PNDSD ROOT SET -SOURCE- 2040 15 JAN 81 22-2362 LP  91750-18041 2013 S C0122 &APLDR +              H0101 wASMB,R,L,Z,C *USE 'ASMB,R,N' (RTE-M-II) OR 'ASMB,R,Z' (RTE-M III) IFN * BEGIN NON-DMS CODE *************** NAM APLDR,1,40 91750-16041 REV.2013 800124 M2 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 91750-16042 REV.2013 800124 M3 ******* END DMS CODE *************** XIF UNL IFN HED APLDR (M2) 91750-16041 REV.2013 791129 (C) HEWLETT-PACKARD CO. XIF IFZ HED APLDR (M3) 91750-16042 REV.2013 791129 (C) HEWLETT-PACKARD CO. XIF LST * * IFN OPTION * NAME: APLDR * SOURCE: 91750-18041 * RELOC: 91750-16041 * PGMR: JERRY BELDEN * * IFZ OPTION * NAME: APLDR * SOURCE: 91750-18041 * RELOC: 91750-16042 * PGMR: JERRY BELDEN * * WRITTEN BY EJW * MODIFIED BY CHW * MODIFIED BY JERRY BELDEN * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 1 EXT $LIBR,$LIBX,EXEC EXT $CVT3,$CON,PRTN,IMESS EXT DOPEN,DREAD,DLOCF,DCLOS,DEXEC EXT #LNOD,#CNOD,#NCNT,D$OVR SPC 1 EXT .MVW,.LBT,.CAX,.CAY,.CYA,.CXA 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,DyWRN-LU,PTTN#,SIZE * LU# * (4) (0) (0) (0) (0) * * APLDR IS SCHEDULED WITH THE FOLLOWING PARAMETERS: * P1 - REMOTE SCHEDULE[15]/ LU[4:9]/ FUNC[0:3] * P2 - #PAGES[10:14] / PTTN#[0:5] OR LIST OPTION * P3 - CHAR1[8:15] / CHAR2[0:7] (OR LU) * P4 - 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 * 3 - SAME AS #1 FROM REMOTE CPU * 4 - SAME AS #2 FROM REMOTE CPU SKP APLDR NOP LDA DPARM GET ADDR OF BUFFER STA TEMP1 SAVE TEMPORARILY LDA MD5 STA TEMP2 CLA,INA TURN ON STA D$OVR SESSION OVERRIDE 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 LDB 1,I GET CART.REF./ NEG.LU STB ICR SAVE IN 2 WORD ICR PARAMETER CLA STA ERTYP INITIALIZE ERROR INDICATOR LDA $CON,I GET CONSOLE LU AND B77 STA 1 LDA ERLUF RAL,CLE,ERA E=1 IF REMOTE SCHEDULE ALF,ALF ALF AND B77 SZA,RSS LIST LU SPECIFIED? LDA 1 NO, USE CONSOLE STA LU SAVE LU FOR LISTING IOR B400 STA RDLU CCB,SEZ SKIP IF LOCALLY SCHEDULED LDB #CNOD GET ORIGIN NODE FOR LIST STB LNODE SAVE LIST NODE * * LDA ERLUF GET FUNCTION FROM BITS 0-3 AND B17 STA FUNC SZA,RSS IS IT LIST? 0 JMP LIST * LDB #LNOD SEZ JMP LODCK JUMP IF REMOTELY SCHEDULED * LDB #NCNT SZB ANY DS-1000 NODES INITIALIZED? JMP CVNOD YES, ASK FOR LOAD NODE CC_CB NO, INDICATE LOCAL NODE JMP LODCK * CVNOD JSB IMESS ASK "LOAD FILE'S NODE?" DEF *+4 DEF D2 DEF QUEST DEF D10 * JSB IMESS GET RESPONSE DEF *+4 DEF D1 DEF ABSBF DEF MD5 * CMB,INB,SZB,RSS JMP CVNOD UNKNOWN RESPONSE STB TEMP1 SAVE BYTE COUNT CLA STA NODE LDB DABS RBL BYTE POINTER JSB .LBT GET FIRST CHAR. STA TEMP2 SAVE IT CPA ASCNG ="-"? LDA D48 YES CVNO1 ADA N58 SSA,RSS VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA D10 A HAS NUMERIC VALUE OF CHARACTER SSA VALID NUMERIC? JMP CVNOD NO, RE-ASK QUESTION ADA NODE ACCUMULATE NODAL ADDRESS ISZ TEMP1 MORE CHARACTERS? RSS YES JMP CVNO2 NO STB TEMP3 SAVE BYTE ADDRESS MPY D10 ACCUMULATED VALUE * 10 STA NODE LDB TEMP3 GET BYTE ADDRESS JSB .LBT GET NEXT CHARACTER JMP CVNO1 CVNO2 LDB TEMP2 CPB ASCNG 1ST = "-"? CMA,INA YES, NEGATE VALUE LDB 0 LDA FUNC * ENTER FOLLOWING CODE WITH FILE'S NODE IN B REGISTER LODCK CPA D1 IS IT A MEMORY RESIDENT LOAD? JMP LOAD IFZ ***** BEGIN DMS CODE ************** CPA D2 IS IT PARTITION LOAD? JMP LOAD ***** END DMS CODE ************** XIF * UNL * EXT DBUG *** DEBUGGING *** * JSB DBUG *** DEBUGGING *** * DEF *+1 *** DEBUGGING *** * NOP *** DEBUGGING *** NOP *** DEBUGGING *** LST * LDB MD64 FUNCTION CODE ERROR JMP ERSET ERROR * DPARM DEF ERLUF MD5 DEC -5 B77 OCT 77 B2300 OCT 2300 OPT OCT 2310 B400 OCT 400 D3 OCT 3 D20 DEC 20 D48 DEC 48 AN ASCII "0" N58 DEC -58 ASCNG OCT 55 NEG 2SIGN RDLU NOP FUNC NOP FUNCTION CODE LNODE NOP NODE FOR LIST OUTPUT ICR BSS 2 CR/NODE ARRAY NODE EQU ICR+1 FLFLG NOP FILE FLAG HED LO: LOAD PROGRAM * LOAD EQU * STB NODE SAVE NODE OF LOAD FILE 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 ADDR. LDA DWRD2 STA WORD2 LDA RSS INITIALIZE SWITCH STA AB12D FOR SPEC. REC. CLA STA ABS12 STA ABSCT INDICATE NO ABS YET. * 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. * LDA NAM12 GET FILE NAME. SZA,RSS GIVEN? LDA D4 NO, USE DEFAULT STA NAM12 SAVE FOR COMPARE STA FLFLG SET FILE FLAG AND B77 CPA NAM12 LEGAL LU? JMP STCNW YES. SET UP CONTROL WORD. LDB #NCNT IS THIS NODE INITIALIZED SZB FOR DS/1000 COMMUNICATIONS? JMP OPENF YES--GO OPEN FILE. JMP ABORT NO--ABORT. * STCNW IOR B2300 SET UP CONTROL WORD FOR STA CONWD BINARY ABSOLUTE DEXEC READS. CLB STB NAM12 CLEAR TO FORCE USE OF NAM RECORD NAME STB FLFLG CLEAR FILE FLAG. JMP NOTIN GO READ FROM LOCAL LU * OPENF JSB DOPEN OPEN THE ABS INPUT FILE DEF *+7 DEF DCB DEF ERR DEF NAM12 FILE NAME ADDR DEF OPT OPT = 2300B FOR ABS DFSC DEF * SECURITY CODE DEF ICR CR/NODE ARRAY SSA ANY ERRORS? JMP NOFIL NO SUCH FILE * JSB DLOCF GET FILE INFO DEF *+9  DEF DCB 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 LDA FLFLG SZA IS INPUT FROM FILE? JMP READF YES, DO RFA READ * NOTIN JSB DEXEC NO--MAKE DEXEC CALLS. DEF *+6 DEF NODE DEF D1 DEF CONWD DEF ABSBF DEF D64 * AND B240 ISOLATE EOF/EOT BITS SZA EOF OR EOT? JMP LOAD5 YES JMP ABS0A NO, CONTINUE * READF JSB DREAD READ ABS RECORD DEF *+6 DEF DCB DEF ERR DABS DEF ABSBF DEF D64 DEF LEN LDB LEN CPB M1 EOF? JMP LOAD5 YES. SSA JMP ABSCK ANY ERROR, CHECKSUM ERROR * ABS0A 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 LDA ABSAD GET ADDR, START CKSM. LDB DABSD ABS0B ADA 1,I ADD WORD TO RUNNING CKSUM INB ISZ TEMP1 BUMP COUNT JMP ABS0B REPEAT TIL DONE. * CPA 1,I COMPARE CKSMS JMP ABS1 MATCHES * ABSCK LDB ERR10 CHECKSUM ERROR- JMP ERPR4 ERR MSG THEN ABORT * NOFIL STA ERTYP RETURN ERROR CODE 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 LDA D2 JSB STUFP STUFF NAME & PRINT MESSAGE JMP ABHlORT ABORT APLDR * * 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. B 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 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. * * I * * COPY ABS RECORD TO CORE IF WITHIN BOUNDS SPC 1 IFZ ***** BEGIN DMS CODE *************** LDA FUNC CPA D1 LOAD MEMORY RESIDENT? JMP LDMRP YES * 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 JSB .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 JSB .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 JSB .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 JSB .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 JSB .CAX (X) = #WORDS LDA ABSAD JSB .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 JSB .CYA STA LOGSA SAVE LOGICAL ADDR JSB .CXA STA NWDS SAVE # WORDS * CLA,INA JSB .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 JSB .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 * * B240 OCT 240 CONWD NOP CONTROL WORD FOR EXEC CALL * * 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,SLA,ERA SIGN BIT 0-MRP, 1-PRP INlPB NOT MEM RES, SET FUNC=2 FOR PTTN LOAD STA MPFT# HAS MPFT INDEX 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 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 MESSAG2xE LDB MD62 ERROR CODE JMP ERSET * 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,SLB,ERB JMP PTNFD RESERVED, 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 COMMON 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. * * 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 * LDB BUFAD SET UP DONE MESSAGE LDA MSG1 WITH PROGRAM NAME JSB .MVW DEF D3 NOP LDA DWRD1+1 GET ADDR OF PROG NAME JSB MVNAM MOVE NAME 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 LDB TEMP,I GET ERROR CODE FOR ANY CALLER * ERSET STB ERTYP SAVE ERROR CODE FOR "PRTN" CALL 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 LDB MD61 * LDA C.. CHANGE NAME ONLY ONCE CPA DUPNM,I IF NAME ALREADY CHANGED, JMP ERSET THEN ABORT, ERROR -61 STA DUPNM,I ELSE SEARCH AGAIN. CLB,INB STB ERTYP RETURN A +1 FOR RENAME JMP DUP1 * * **************************** * * SYSET SETS WORDS INTO CORE LOCATIONS * LDA ADDFR * LDB ADDTO * JSB SYSET * 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) JSB .MVW STORE WORD INTO SYS. DEF SYSCT NOP SYSCT EQU *-2 p 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 SUBTR FROM ADA TEMP1 HI ADDR. SZA ADDR <= SSA 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 LDA ERLUF LDB MD60 SSA REMOTE SCHEDULE? JMP ERSET YES, RETURN ERROR = -60 * 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 EQU * 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 1 LDB LINE PUT PROG NAME INB 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 DCLOS CLOSE INPUT FILE IF ANY DEF *+3 DEF DCB DEF ERR * LDA ERTYP STA MSG+6 MOVE ERROR VALUE FOR PARAMETER RETURN * RTRNP JSB PRTN RETURN ERROR CODE(,PGM NAME) DEF *+2 TO "FATHER" PGM ("EXECW") DEF MSG+6 * JSB EXEC CALL EXEC DEF *+2 TO END GDEF 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 BUFAD 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 JSB .MVW MOVE 'NOT DEFINED' MESSAGE DEF D6 NOP 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 LDA 1,I SZA,RSS EMPTY? JMP PTEMT YES * ADA D12 NO, INDEX TO NAME LDB .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 JSB .MVW DEF D3 NOP 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 CLA GO THROUGH STA D$OVR CALLER'S SESSION JSB DEXEC CALL REMOTE EXEC DEF *+6 TO PRINT DEF LNODE ON LIST DEVICE DEF D2I WRITE, NO-ABORT DEF LU MADDR NOP DEF TEMP1 JMP IOERR ERROR RETURN ISZ D$OVR TURN OFF SESSION JMP PRINT,I * IOERR DST MSG+7 SAVE ASCII ERROR CODE ISZ D$OVR TURN OFF SESSION LDA ERLUF SSA REMOTE CALL? JMP REMOT YES LDA DBLNK NO, LOCAL STA MSG+4 CLEAR MSG BUFR STA MSG+5 LDA D9 PRINT ERROR STA TEMP3 MESSAGE LOCALLY JSB DSPLA AND JMP ABORT ABORT. * REMOT LDA BIT15 INDICATE I/O ERROR STA MSG+6 JMP RTRNP RETURN PARAMETERS TO CALLER * * ******************************** * * STUFP STUFFS A MESSAGE WITH THE IDENTIFIER "APLDR:" AND * PRINTS IT ON CONSOLE. * LDA WORDS * LDB ADDR * JSB STUFP * * STUFP 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 LDA ERLUF AND MSKW1 ISOLATE REMOTE FLAG & LU CPA BIT15 REMOTE, AND LU=0? JMP DSPLA,I YES, DON'T LOG THE MESSAGE RAL,CLE,SLA,ERA REMOTE? JMP RMESG YES * JSB IMESS NO DEF *+4 DEF D2 WRITE DEF MSG MESSAGE ON DEF TEMP3 OPERATOR CONSOLE. JMP DSPLA,I RETURN * RMESG ALF,ALF ALF STA MVNAM CLA GO THROUGH STA D$OVR CALLER'S SESSION * JSB DEXEC WRITE MESSAGE TO REMOTE INITIATOR DEF *+6 DEF LNODE DEF D2I WRITE, NO-ABORT DEF MVNAM REMOTE CONSOLE'S LU DEF MSG DEF TEMP3 JMP IOERR ERROR RETURN ISZ D$OVR TURN OFF SESSION JMP DSPLA,I * * ****************************** * * MVNAM MOVES A PROGRAM NAME (3 WORDS) AND FILLS AN * ASCII BLANK IN THE DESTINATION NAME. * LDB DEST ADDR OF DESTINATION FOR NAME * LDA SORC ADDR OF SOURCE NAME * JSB MVNAM * * MVNAM NOP MOVEf0 PROG NAME JSB .MVW MOVE FIRST 4 CHARACTERS DEF D2 NOP LDA 0,I GET 5TH CHARACTER AND LHALF PUT ASCII BLANK IOR B40 IN CHAR6 STA 1,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 BUFAD EQU *+1 DST BUF MOVE ERR MSG TO OUTPUT AREA LDA TEMP5 GET ADDR OF NAME LDB LINE2 TO PUT INTO MSG 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 MATbCHES. 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 ADDR JSB .MVW MOVE 3 ASCII WORDS DEF D3 NOP JSB $LIBX RETURN DEF CVT * ADDR NOP SKP * CONSTANTS AND STORAGE. * UNS M1 DEC -1 M2 DEC -2 * D1 OCT 1 D2 OCT 2 D2I OCT 100002 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 MSKW1 OCT 101760 BIT15 OCT 100000 LHALF OCT 177400 ZERO OCT 0,0,0 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 ERTYP NOP * ERLUF NOP 5-WORD TABLE. PGPT NOP DO NOT RE-ARRANGE! NAM12 NOP NOP NAM50 NOP * DCB BSS 4 SKP * MESSAGES FROM APLDR WITH LOVE. * * ERR01 DEF *+1 REMOVE PROGRAM TO BE OVERLAYED ASC 2,REM MD60 DEC -60 * ERR02 DEF *+1 DUPLICATE PROGRAM NAME ASC 2,DUP MD61 DEC -61 * ERR10 DEF *+1 CHECKSUM ERROR ASC 2,CKSM DEC -66 * ERR11 DEF *+1 COMMON AREA OVERFLOW ASC 2,COM DEC -67 * ERR12 DEF *+1 MEMORY OVERFLOW ASC 2,MEM DEC -68 * ERR13 DEF *+1 IDENTIFICATION RECORDS MISSING OR WRONG ASC 2,ID? DEC -65 * ERR99 DEF *+1 APLDR IS ABORTED ASC 4,ABORTED * * QUEST ASC 10, LOAD FILE'S NODE? __ * MSG1 DEF *+1 ASC 3,DONE- LDASH EQU *-1 "- " * * MT.ID DEF *+1 ASC 11, 00 BLANK ID SEGMENTS MD64 DEC -64 DBLNK EQU MT.ID+1 DOUBLE BLANK WORD DFBLK DEF DBLNK * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * SPC 1 IFZ ***** BEGIN DMS CODE *************** ERR14 DEF *+1 NO FREE PARTITION ASC 2,PTN MD62 DEC -62 * ERR15 DEF *+1 PARTITION NOT LARGE ENOUGH ASC 2,PTSZ DEC -63 * PUNDF DEF *+1 ASC 6, NOT DEFINED * PTNON DEF *+1 ASC 3, PTHED DEF *+1 ASC 16, PTN# R SIZE PAGES PROGRAM ASCR EQU PTHED+4 .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 * DMYILD 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 MPFT EQU DMYID+21 PRGMN EQU DMYID+22 PRGM2 EQU DMYID+23 PRGBP EQU DMYID+24 PRGD2 EQU DMYID+25 SEGMX EQU DMYID+26 * * BSS 0 SIZE OF APLDR * * END APLDR .  91750-18047 2013 S C0122 &CLRQ              H0101 YASMB,Q,C NAM CLRQ,7 91750-1X047 REV 2013 801014 (IV,M3) * * SOURCE: 91750-18047 * RELOC.: 91750-1X047 * PRGMR: LYLE WEIMAN JULY 1979 * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * "CLRQ" ROUTINE FOR DS/1000, TO BE USED IN RTE-IV, -M-2 & -M-3 * SYSTEMS ONLY. * * NOTE: IN THIS VERSION, CERTAIN FEATURES OF THE RTE-L ROUTINE * OF THE SAME NAME ARE NOT IMPLEMENTED. IN PARTICULAR, CLASS NUMBERS * ARE ALWAYS ALLOCATED GLOBALLY. THE "NO-ABORT" BIT MUST BE SET IN * ALL CALLS. * * * THIS LIBRARY SUBROUTINE PERFORMS CLASS MANAGEMENT FUNCTIONS. IT WILL * ALLOW THE ASSIGNMENT OF OWNERSHIP TO CLASSES SO THAT IN THE EVENT * OF A PROGRAM TERMINATING OR ABORTING WITHOUT CLEANING UP THE CLASSES * AND CLASS BUFFERS ASSIGNED TO IT, THE SYSTEM WILL BE ABLE TO * DEALLOCATE THESE RESOURCES. THIS ROUTINE ALSO ALLOWS PROGRAMMATIC * FLUSHING OF PENDING CLASS BUFFERS ON AN LU OR FLUSHING OF ALL CLASS * BUFFERS (PENDING OR COMPLETED) WITH DEALLOCATION OF THE CLASS ITSELF. * THE CALLING SEQUENCE IS AS FOLLOWS: * EXT CLRQ * . * . * JSB CLRQ TRANSFER CONTROL TO SUBROUTINE * DEF RTN RETURN ADDRESS * DEF ICODE CONTROL INFORMATION (BIT14=NO ABORT)(15=NO WAIT) * DEF CLASS CLASS NUMBER * DEF IPRAM CALL DEPENDENT PARAMETER (PGM NAME OR LU) * (NOT USED IN THIS VERSION) * USED ONLY IF NO-ABORT BIT SET * RTN RETURN POINT CONTINUE EXECUTION * . * . * ICODE OCT 1 ASSIGN CLASS OWNERSHIP. IPRAM CONTAINS THE NAME * OF THE PROGRAM ASSIGNED OWNERSHIP OF THE CLASS. * IF IPRAM IS ZERO, NO OWNERSHIP IS ASSIGNED. IF * IPRAM IS DEFAULTED, THE CALLING PROGRAM IS ASSIGNED * OWNERSHIP. IF CLASS IS ZERO, A NEW CLASS NUMBER IS * ALLOCATED BY THE CALL. IN THIS CASE, A ZERO IS * RETURNED IN THE A REG IF ALLOCATION WAS SUCCESSFUL * IF NO CLASSES ARE AVAILABLE, THE USER IS SUSPENDED * UNLESS THE NO-WAIT FLAG WAS SET IN WHICH CASE A * -1 IS RETURNED IN THE A REGISTER. * * " " OCT 2 FLUSH CLASS REQUESTS & DEALLOCATE CLASS. ALL NON- * ACTIVE PENDING REQUESTS WILL BE DEALLOCATED. ABORT * REQUESTS WILL BE ISSUED BY THE SYSTEM FOR ALL ACTIVE * I/O REQUESTS, IN WHICH CASE THE BUFFER WILL BE * DEALLOCATED AT LOGICAL DONE. ALL PREVIOUSLY * COMPLETED REQUESTS WILL BE IMMEDIATELY DEALLOCATED. * THE CLASS TABLE ENTRY WILL BE FLAGGED SO THAT NO * NEW REQUESTS WILL BE ISSUED ON THE CLASS (IO00 * ERROR RETURNED) AND SO THAT UPON THE PENDING * COUNT REACHING ZERO, THE SYSTEM CAN DEALLOCATE THE * CLASS. * * " " OCT 3 FLUSH CLASS REQUESTS ON LU DESIGNATED BY IPRAM. * (NOT IMPLEMENTED FOR RTE-IV/M) * NON-ACTIVE REQUESTS FOR THE DESIGNATED CLASS * PENDING ON THE LU ARE DEALLOCATED AND IF A * REQUEST IS ACTIVE, AN ABORT REQUEST IS ISSUED BY * THE SYSTEM. THE BUFFER WILL BE DEALLOCATED AT * LOGICAL DONE. THE CLASS IS NOT DEALLOCATED BY * THIS CALL. * ERRORS: SAME AS RTE RETURNS ON CLASS-I/O CALLS * ENT CLRQ EXT EXEC,.ENTR SPC k2 OPTN NOP OPTION CLASS NOP OWNER NOP CLRQ NOP JSB .ENTR DEF OPTN LDA OPTN,I AND D3 CPA D1 ALLOCATE? JMP ALLOC YES CPA D2 DE-ALLOCATE? JMP DALLC JMP CLRQ,I RETURN WITHOUT CAUSING DAMAGE! SPC 2 ALLOC EQU * CLA WE WANT A CLASS # ALLOCATED. LDB OPTN,I RBL,SLB IS "NO-WAIT" BIT IN OPTN SET? IOR SIGNB YES, SET "NW" BIT IN CLASS NUMBER STA CLASS,I SET CLASS NUMBER JSB EXEC ALLOCATE A CLASS NUMBER DEF *+5 DEF CLCTL OCT 23 + NO-ABORT BIT DEF ZERO DEF ZERO DEF CLASS,I --RETURN CLASS NUMBER HERE JMP EXITA ERROR RETURN STA ARTN LDA CLASS,I LOAD ASSIGNED CLASS NUMBER RAL,CLE,ERA CLEAR "NO-WAIT" BIT STA CLASS,I RETURN CLASS NUMBER IOR =B20000 SET THE "DON'T DE-ALLOCATE CLASS NUMBER" STA CLASS BIT * JSB EXEC CLEAR CLASS REQUEST DEF *+5 DEF CLS21 DEF CLASS DEF ZERO DEF ZERO JMP EXITA -- ERROR RETURN * ISZ CLRQ BUMP RETURN ADDRESS FOR "GOOD" RETURN * EXITA EQU * LDA ARTN JMP CLRQ,I RETURN SPC 2 DALLC EQU * HERE TO DE-ALLOCATE A CLASS NUMBER LDA CLASS,I AND CLSBF CLEAR "SAVE-BUFFER" BIT IOR SVCLS SET "SAVE CLASS NUMBER"&NO-WAIT OPTION STA OPTN SET OPTNS:SAVE CLASS#, RELS BUFRS,NO-WAIT * * NOW, THE OPTION IS SET SO THE BUFFER WILL BE RELEASED ON EACH CALL, * IF THERE IS ONE, BUT THE CLASS NUMBER WILL NOT BE. THIS LOOP * EXITS WHEN THERE ARE NO MORE BUFFERS ( = -1 ON RETURN FROM * 'EXEC' CALL) * CLA CLEAR THE CLASS NUMBER STA CLASS,I THE USER PASSED US. DALL1 EQU * CCA SET THE RELEASE RE-TRY SWITCH SO WE WILL STA TEMP MAKE ONE MORE CALL AFTER LAST BUFFER IS RELEASED * CLs]RTN JSB EXEC GO TO RTE TO RELEASE CLASS BUFFER OR NUMBER DEF *+5 DEF K21N CLASS GET/NO ABORT DEF OPTN MASTER OPTN/RELEASE/NO WAIT DEF ZERO DEF ZERO JMP CLRQ,I -- ERROR RETURN * ISZ TEMP RELEASE PROCESSING COMPLETED? JMP DXIT YES, RETURN * INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP DALL1 NO. CONTINUE TO CLEAR REQUESTS * LDA OPTN GET THE OPTION NUMBER AGAIN AND CLMSK CHANGE OPTION TO DE-ALLOCATE CLASS# STA OPTN RESTORE THE MODIFIED OPTN WORD JMP CLRTN RETURN FOR FINAL DE-ALLOCATION SPC 2 DXIT EQU * RETURN TO CALLER ISZ CLRQ TAKE "GOOD" EXIT JMP CLRQ,I SPC 3 SIGNB DEF 0,I SIGN BIT K21N OCT 100025 ARTN NOP CLMSK OCT 157777 CLSBF OCT 17777 ZERO DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 CLCTL OCT 100023 CLASS CONTROL W/ "NO-ABORT BIT" SET CLS21 OCT 100025 CLASS "GET" + "NO ABORT" BIT SVCLS OCT 120000 SAVE CLASS NUMBER & NO-WAIT OPTION TEMP NOP END NT  91750-18048 2013 S C0122 &CNSLM              H0101 ASMB,Q,C HED 3000 $STDLIST MONITOR * (C) HEWLETT-PACKARD CO. NAM CNSLM,19,30 91750-16048 REV.2013 800117 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC,XLUEX,DTACH,#QXCL,#RSAX,#GET,$OPSY SPC 3 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: CNSLM *SOURCE: 91750-18048 * RELOC: 91750-16048 * PGMR: DMT LST *************************** CNSLM ****************************** * * * SOURCE: 91750-18048 * * * * BINARY: 91750-16048 * * * * PROGRAMMR: JIM HARTSELL * * * * DATE: FEBRUARY 10, 1976 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 3, 1978 * * * ****************************************************************** SPC 3 * CNSLM IS THE DS/1000 MONITOR WHICH RECEIVES "UNEXPECTED" * $STDLIST REQUESTS INITIATED BY AN HP 3000. THESE ARE USUALLY * "TELL" MESSAGES OR THE LOGOFF FROM A "KILLED" SESSION. SPC 2 A EQU 0  B EQU 1 SUP SKP * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * SKP CNSLM LDA $OPSY CHECK FOR OPERATING RAR SYSTEM TYPE. SLA,RSS JMP LDABI XLA B,I DMS LOAD. RSS LDABI LDA B,I NON-DMS LOAD. STA CLSN  SAVE CLASS NUMBER. * JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * GET JSB #GET DO A CLASS GET AND WAIT FOR REQUEST DEF *+6 DEF CLSN CLASS # DEF DS1KH DS/1000 HEADER DEF MINLN DEF RQBUF REQUEST BUFFER DEF D80 MAX LENGTH = 80 WORDS. JMP GET ERROR RETURN. * LDA RQBUF GET LENGTH/CLASS WORD. AND B77 ISOLATE CLASS. CPA D5 IS IT 5? RSS JMP GET NO. IGNORE. * LDA RQBUF+2 GET STREAM TYPE WORD. AND B77 ISOLATE STREAM TYPE. CPA B23 STREAM 23 IS CONTROL. JMP REPLY (JUST REPLY.) CPA B20 RSS STREAM 20 IS $STDLIST. JMP REJCT REJECT ALL OTHERS. * LDA RQBUF+4 AND B377 STA TONUM STORE "TO" NUMBER (LU # OR 0) * LDA RQBUF+7 GET BYTE LENGTH. ADA MD4 OMIT CONTROL WORDS FROM COUNT. CMA,INA NEGATE MESSAGE BYTE LENGTH. STA BUFL SAVE NEGATIVE LENGTH. * LDA TONUM IF DIRECTED TO USER, SZA JSB OTPUT DISPLAY ON THAT LOG LU. CLA,INA IF USER CONSOLE CPA TONUM IS NOT 1, RSS DISPLAY ON JSB OTPUT SYSTEM CONSOLE. * * BUILD A REPLY FOR THE $STDLIST REQUEST. * REPLY LDA RQBUF STORE COUNT WORD. AND B377 IOR LB9 STA RQBUF LDA RQBUF+2 SET REPLY BIT. AND B77 IOR BIT15 STA RQBUF+2 SET APPENDAGE LDA D2 SET APPENDAGE STA RQBUF+7 LENGTH (2 BYTES). LDA CCE STORE STATUS WORD. STA RQBUF+8 * * SEND THE REPLY OR REJECT * SEND LDA RQBUF+4 REVERSE PROCESS NUMBERS. ALF,ALF STA RQBUF+4 AND B377 IF NO REPLY TO BE SENT, SZA,RSS JMP CNSL1 GO RELEASE SLAVE TCB. * LDA RQBUF+7 GET BYTE COUNTER. INA CLE,ERA ADA D8 STA RQLEN LENGTH OF REPLY. * LDA #QXCL IS 3000 LINK DOWN? SSA JMP CNSL1 YES. IGNORE REPLY. * JSB EXEC WRITE REPLY TO QUEX. DEF *+8 DEF CLS20 DEF D0 DEF RQBUF DEF RQLEN DEF RQLEN DEF D0 DEF #QXCL NOP IGNORE ERROR RETURN. * CNSL1 JSB #RSAX DELETE SLAVE TCB. DEF *+4 DEF D7 CODE FOR "CLEAR". DEF DS1KH+#SEQ LOCAL SEQUENCE #. DEF D2 CNSLM STREAM TYPE. * JMP GET GO WAIT FOR ANOTHER REQUEST. SKP * SUBROUTINE TO PERFORM $STDLIST ON LU IN A-REGISTER * OTPUT NOP ENTRY POINT STA LU STORE LU NUMBER * JSB XLUEX DISPLAY MESSAGE DEF *+5 DEF SD2 DEF LU DEF RQBUF+10 DEF BUFL NOP IGNORE ERRORS * LDA RQBUF+8 IF DOUBLE CPA B60 SPACE WAS RSS SPECIFIED, JMP OTPUT,I * JSB XLUEX PRINT A DEF *+5 BLANK DEF SD2 LINE. DEF LU DEF BLANK DEF D1 NOP JMP OTPUT,I RETURN. * B60 OCT 60 BLANK ASC 1, * * DO NOT CHANGE THE ORDER OF THE FOLLOWING TWO STATEMENTS. LU BSS 1 LU NUMBER OCT 200 CONTROL BIT TO PRINT COL 1 SPC 5 * * SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. * REJCT LDA RQBUF TOTAL AND B377 LENGTH IOR LB8 IS 8. STA RQBUF LDA RQBUF+2 SET REJECT BIT. IOR BIT14 STA RQBUF+2 CLA DATA LENGTH = 0. STA RQBUF+7 JMP SEND SEND REJECT TO QUEX. SPC 5 * * CONSTANTS AND WORKING STORAGE. * D0 OCT 0 D1 DEC 1 D2 DEC 2 D5 DEC 5 D7 DEC 7 D8 DEC 8 D80 DEC 80 B20 OCT 20 B23 OCT 23 B77 OCT 77 B377 OCT 377 CLS20 DEF 20,I MD4 DEC -4 SD2 DEF 2,I LB8 BYT 10,0 DECIMAL 8, LEFT BYTE. LB9 BYT 11,0 DECIMAL 9, LEFT BYTE. BIT14 OCT 40000 REJECT BIT BIT15 OCT 100000 REPLY BIT CLSN NOP RQLEN NOP CCE OCT 1000 BUFL NOP TONUM NOP MINLN ABS #MHD DS1KH BSS #MHD+#LSZ DS/1000 HEADER RQBUF BSS 80 DS/3000 MESSAGE * BSS 0 SIZE OF CNSLM * END CNSLM   91750-18049 2013 S C0122 &COMND              H0101 xASMB,R,L,C HED AUXILIARY COMMANDS FOR RTE-L MEMORY BASED SYSTEM * NAME: COMND * SOURCE: 91750-18049 * RELOC: 91750-16049 * PGMR: JERRY BELDEN * **************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * RESERVED. 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 COMND,1,90 91750-16049 REV.2013 791003 L SUP * * THIS IS THE DS VERSION OF COMND. IT DOES NOT HAVE THE * ACTION ROUTINES APPENDED TO IT, BUT RATHER PASSES * THE COMMAND STRING TO OPERM. * * * GLOBAL DATA * * * GLOBAL ENTRY POINTS * * * EXTERNAL ROUTINES * EXT EXEC,LOGLU,RMPAR,REIO,CLRQ EXT PNAME,PARSE EXT #ST07,.MVW SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV XXXX 790531 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+20 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP * * INITIALIZATION * COMND JSB RMPAR GET SCHEDULING PARAMETERS DEF *+2 DEF CAM.I STORE STARTING AT CAM.I * JSB Q.LOGLU GET CONSOLE LU DEF *+2 DEF CAM.O (ACTUALLY A DUMMY PARAMETER) STA CAM.O SET UP LOG LU * LDA TMP. TEST THE RANGE (1-63) JSB PCHEK OF THE LIST LU LDA CAM.O ILLEGAL RETURN, USE CONSOLE LU STA TMP. STORE VALUE OF LIST * * THIS VERSION OF COMND ALLOWS ONLY INTERACTIVE INPUT * TRLOG LDA CAM.O USE CONSOLE LU IOR B104H ECHO FLAG STA CAM.I SAVE IN INPUT FLAG JSB PNAME CALL FOR THE PROGRAM'S NAME DEF *+2 DEF PRMPT FOR USE AS THE PROMPT LDA PRMP3 GET 3RD CHARACTER IOR B72 PUT COLON IN PLACE STA PRMP3 SAVE SKP * * READ COMMAND * JSB REIO YES, WRITE PROMPT AND READ INPUT DEF *+7 FROM INPUT DEVICE DEF .1 DEF CAM.I DOUBLE BUFFER WRITE/READ DEF RQB+#CMS INPUT BUFFER DEF MXLEN INPUT LENGTH DEF PRMPT OUTPUT BUFFER DEF .4 OUTPUT LENGTH * STB ECH STORE TRANSMISSION LOG BLS STB RQB+#CML CHAR. COUNT SZB,RSS NOTHING ENTERED JMP EX NOTHING, EXIT AND B200 CHECK FOR EOF SZA,RSS EOF? JMP PARS NO, GO PARSE THE COMMAND JMP TRLOG EOF, TRANSFER TO LOG DEVICE SKP * * PARSE STRING & TEST FOR APLDR COMMANDS * PARS JSB PARSE USE SYSTEM'S PARSER DEF *+4 DEF RQB+#CMS INPUT BUFFER DEF RQB+#CML CHAR COUNT DEF MRSLT PARSED PARAMETER BUFFER * LDB DMRLT PARSE BUFFER ADDRESS LDA B,I PARAMETER TYPE CPA .2 ASCII ? JMP PAR1 YES, OK PARER LDA IN NO, INPUT ERROR LDB PT JMP RPERR PAR1 INB PICK UP COMMNAND NMEMONIC LDB B,I * CLA INITIALIZE STA PRAM3 LDA TMP. SET UP LIST LU CPB LO"" IF LO, USE CONSOLE LU LDA CAM.O AND B377 } ALF STA PRAM1 CLA PRESET FUNCTION * CPB PL"" JMP APLF2 SET UP FOR APLDR PL CPB IO"" JMP APLFX APLDR IO CPB LO"" JMP APLF1 APLDR LO * * CHECK FOR 'SS' COMMAND W/O PARAM. THIS WILL CAUSE * COMND TO SUSPEND ITSELF. * CPB SS"" RSS JMP OPCOM NOT 'SS' LDB DMRLT PARSE BUFFER ADDRESS ADB .4 POINT TO NXT PARAM TYPE LDB B,I SZB ANYTHING THERE ? JMP OPCOM YES, STD REQUEST * JSB EXEC NO, SUSPEND SELF DEF *+2 DEF .7 JMP EX JUST RESTARTED, EXIT FOR NOW SKP * * FIX UP THE REQUEST TO OPERM * OPCOM CCA SET DESTINATION TO LOCAL STA RQB+#DST LDA ECH CALCULATE CLASS READ/WRITE REQUEST LEN. ADA HDLEN STA ECH LDA CAM.O SAVE LOCAL LU STA RQB+#EHD IN LAST WORD OF HEADER * * CODE FOLLOWS TO WRITE REQUEST TO OPERM'S CLASS, DETERMINE * WHETHER OPERM IS DORMANT OR NOT AND HANDLE APPROPRIATELY * LDA #ST07+1 OPERM'S CLASS STA CLAS1 SAVE IT IOR SIGN SET NO-WAIT BIT AND SPECL MASK OUT BITS 13 & 14 STA CLASS SAVE IN REQUEST JSB EXEC DO CLASS READ/WRITE DEF *+8 DEF CLWRT DEF B10K Z-BIT SET DEF RQB ADDR OF START OF MESSAGE DEF .0 NO DATA DEF RQB REQUEST BUFFER DEF ECH REQUEST LENGTH DEF CLASS JMP RPERR ERROR SSA JMP RPER1 NO SAM OR CLASS # * LDA CLAS1 CHECK OPERM AGAIN SZA INITIALIZED ? JMP CALR YES, DONE JSB CLRQ ASSIGN OWNERSHIP DEF *+3 OF CLASS TO US DEF .1 IN CASE WE DEF CLASS GET STOMPED ON JSB EXEC SCHEDULE OPERM WITH WAIT DEF *+4 DEF SCHD DEF OPERM DEF CLASS SCHED PRNKAM 1 JMP RPERR SCHEDULE ERROR SZA JMP RPER1 OPERM NOT DORMANT CALR JMP EX YES, GO TERMINATE SKP * * ENTER BELOW FOR APLDR COMMANDS * APLFX ADA .4 IO COMMAND = 5 APLF1 INA LO = 1 APLF2 STA PRAM5 PL = 0, SAVE FUNCTION TEMPORARILY IOR PRAM1 SET UP 1ST PARAMETER STA PRAM1 LDA PRAM5 WHICH COMMAND ? CPA .5 JMP APL10 DONE WITH IO COMMAND LDB DMRLT PARSE BUFFER ADDR. ADB .4 POINT TO NEXT PARAM. TYPE SZA JMP APLF5 GO DO 'LO' COMMAND LDA B,I MUST BE PL, GET PRAM TYPE SZA,RSS ANY 2ND PRAM ? JMP APL10 NO, DONE ! CPA .2 ALPHA RSS JMP PARER NO, ERROR ! INB YES LDA B,I STORE IN OPTION PARAM. STA PRAM3 JMP APL10 SKP * * 'LO' PARAMETER SETUP * APLF5 LDA B,I LOOK AT PARAM TYPE * * LOADING FROM A LU NOT ALLOWED ON THE L. MUST BE A * REMOTE DISK FILE * CPA .2 ASCII ? RSS JMP PARER NO, MUST BE LU (NOT ALLOWED) INB MOVE FILENAME TO LDA B SCHEDULE PARAMETERS LDB APRM3 JSB .MVW DEF .3 NOP LDB A A(3RD PRAM TYPE), PARSE BUF INB POINT TO SECURITY CODE LDA B,I STA PRAM2 ADB .4 POINT TO CRN LDA B,I PREPARE TO PLACE EXCESS STA ACRN# PARAMS IN RES ADB .3 NODE # PRAM TYPE LDA B,I CPA .1 SHOULD BE NUMERIC RSS JMP PARER INB LDA B,I PICK UP NODE # STA ACRN#+1 SAVE FILE NODE * SKP * * SCHEDULE APLDR * APL10 JSB EXEC SCHEDULE APLDR W/WAIT DEF *+10 DEF SCHD (NO ABORT BIT SET) DEF APLDR DEF PRAM1 DEF PRAM2 DEF PRAM3 DEF PRAM4 DEF PRAM5 DEF ACRN# STRING BUFFER DEF .2 STRING LENGTH JMP IDER APLDR MISSING SZA JMP BSYER APLDR BUSY JMP EX NO PROBLEM SKP * * EXITS * * ERRORS * * LACK OF SAM, CLASS #S OR OPERM NOT DORMANT * RPER1 LDA EXX LDB EC JMP RPERR * * SCHEDULE ERRORS * IDER LDB ID APLDR MISSING JMP BSY1 * BSYER LDB BS APLDR BUSY BSY1 LDA AP JMP RPERR * * ERROR REPORTING * RPERR STA MSG STB NUM INSERT ERROR CODE LDA CAM.O OUTPUT LU IOR B40K FORCE NON-BUFFERED I/O STA CAM.O JSB EXEC WRITE TO LOCAL DEVICE DEF *+5 DEF .2 DEF CAM.O DEF ERBUF DEF .4 * * EXIT PROGRAM * EX LDA CLAS1 DID WE HAVE TO SZA ALLOCATE A CLASS? JMP EXIT NO ISZ CLAS1 YES, SHOW THAT WE HAVE GIVEN IT BACK JSB CLRQ AND DEF *+3 DO DEF .2 SO DEF CLASS EXIT JSB EXEC TERMINATE SAVING RESOURCES DEF *+4 DEF .6 DEF .0 DEF .1 JMP COMND * * DATA FOR ERROR EXITS * ERBUF ASC 2,CMD MSG NOP NUM NOP EXX ASC 1,EX EC ASC 1,EC IN ASC 1,IN PT ASC 1,PT AP ASC 1,AP ID ASC 1,ID BS ASC 1,BS SKP * * PCHEK - INPUT PARAMETER CHECK OF RANGE * PCHEK NOP LDB A SAVE A SSA IS IT GREATER THAN 0 ? JMP PEXIT NO, ERROR SZA,RSS IS LU ZERO? JMP PEXIT YES, ERROR ADB N64 IS IT GREATER THAN 64 ? SSB ISZ PCHEK NO IT IS OK SO RETURN P+2 PEXIT JMP PCHEK,I * * CONSTANTS * .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEC 6 .7 DEC 7 N64 DEC -64 B72 OCT 72 B200 OCT 200 B377 OCT 377 B10K OCT 10000 B104H OCT 10400 B40K OCT 40000 A EQU 0 B EQU 1 * DMRLT DEF MRSLT AP*($RM3 DEF PRAM3 SKP * * VARIBLES * CAM.I NOP INPUT DEVICE LU (MUST BE 1ST) TMP. NOP LIST LU CAM.O NOP OUTPUT DEVICE LU ECH NOP INPUT WORD COUNT PRMPT BSS 2 PROMPT BUFFER PRMP3 BSS 1 5TH & 6TH CHARACTERS OCT 20137 , PRAM1 NOP 1ST APLDR SCHED PRAM PRAM2 NOP 2ND " PRAM3 NOP 3RD " PRAM4 NOP 4TH " PRAM5 NOP 5TH " OCT 20137 * * PARSE BUFFER * MRSLT BSS 4 \ ORDERED COMMAND PARAMETER BSS 28 > PARAMETER LIST NOP / PARAMETER COUNT * * REQUEST BUFFER * RQB DEC 7 STREAM # BSS #OLW SKP * * DATA ADDED FOR DS * SIGN OCT 100000 SIGN BIT SPECL OCT 117777 MASK FOR CLASS ALLOCATE ACRN# BSS 2 CRN & FILE NODE FOR LOAD CLASS NOP OPERM'S CLASS # CLAS1 OCT 1 ZERO IFF COMND ALLOCATED A CLASS CLWRT OCT 100024 CLASS WRITE ICODE SCHD OCT 100011 SCHEDULE W/WAIT ICODE PL"" ASC 1,PL IO"" ASC 1,IO LO"" ASC 1,LO SS"" ASC 1,SS APLDR ASC 3,APLDR OPERM ASC 3,OPERM MXLEN ABS #OLW-#CMS * * HEADER LENGTH + APPENDAGE WORDS + 1 * HDLEN DEF #MHD+#LSZ+1 END COMND 8*   91750-18050 2013 S C0122 &D$3BF              H0101 HbASMB,Q,N IFN NAM D$3BF,7 91750-1X050 REV.2013 800201 MEF: 304 3K BUF XIF IFZ NAM D$3BF,7 91750-1X051 REV.2013 800201 MEF: 1072 3K BUF XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$3BF,D$RQB SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$3BF *SOURCE: 91750-18050 * RELOC: 91750-1X050 * PGMR: DMT LST ************************** D$3BF ************************* * * * SOURCE: 91750-18050 * * * * BINARY: 91750-1X050 (N-OPTION PART OF $D3KRB) * * (Z-OPTION PART OF $D3KBB) * * * * PROGRAMMER: DAVE TRIBBY * * * * MARCH 24, 1979 * * * ***************************************************************** SPC 2 * BUFFER FOR DS/1000-DS/3000 MASTER REQUEST SUBROUTINE D3KMS. * * DIFFERENT SIZE DATA BUFFERS MAY BE CREATED BY CHANGING "L" AND * RE-ASSEMBLING. TWO SIZES CURRENTLY SUPPORTED: * 304 WORDS (N-OPTION) INSURES AT LEAST 256 WORDS OF DATA * 1072 WORDS (Z-OPTION) INSURES AT LEAST 1024 WORDS OF DATA. SPC 1 IFN L EQU 304 MAXIMUM LINE BUFFER SIZE XIF |   IFZ L EQU 1072 XIF D$RQB DEF D$3BF D$3BF BSS L D3KMS BUFFER END X   91750-18052 2013 S C0122 &D$CON              H0101 WzASMB,Q,N IFN NAM D$CON,7 91750-1X052 REV.2013 800201 MEF: 304 3K BUF XIF IFZ NAM D$CON,7 91750-1X053 REV.2013 800201 MEF: 1072 3K BUF XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$MAX,D$MXR SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$CON *SOURCE: 91750-18052 * RELOC: 91750-1X052 * PGMR: DMT LST ************************** D$CON ************************* * * * SOURCE: 91750-18052 * * * * BINARY: 91750-1X052 (N-OPTION PART OF $D3KRB) * * (Z-OPTION PART OF $D3KBB) * * * * PROGRAMMER: DAVE TRIBBY * * * * APRIL 6, 1979 * * * ***************************************************************** SPC 2 * CONSTANTS FOR DS/1000-DS/3000 COMMUNICATION. * * THESE CONSTANTS CHANGE FOR DIFFERENT BUFFER SIZES. NEW SIZES * CAN BE CREATED BY CHANGING "D" AND "DBL", THEN RE-ASSEMBLING. * TWO VERSIONS ARE CURRENTLY SUPPORTED: * * N OPTION: 256 WORDS DATA PER TRANSFER, MAXIMUM OF 512 * Z OPTION: 1024 WORDS DATA PER TRANSFER, MAXIMUM OF 1024 SPC 1 IFN D EQU 256 }A  DATA PER BLOCK DBL EQU 512 MAXIMUM TOTAL DATA SIZE XIF IFZ D EQU 1024 DBL EQU 1024 XIF L EQU D+48 MAX WORDS/BLOCK (DATA+HEADER) * D$MAX ABS DBL D$MXR ABS L END }   91750-18054 2013 S C0122 &D$EQ2              H0101 [`ASMB,R NAM D$EQT,30 91750-1X054 REV.2013 800527 ALL W/O 3K LINK SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ******************************************************************* SPC 2 ENT D$EQT,D$XS5 * * D$EQT * SOURCE: 91750-18054 * BINARY: 91750-1X054 * D$EQT NOP D$XS5 EQU D$EQT END   91750-18056 2013 S C0122 &D$EQT              H0101 ]ASMB,Q,C HED SLC EQT EXTENSION * (C) HEWLETT-PACKARD CO. NAM D$EQT,30 91750-1X056 REV.2013 790608 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$EQT,D$XS5 SPC 1 * NAME: D$EQT *SOURCE: 91750-18056 * RELOC: 91750-1X056 * PGMR: DMT SPC 1 * T EQU 100 LENGTH OF EQTX EVENT TRACE TABLE. * * EQT EXTENSION BUFFER FOR DVG67. * D$EQT DEF TRFWA+T-1 LAST WORD IN TRACE TABLE. TSBTS OCT 100030 LINE PLEX, REVERSE CHANNEL. (BY "LSTEN") OCT 26 SYNC CHARACTER = ASCII. NTRY NOP # OF RETRIES NLTO NOP # OF 3-SECS IN LONG TIMEOUT PRVAC NOP PREVIOUS & CURRENT ACTIONS PRVST NOP PREVIOUS-1 & PREVIOUS STATES D$XS5 NOP ENVIRONMENT. (BY "LSTEN") LTCS OCT 0 # OF READ REQUESTS. ******************* OCT 0 # OF WRITE REQUESTS. * * OCT 0 # OF MESSAGES TRANSMITTED. * LONG-TERM * OCT 0 # OF ERROR-FREE MSGS RECV. * * OCT 0 # OF LINE ERRORS. * * OCT 0 # OF TIMES NAK RECEIVED. * COMMUNICATION * OCT 0 # OF TIMES BCC/PARITY. * * OCT 0 # OF LONG TIMEOUTS. * * OCT 0 # OF RESPONSE ERRORS. * STATISTICS * OCT 0 # OF TIMES RESPONSE REJ. * * OCT 0 # OF TIMES WACK/TTD RECV. ******************* TRNEW NOP ADDR OF CURRENT ENTRY IN EVENT TRACE. TROLD NOP ADDR OF OLDEST ENTRY IN EVENT TRACE. TRFWA BSS T EVENT TRACE TABLE. * SIZE EQU * END m    91750-18057 2013 S C0122 &D$QBF              H0101 OASMB,Q,N IFN NAM D$QBF,7 91750-1X057 REV.2013 800201 MEF: 304 3K BUF XIF IFZ NAM D$QBF,7 91750-1X058 REV.2013 800201 MEF: 1072 3K BUF XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$WAD,D$RAD,D$WLN SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$QBF *SOURCE: 91750-18057 * RELOC: 91750-1X057 * PGMR: DMT LST ************************** D$QBF ************************* * * * SOURCE: 91750-18057 * * * * BINARY: 91750-1X057 (N-OPTION PART OF $D3KRB) * * (Z-OPTION PART OF $D3KBB) * * * * PROGRAMMER: DAVE TRIBBY * * * * APRIL 10, 1979 * * * ***************************************************************** SPC 2 * BUFFER FOR DS/1000-DS/3000 COMMUNICATIONS PROGRAM QUEX. * * DIFFERENT SIZE DATA BUFFERS MAY BE CREATED BY CHANGING "L" AND * RE-ASSEMBLING. TWO SIZES CURRENTLY SUPPORTED: * 304 WORDS (N-OPTION) INSURES AT LEAST 256 WORDS OF DATA * 1072 WORDS (Z-OPTION) INSURES AT LEAST 1024 WORDS OF DATA. SPC 1 IFN L EQU 304 MAXIMUM LINE BUFFER SIZE XIF f-   IFZ L EQU 1072 XIF * * D$WAD DEF D$WBF ADDRESS OF WRITE BUFFER D$RAD DEF D$RBF ADDRESS OF READ BUFFER * *** DO NOT CHANGE ORDER OF NEXT THREE LINES ****** D$WLN NOP LENGTH OF WRITE BUFR (-BYTES). D$WBF BSS L WRITE BUFFER. D$RBF BSS L READ BUFFER. * END b    91750-18059 2013 S C0122 &D$TST              H0101 bASMB,Q,N IFN NAM D$TST,7 91750-1X059 REV.2013 800201 MEF: 304 3K BUF XIF IFZ NAM D$TST,7 91750-1X060 REV.2013 800201 MEF: 1072 3K BUF XIF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$TST SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$TST *SOURCE: 91750-18059 * RELOC: 91750-1X059 * PGMR: DMT LST ************************** D$TST ************************* * * * SOURCE: 91750-18059 * * * * BINARY: 91750-1X059 (N-OPTION PART OF $D3KRB) * * (Z-OPTION PART OF $D3KBB) * * * * PROGRAMMER: DAVE TRIBBY * * * * APRIL 6, 1979 * * * ***************************************************************** SPC 2 * BUFFER FOR DS/1000-DS/3000 SLAVE REQUEST AND REPLY CONVERTERS. * * DIFFERENT SIZE DATA BUFFERS MAY BE CREATED BY CHANGING "DBL" AND * RE-ASSEMBLING. TWO SIZES CURRENTLY SUPPORTED: * N-OPTION INSURES 512 WORDS OF TOTAL DATA * Z-OPTION INSURES 1024 WORDS OF TOTAL DATA. SPC 1 IFN DBL EQU 512 TOTAL DATA SIZE XIF IFZ DBL EQU 1072 XIF D$TS1  T BSS 14+DBL+25 RQCNV/RPCNV LOCAL TST + ROOM FOR DATA END    91750-18061 2013 S C0122 &D3KBB              H0101 XwASMB,L NAM D3KBB,0 91750-1X061 REV.2013 791026 MEF: 3K LINK, 1072 BFRS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END |   91750-18062 2013 S C0122 &D3KL2              H0101 cgASMB,L NAM D3KL2,0 91750-1X062 REV.2013 791026 MEF W/3K & NO RTE LINKS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END    91750-18063 2013 S C0122 &D3KLB              H0101 dwASMB,L NAM D3KLB,0 91750-1X063 REV.2013 791026 MEF W/ HP 3000 LINK * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END X   91750-18064 2013 S C0122 &D3KMS              H0101 fASMB,Q,C HED D3KMS * (C) HEWLETT-PACKARD CO. NAM D3KMS,7 91750-1X064 REV.2013 800408 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * PRIMARY ENTRY POINTS: ENT D3KMS,PRCNM,ICC,D$ABT * SUBROUTINES TO MANAGE APPENDAGE: ENT D$INI,D$STW,D$PRM,D$NWD,D$ASC,D$ZRO ENT D$IPM,D$NPM,D$SPM * GLOBAL DATA WORDS: ENT D$SMP,D$LOG,D$INP,D$BRK,D$CTY,D$ECH,D$ERR,D$TAG SPC 1 EXT .ENTR,.DFER,.MVW,$OPSY EXT EXEC,REIO,IFBRK,IFTTY,LUTRU,LOGLU,RNRQ,CNUMO EXT #LDEF,#QRN,#TBRN,#RSAX,#QXCL,#MSTO EXT D$3BF,D$RQB,D$BSZ,D$MXR SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D3KMS *SOURCE: 91750-18064 * RELOC: 91750-1X064 * PGMR: DMT LST ************************** D3KMS ************************* * * * SOURCE: 91750-18064 * * * * BINARY: 91750-1X064 * * * * PROGRAMMER: JIM HARTSELL * * * * AUGUST 11, 1975 * * * *---------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING OCTOBER 30, 1978 * * "= FOR DS/1000 ENHANCEMENTS AND SESSION COMPATIBILITY * * * ***************************************************************** SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SUP SKP * D3KMS PROVIDES THE MASTER REQUESTOR WITH AN INTERFACE TO AN * HP3000 REMOTE COMPUTER. ALL REQUESTS ARE SENT TO THE 3000 * LU, AND MPE PROCESS NUMBER, WHICH WERE DEFINED IN THE PREVIOUS * CALL TO HELLO. D3KMS WRITES THE REQUESTS TO THE QUEX I/O CLASS, * WHICH QUEX RETRIEVES VIA CLASS I/O GET CALLS PRIOR TO TRANSMISSION. * D3KMS IS THE COUNTERPART OF THE DS/1000 #MAST SUBROUTINE. * * D3KMS BLOCKS THE REQUESTS AND DATA INTO PROPERLY SIZED CHUNKS FOR * TRANSMISSION TO QUEX. D3KMS'S BUFFER AND THE BUFFER SIZE ARE DEFINED * IN THE APPENDED MODULE D3KBF. * * IT IS THE RESPONSIBILITY OF THE ROUTINE CALLING D3KMS TO SET * D$3BF TO THE DS/3000 CLASS * D$3BF+2 TO THE DS/3000 STREAM * AND ALL PARAMETERS THAT ARE PASSED IN THE APPENDAGE. THE APPENDAGE * PARAMETERS AND BYTE COUNT WORD (HEADER WORD 7) ARE SET UP BY THE * CALLER USING THE FOLLOWING SUBROUTINES: * D$INI D$STW D$PRM D$NWD D$ALC D$ZRO * (THESE ARE EXPLAINED IN THE LISTING). * * D3KMS CALLING SEQUENCE: * JSB D3KMS * DEF * DEF CONWD CONTROL WORD (SEE BELOW). * DEF SNDBF "SEND" BUFFER [OPTIONAL] * DEF SNDLN "SEND" LENGTH [OPTIONAL] * DEF RCVBF "RECEIVE" BUFFER [OPTIONAL] * DEF RCVLN "RECEIVE" LENGTH [OPTIONAL] * RETURN HERE UPON ERROR DETECTION. * NORMAL RETURN. * * IF NEITHER SEND NOR RECEIVE DATA IS EXPECTED, CALL WITH * JSB D3KMS * DEF *+2 * DEF CONWD * * IF SEND BUT NOT RECEIVE DATA IS EXPECTED, CALL WITH * JSB D3KMS * DEF *+4 * DEF CONWD * DEF SNDBF * DEF SNDLN <+WORDS OR -BYTES>s * (SNDBF AND SNDLN WILL GENERALLY BE USER PARAMETERS, INDIRECT.) * * IF RECEIVE BUT NOT SEND DATA IS EXPECTED, CALL WITH * JSB D3KMS * DEF *+6 * DEF CONWD * DEF 0 * DEF 0 * DEF RCVBF * DEF RCVLN <+WORDS OR -BYTES> * SPC 2 * IN CONWD * BIT 15 - ERROR-RETURN FLAG (NO-ABORT BIT). * BIT 14 - LONG TIMEOUT. SPC 1 * D3KMS ERROR PROCESSING: * * 1. IF SIGN BIT (15) OF CONTROL WORD IS SET, ASCII ERROR CODES * ARE SUPPLIED TO THE CALLER IN THE A & B REGISTERS, UPON * RETURN TO THE POINT IN THE CALLING SEQUENCE. * * 2. IF THE SIGN BIT IS NOT SET, THEN THE CALLER'S PROGRAM IS * ABORTED, AFTER PRINTING AN ERROR MESSAGE ON THE SYSTEM * CONSOLE. THE MESSAGE PRINTED WILL CONTAIN THE ADDRESS OF THE * USER'S RETURN FROM D3KMS. * * D3KMS ERROR MESSAGES: * * "DS00" - LOCAL SYSTEM IS NOT INITIALIZED. * "DS01" - DS/3000 LINK NOT INITIALIZED OR SHUT DOWN. * "DS05" - TIMEOUT. * "DS06" - ILLEGAL REQUEST. * "DS07" - "RES" LIST ACCESS ERROR. * * * EXIT CONDITIONS: A-REG = STATUS WORD. * B-REG = NUMBER OF BYTES READ. SPC 3 * * USER-CALLABLE ENTRY POINTS: * SPC 1 * INTEGER FUNCTION ICC: RETURNS CONDITION CODE FROM LAST 3000 CALL. * * ICC = -1 IF CCL (01) CONDITION CODE (A LA HP3000) FOR EVERY REPLY. * = 0 IF CCE (10) " * = 1 IF CCG (00) " SPC 1 * SUBROUTINE PRCNM: SET SESSION NUMBER FROM "FATHER." * * CALL PRCNM(SESNO) * WHERE SESNO IS THE NEGATIVE SESSION NUMBER FROM FATHER'S HELLO. SKP *** OFFSETS INTO DS/3000 BUFFER *** BUF EQU D$3BF CLS EQU 0 CLASS WORD STR EQU 2 STREAM WORD PRC EQU 4 PROCESS # WORD SEQ EQU 5 RTE SEQ # WORD BYT EQU 7 BYTE COUNT WORD APN EQU 8 FIRST WORD OF APENDAGE SPC 2 * FIRST ENTRY. CLEAR PARAMETERS IN CASE SOME ARE NOT PROVIDED, THEN * MAKE "DUMMY#D" ENTRY TO PICK THEM UP AT "BEGIN." D3KMS NOP CLA CLEAR ADDRESSES. STA CONWD STA SNDBF STA SNDLN STA RCVBF STA RCVLN LDA D3KMS SET ADDRESS STA RETRN FOR .ENTR JMP BEGIN THEN CALL. SPC 1 CONWD NOP CONTROL WORD ADDRESS. SNDBF NOP SEND BUFFER SNDLN NOP SEND LENGTH RCVBF NOP RECEIVE BUFFER RCVLN NOP RECEIVE LENGTH RETRN NOP * BEGIN JSB .ENTR OBTAIN DIRECT ADDRESSES DEF CONWD FOR PARAMETERS & RETURN POINT. * CLA LDA SNDLN,I GET SEND LENGTH. SSA CHECK SIGN-- CMA,INA,RSS NEG: MAKE POSITIVE CLE,ELA POS: DOUBLE STA SNDLN SAVE BYTE LENGTH AS LOCAL VAR. * CLA LDA RCVLN,I GET MAX RECEIVE LENGTH. SSA,RSS CHECK SIGN-- JMP COMPL CMA,INA NEG: MAKE POS INA WORD COUNT. CLE,ERA COMPL CMA,INA MAKE NEGATIVE WORD COUNT STA RCVLN AND SAVE AS LOCAL VARIABLE. * CLB CLEAR STB BRFLG BREAK FLAG AND STB OEFLG OUTPUT ERROR FLAG STB PRFLG AND PROMPT FLAG STB RTNLN AND # BYTES RETURNED STB BLK#1 AND FIRST BLOCK FLAG STB PCLSF AND PCLOSE FLAG. * LDA BUF+CLS SAVE THE ALF,ALF CLASS & IOR BUF+STR STREAM. STA OCLST CPA C7S21 IF CLASS 7 & STREAM 21, RSS CHECK FOR PCLOSE. JMP LDSZ LDA BUF+BYT IF BYTE COUNT CPA D12 IS 12, SET STA PCLSF PCLOSE FLAG. * * USE MINIMUM OF D$BSZ (CONFIGURED LINE SIZE, SET BY QUEX) AND * D$MXR (ACTUAL BUFFER SIZE APPENDED) FOR SENDING/RECEIVING DATA. * IF D$BSZ > D$MXR, THE 3000 MAY SEND TOO MUCH ON A READ REQUEST. * LDSZ LDA D$BSZ SUBTRACT D$BSZ CMA,INA FROM D$MXR. IF ADA D$MXR RESULT > 0 USE D$BSZ. LDB D$BSZ IF < 0, USE D$MXR. SSA LDB D$MXR STB BUFSZ SAVE BUFFER SIZE LOCALLY. CMB,INB CALCULATE NEGATIVE STB NBFSZ FOR FUTURE USE. * LDA $OPSY IS THIS A MAPPED SYSTEM? RAR,SLA RSSI RSS YES. JMP NEWRQ NO. LDB RSSI GET "RSS" INSTRUCTION. STB MODI2 MODIFY TO DO CROSS-MAP LOAD. * * A NEW REQUEST IS READY TO GO TO THE HP3000. CHECK FOR * LOCAL SYSTEM SHUT-DOWN OR QUIESCENT STATUS. * (CONTINUATION REQUESTS WILL NOT COME THRU HERE.) * NEWRQ LDA #QRN GET THE QUIESCENT/SHUTDOWN RN. SZA,RSS IS THE SYSTEM SHUT DOWN? JMP DOWN YES. GO TELL CALLER. * * NEW REQUESTS WILL BE FORCED TO WAIT HERE * IF LOCAL SYSTEM HAS BEEN QUIESCED. * JSB RNRQ GO TO RTE TO CHECK FOR QUIESCENCE. DEF *+4 DEF LCGW LOCK/CLEAR/WAIT/NO-ABORT. DEF #QRN SYSTEM-QUIESCENCE RESOURCE NUMBER. DEF TEMP DUMMY PARAMETER. JMP PASER * RTE ERROR - PASS CODE TO CALLER * * LDA #QRN IF QUIESCENT STATE HAS BEEN CHANGED SZA,RSS TO SYSTEM SHUT-DOWN STATE, JMP DOWN THEN TELL THE CALLER. * * * GET A CLASS NUMBER FOR THIS REQUEST. * LDA BIT13 CLEAR CLASS # AND SET BIT 13 STA CLASN FOR NON-RELEASE USAGE. * JSB EXEC GO TO RTE FOR A CLASS NO.---WAIT FOR IT. DEF *+5 DEF CLS19 CLASS CONTROL(QUICK ALLOCATE)- NO ABORT. DEF D0 LU = "BIT BUCKET" FOR ALLOCATION. DEF D0 DUMMY PARAMETER. DEF CLASN CLASS NUMBER STORAGE ADDRESS. JMP PASER * RTE ERROR: MESSAGE IN A & B * * JSB EXEC GO TO RTE TO COMPLETE DEF *+5 PREVIOUS ALLOCATION REQUEST. DEF CLS21 CLASS GET - NO ABORT. DEF CLASN CLASS NUMBER STORAGE ADDRESS. DEF D0 DUMMY. DEF D0 DUMMY. JMP PASER * RTE ERROR: MESSAGE IN A & B * * * CLEAR WORDS 1, 3, AND 6 OF HEADER. CLA STA D$3BF+1 STA D$3BF+3 STA D$3BF+6 * * ADD INPUT LU TO REQUEST AS "FROM PROCESS #." * JSB LUTRU GET "REAL" INPUT DEF *+3 LU NUMBER. DEF D$INP DEF TEMP LDA TEMP STORE INPUT LU IN AND B377 "FROM PROCESS #". ALF,ALF STA BUF+PRC * * USE MPE PROCESS NUMBER RETRIEVED FROM "HELLO" AS THE * "TO PROCESS #". IF ZERO, THIS MUST BE A HELLO COMMAND. * LDA D$SMP GET SESSION NUMBER. AND B377 IOR BUF+PRC STA BUF+PRC LDB OCLST CPB C6S20 IF NOT HELLO, JMP SETWD AND B377 SZA,RSS AND SESSION # IS ZERO, JMP ILRQ IT IS AN ILLEGAL REQUEST. * * VERIFY THAT SMP # IS GOOD BY SEARCHING PNL. SEND CCB ADDR OF PNL HEADER ADDRESS. ADB #LDEF LDB B,I GET ADDR OF FIRST ENTRY. STLST SZB,RSS END OF LIST? JMP NTFND YES. SMP # NOT FOUND. JSB LODWD GET NEXT ADDR. STA NXTAD SAVE NEXT ADDRESS. ADB D5 POINT TO SMP WORD. JSB LODWD LOAD. CPA D$SMP OURS? JMP SETWD YES! OK TO SEND. LDB NXTAD GET NEXT ADDR. JMP STLST GO CHECK NEXT ENTRY. * * SMP NOT FOUND IN LIST. (LINE WAS PROBABLY RE-ENABLED.) NTFND STB D$SMP SET SMP # TO 0. JMP ILRQ REPORT ILLEGAL REQUEST. * NXTAD NOP SPC 1 * SETWD JSB STWDC SET WORD COUNT IN CLASS WORD. * * MOVE "SEND" DATA, IF NECESSARY. * CLA CLEAR MOVE STA MVLEN LENGTH. LDA BUF+CLS CALCULATE NUMBER ALF,ALF OF WORDS IN AND B377 HEADER & APPENDAGE. STA H&ALN LDB SNDLN IF NO DATA SZB,RSS TO SEND, JMP STBLN SKIP THE MOVE. ADA NBFSZ CALCULATE NEG NUMBER STA SPCAV WORDS LEFT IN BUFFER. INB SUBTRACT;R FROM NUM OF CLE,ERB WORDS TO SEND. ADA B SZA SSA IF A-REG NEGATIVE, JMP LENOK ENTIRE BUFFER WILL FIT. * * SET UP FOR CONTINUATION WRITE. * LDA SPCAV SET THE MOVE CMA,INA LENGTH TO STA MVLEN SPACE AVAILABLE. CLE,ELA ADD # BYTES STA TEMP TO BYTE COUNT. ADA BUF+BYT STA BUF+BYT LDA TEMP SUBTRACE # OF CMA,INA BYTES MOVED ADA SNDLN FROM TOTAL STA SNDLN LENGTH. LDA BUF+STR SET CONTINUATION AND B377 BIT IN STREAM IOR BIT13 WORD. MAKE SURE STA BUF+STR OTHERS AREN'T. JMP MVDAT GO MOVE DATA. * * ENTIRE BUFFER FITS--NO CONTINUATION. * LENOK STB MVLEN SET MOVE LENGTH. LDA BUF+BYT ADD # BYTES ADA SNDLN TO BYTE COUNT STA BUF+BYT IN HEADER. CLA SET REMAINING STA SNDLN LENGTH TO 0. LDA BUF+STR INSURE AND B377 UNWANTED BITS STA BUF+STR ARE NOT SET. * * ALL SET TO MOVE "SEND" DATA. * MVDAT LDA SNDBF SOURCE ADDR. LDB D$RQB ADB H&ALN DESTINATION. JSB .MVW MOVE THE DEF MVLEN WORDS. NOP STA SNDBF UPDATE SOURCE PNTR. * * SET WORD LENGTH OF CLASS I/O WRITE TO QUEX. * STBLN LDA BUF+BYT GET BYTE COUNTER. INA CLE,ERA MAKE WORD COUNT. ADA D8 ADD FIXED FORMAT LENGTH. STA BUFL STORE REQUEST LENGTH. * * WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN "RES"; ADD NEW ENTRY. * SEND1 LDA #QXCL GET QUEX I/O CLASS. SZA,RSS JMP NINIT DS/3000 NOT INITIALIZED. SSA JMP NINIT DS/3000 DISCONNECTED. * JSB RNRQ CHECK TABLE-ACCESS RN. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT/NO ABORT. DEF #TBRN TABLE-ACCESS SPACE-AVAILABLE RN. DEF TEMP DUMMY. JMP PAH.SER * RTE ERROR - PASS ERROR CODE TO USER * * LDA CONWD,I RAL,ELA BIT 14 HAS TIMEOUT SUPPRESS FLAG. LDA CLASN RAL,ERA MOVE FLAG TO BIT 15 OF CLASS WORD. STA TEMP * LDA #MSTO SET UP IOR BIT14 TIMEOUT STA TEMP1 WORD. * JSB #RSAX GO TO "RES" ACCESS ROUTINE. DEF *+6 DEF D2 ADD A MASTER ENTRY. DEF TEMP CLASS # AND TIMEOUT FLAG. DEF D0 DUMMY M.A. SEQ #. DEF D0 DUMMY DESTINATION NODE. DEF TEMP1 TIMEOUT WORD. SSB ANY ERRORS? JMP RESER * ERROR: "DS07" (NOT LIKELY) * * STA BUF+SEQ STORE SEQ # IN REQUEST. STA SEQ# SAVE LOCALLY. * LDA BRFLG IF CONTROL-Y SZA,RSS BREAK IS JMP CLSWR BEING SENT, LDA SEQ# STORE SEQ # IN STA YSEQ#,I CONTROL-Y REQUEST. CLA CLEAR STA BRFLG BREAK FLAG. * * SEND REQUEST TO HP 3000 BY WRITING IT TO THE QUEX I/O CLASS * CLSWR JSB EXEC DEF *+8 DEF CLS20 DEF D0 DEF D$3BF DEF BUFL DEF BUFL PASS LENGTH FOR "GET" (WORDS). DEF D0 DEF #QXCL QUEX I/O CLASS. JMP PASER * RTE ERROR - PASS CODE TO CALLER * * JMP WAIT NO. * * ISSUE A CLASS GET TO USER'S CLASS TO WAIT FOR A REPLY. * USER WILL BE SUSPENDED UNTIL REPLY ARRIVES. * WAIT LDA BUFSZ STA BUFL * JSB EXEC GO TO RTE TO GET THE REPLY. DEF *+5 DEF CLS21 CLASS GET - NO ABORT. DEF CLASN MASTER CLASS NO. -- NO RELEASE. DEF D$3BF REPLY ADDRESS. DEF BUFL REPLY LENGTH. JMP PASER * RTE ERROR: MESSAGE IN A & B * STB TEMP SAVE T/O INDICATOR. * JSB #RSAX RELEASE DEF *+3 MASTER DEF D6 T.C.B. DEF SEQ# * * CHECK FOR PROPER REPLY. * LDB TEMP 'SZB,RSS CHECK FOR ZERO REPLY LENGTH. JMP MTOER YES. GO PROCESS TIMEOUT ERROR. * LDA BUF+STR CHECK REJECT BIT. RAL SSA JMP ILRQ REQUEST REJECTED. * SPC 1 * GO CHECK IF A $STDLIST OR $STDIN WAS RECEIVED. IF NOT, * CONTROL WILL BE RETURNED. IF YES, THE PRINT OR READ WILL BE * PROCESSED, A REPLY WILL BE BUILT, AND CONTROL WILL GO TO "SEND". * JSB PRTRD GO CHECK FOR PRINT/READ REQUEST. * LDA BLK#1 IF FIRST BLOCK IN RETURN, SZA JMP CKNOR ISZ BLK#1 SET THE FLAG. LDA BUF+APN SAVE STATUS WORD STA STATS FROM APPENDAGE. * LDA OCLST IF IT'S THE CPA C4S22 FIRST PREAD RSS REPLY, JMP CKNOR LDA D$RQB SAVE TAG ADA D13 WORDS IN LDB D$TAG TEMPORARY JSB .MVW AREA. DEF D20 NOP * * MOVE "RECEIVE" DATA, IF NECESSARY. * CKNOR LDB RCVBF IF NO RETURN SZB,RSS DATA EXPECTED, JMP CKCNT SKIP THE MOVE. **** NOTE: B-REG CONTAINS DESTINATION ADDRESS FOR MOVE! *** LDA BUF+CLS CALCULATE NUM ALF,ALF OF WORDS IN AND B377 HEADER & STA H&ALN APPENDAGE. ADA N8 CALCULATE CLE,ELA NUMBER OF CMA,INA DATA BYTES ADA BUF+BYT RETURNED. STA TEMP INA CONVERT TO CLE,ERA WORDS. SZA,RSS IF ZERO, JMP CKCNT SKIP MOVE. STA MVLEN SAVE MOVE LENGTH. ADA RCVLN IF MOVE WOULD SZA STAY WITHIN SSA LIMIT, JMP UPRTN READY TO DO IT. * * MORE DATA RETURNED BY 3000 THAN REQUESTED * LDA RCVLN IF NO ROOM LEFT SZA,RSS IN USER'S BUFFER, JMP CKCNT SKIP THE MOVE. CMA,INA MAKE POSITIVE WORDS. STA MVLEN SET MOVE LENGTH. CLE,ELA a CONVERT TO STA TEMP BYTES & SAVE. CLA * UPRTN STA RCVLN UPDATE # WORDS IN USER BUF. LDA RTNLN UPDATE ADA TEMP RETURN LENGTH STA RTNLN COUNTER. * LDA D$RQB ADA H&ALN SOURCE ADDRESS. **** NOTE: B-REG ALREADY LOADED WITH DESTINATION ADDR. *** JSB .MVW MOVE DATA DEF MVLEN TO USER. NOP STB RCVBF UPDATE RECEIVE POINTER. * CKCNT LDA BUF+STR IF CONTINUATION AND BIT13 BIT NOT SET, SZA,RSS JMP EXIT NO MORE DATA. * LDA BUF+STR ELA,CLE,ERA CLEAR REPLY BIT. STA BUF+STR LDA BUF+PRC REVERSE ALF,ALF PROCESS STA BUF+PRC NUMBERS. LDA OCLST CLB APPENDAGE LENGTH IS CPA C4S23 0 FOR ALL EXCEPT LDB D10 PWRITE (THEN 10 BYTES). STB BUF+BYT JMP SEND SEND NEXT BLOCK. SPC 1 * * DE-ALLOCATE THE USER'S CLASS NUMBER. * EXIT JSB CLNUP GO CLEAN UP BEFORE EXIT. * * STORE CONDITION CODE IN ICC AND RETURN TO * CALLER WITH (A) = STATUS WORD. * (B) = NO BYTES RETURNED. * LDB OEFLG WAS THERE AN OUTPUT ERROR? SZB JMP PSER1 YES! LDA BUF+APN GET STATUS WORD. LDB RCVBF IF RECEIVE BUFFER WAS SZB,RSS EXPECTED, STATS HAS STA STATS ALREADY BEEN SET. LDA STATS ALF,ALF AND D3 IF CC IS: SET ICC TO: CPA D1 CCB 01 (CCL) -1 CPA D2 CLB 10 (CCE) 0 SZA,RSS CLB,INB 00 (CCG) +1 STB ICCC * LDA STATS GET RETURN STATUS WORD. LDB RTNLN GET TOTAL NUMBER OF BYTES RETURNED. ISZ RETRN SET EXIT POINTER FOR NORMAL RETURN. JMP RETRN,I RETURN. SPC 3 BUFSZ NOP BUFFER SIZE NBFSZ NOP NEGATIVE OF BUFSZ SKP * * SUBROUTINE TO PROCESS $S!TDLIST OR $STDIN "REQUESTS" THAT * MAY HAVE BEEN RECEIVED AS A "REPLY" FROM THE 3000. * PRTRD NOP LDA BUF+CLS AND B377 CHECK FOR MESSAGE CLASS 5 CPA D5 ($STDLIST, $STDIN, OR FCONTROL). RSS JMP PRTRD,I NOT PRINT/READ. RETURN. LDA BUF+STR SSA CHECK IF IT IS A REQUEST. JMP PRTRD,I NO... REPLY, SO LET IT THROUGH. * LDA BUF+STR GET STREAM WORD. AND B77 ISOLATE STREAM TYPE. CPA B20 JMP MESG STREAM 20 IS $STDLIST "REPLY". CPA B21 STREAM 21 IS $STDIN "REQUEST". JMP STDIN CPA B23 IF NOT FCONTROL, RSS JMP PRTRD,I JUST IGNORE. SPC 2 * * FCONTROL REQUEST. SEE IF IT'S ONE WE CAN REALLY ACT UPON. * LDA BUF+APN+1 CHECK FOR UNRECOGNIZED CONTROL CHAR: ADA N12 SSA JMP SETPR < 12: NO GOOD. STA TEMP ADA N6 SSA JMP USTBL 12 TO 17: USE TABLE. * LDA BUF+APN+1 CHECK FOR VALID FUNCTIONS > 17. CPA D39 FCONTROL 39-- JMP SETYP SET TERMINAL TYPE. CPA D41 FCONTROL 41-- JMP RDSTP READ STRAPS. JMP SETPR NOT VALID. JUST REPLY. * USTBL LDA CTABL GET ADDRESS ADA TEMP OF ACTION SUBROUTINE. JMP A,I GO DO IT. * CTABL DEF *+1 TABLE FOR FCONTROL SUBROUTINES. JMP ECHON 12: SET $STDIN ECHO ON JMP ECHOF 13: SET $STDIN ECHO OFF JMP DSBRK 14: DISABLE "BREAK" JMP ENBRK 15: ENABLE "BREAK" JMP DSCTY 16: DISABLE "CONTROL-Y" JMP ENCTY 17: ENABLE "CONTROL-Y" * * FUNCTIONS 12 & 13 * ECHON LDA B600 SET "ECHO INPUT" RSS IN CONTROL WORD. ECHOF CLA CLEAR "ECHO INPUT" STA D$ECH IN CONTROL WORD. JMP SETPR * * FUNCTIONS 14 & 15 * DSBRK CLA DISABLE "BREAK" RSS CHECK FLAG. ENBRK CCA _ENABLE "BREAK" STA D$BRK CHECK FLAG. JMP SETPR * * FUNCTIONS 16 & 17 * DSCTY CLA DISABLE "CONTROL-Y" RSS CHECK FLAG. ENCTY CCA ENABLE "CONTROL-Y" STA D$CTY CHECK FLAG. JMP SETPR * * * FUNCTION 39 * SETYP JSB IFTTY SET TERMINAL TYPE BY DEF *+2 CHECKING RTE DRIVER DEF D$LOG TYPE. SZA,RSS NON-INTERACTIVE. JMP STAPN RETURN TYPE=0. LDA B IF DRIVER ALF,ALF IS 5 AND B77 CLB CPA D5 LDB D10 USE 10. CPA D7 IF 7 (MULTIPOINT), LDB D14 USE 14. LDA B (OTHERWISE USE 0.) JMP STAPN STORE IN APPENDAGE. * * * FUNCTION 41 * ON MPE THIS SETS UNEDITED TERMINAL MODE. * FOR RTE, TELL DRIVER TO CHECK TERMINAL STRAPS. * RDSTP JSB IFTTY IF INPUT DEF *+2 LU IS NOT DEF D$INP INTERACTIVE, SSA,RSS JMP SETPR JUST REPLY. * LDA B ISOLATE ALF,ALF TERMINAL AND B377 TYPE. CPA D5 IF NOT TYPE 5, RSS JMP SETPR JUST REPLY. * LDA D$INP MAKE I/O CONTROL IOR B700 REQUEST 7, STA CNWRD WHICH CLEARS STATUS JSB EXEC BIT 3 FOR A NORMAL DEF *+3 DV.05 TERMINAL, DEF SD3 BUT SETS IT FOR MUX. DEF CNWRD NOP JSB EXEC GET STATUS WORD. DEF *+4 DEF D13 DEF D$INP DEF TEMP LDB B2500 ASSUME IT'S NORMAL. LDA TEMP ISOLATE BIT AND B40 3 OF STATUS. SZA IF IT'S SET LDB B3200 TERMINAL IS A MUX. LDA D$INP SET UP CONTROL WORD IOR B TO READ STRAPS. STA CNWRD JSB EXEC TELL DRIVER DEF *+3 TO CHECK DEF SD3 THE STRAPS. DEF CNWRD JSB OERR (ABORT RETURN.) * JMP SETPR SEND REPLY. * SETPR LDA BUF+APN+2 MOVE PARAM STAPN STA BUF+APN+1 WORD. LDA D4 SET BYTE STA BUF+BYT LEN WORD. JMP NEXT1 SPC 1 N12 DEC -12 N6 DEC -6 D39 DEC 39 D41 DEC 41 SKP * * WE HAVE A REQUEST FROM THE HP 3000 FOR INPUT FROM A * USER TERMINAL (PREVIOUS $STDLIST SHOULD HAVE * PROVIDED A PROMPT MESSAGE OR CHARACTER). * STDIN LDA BUF+PRC CHECK FOR SPECIAL "FEATURE" ON AND UP377 MPE-III. A $STDIN REQUEST FROM SZA,RSS SESSION 0 OCCURS WHEN A BAD JMP EXIT ACCOUNT IS USED FOR HELLO. * LDA D$INP SET "ECHO INPUT" BIT IOR D$ECH IF FLAG IS SET. STA CNWRD * * CHECK WHETHER WE NEED TO REWRITE PREVIOUS $SDTLIST BY CHECKING: * D$INP <> D$LOG AND PROPMT FLAG = TRUE AND D$INP IS INTERACTIVE. LDA D$INP IF D$INP = CPA D$LOG D$LOG, JMP RDLIN GO READ. LDA PRFLG IF PROMPT SZA,RSS IS ZERO, JMP RDLIN GO READ. JSB IFTTY IF D$INP DEF *+2 IS NOT DEF D$INP INTERACTIVE, SZA,RSS JMP RDLIN GO READ. * JSB REIO REPEAT DEF *+5 PROMPT DEF SD2 ON DEF CNWRD INPUT DEF ORCRD DEVICE. DEF OLDLN NOP IGNORE ERRORS. CLA CLEAR PROMPT STA PRFLG FLAG. * RDLIN LDA BUF+APN+2 GET PARAMETER WORD. AND B100 IF "SPECIAL READ" SZA,RSS BIT ISN'T SET, JMP DOREA GO DO THE READ. * * FOR SPECIAL BLOCK MODE READ, DO A DUMMY READ AND HOME THE CURSOR. * LDA D$INP STORE LU IN CNWRD STA CNWRD WITHOUT FUNCTION BITS. JSB REIO DUMMY READ. DEF *+5 DEF SD1 DEF CNWRD DEF BUF+APN+2 DEF BUF+APN CLB SZB,RSS IF 1ST CHAR IS JMP HOCUR ESCAP.E (AND DATA LDA BUF+APN+2 WAS ACTUALLY READ) AND UP377 ASSUME IT'S FROM A CPA ESC SOFT KEY & USE IT. JMP GTRLN HOCUR JSB REIO HOME CURSOR DEF *+5 AND RE-READ DEF SD2 THE SCREEN. DEF CNWRD DEF HCENT DEF N5 NOP * DOREA JSB REIO READ FROM USER TERMINAL. DEF *+5 DEF SD1 DEF CNWRD DEF BUF+APN+2 DEF BUF+APN (+ = WORDS, - = BYTES) CLB INPUT ERROR: SET B:=0. * GTRLN LDA BUF+APN (B) = POS. BYTES OR POS. WORDS INPUT. SSA,RSS IF $STDIN SPECIFIED POS. WORDS, BLS MAKE (B) = POS. BYTES. * LDA B IF # BYTES IS ADA N3 SSA,RSS ONE OR TWO, JMP REPLY LDA BUF+APN+2 AND INPUT WORD = BLANKS, CPA BLNKS CLB SET 0-LEN REPLY MESSAGE. * REPLY ADB D4 COUNT CONTROL & LENGTH WORDS. STB BUF+BYT STORE TOTAL REPLY BYTE LENGTH. * ADB N4 RESTORE POS. BYTE LEN OF INPUT. LDA BUF+APN SSA IF $STDIN SPECIFIED NEG. BYTES, CMB,INB,RSS MAKE (B) = NEG. BYTES, BRS ELSE MAKE (B) = POS. WORDS. STB BUF+APN+1 STORE NEG. BYTE OR POS. WORD COUNT. * CLA,INA SET STATUS WORD. JMP NEXT2 SKP * * WE HAVE A $STDLIST MESSAGE FROM THE HP3000. * DISPLAY ON USER-SPECIFIED LOG DEVICE. * MESG LDA PCLSF IF WITHIN PCLOSE, SZA DON'T PRINT MESSAGE: JMP NEXT "END OF REMOTE PROGRAM." LDA OEFLG SKIP OUTPUT SZA IF OUTPUT ERROR JMP NEXT FLAG IS SET. STA SKIP CLEAR SKIP FLAG. LDA BUF+BYT GET BYTE LENGTH. ADA N4 OMIT CONTROL WORDS FROM COUNT. CMA,INA NEGATE MESSAGE BYTE LENGTH. STA BUFL SAVE NEGATIVE LENGTH. * * CHECK FOR SPECIAL BLOCK MODE FOR MULTIPOINT. LDA BUF+APN+1 ISOLATE "SPE~CIAL BLOCK AND B100 MODE" INDICATION BIT. SZA,RSS IF NOT SET, JMP REGWR IT'S A REGULAR WRITE. * JSB IFTTY GET TERMINAL DEF *+2 TYPE. DEF D$LOG LDA B ALF,ALF AND B377 IF IT'S TYPE CPA D7 7 (MULTIPOINT), RSS JMP REGWR LDA B100 SET 100B BIT JMP DOWRT IN CONTROL WORD. * REGWR LDA BUF+APN GET FORMS CONTROL WORD. AND B377 JSB CNTRL PROCESS FORMS CONTROL. * LDA B600 SET "ECHO INPUT" & DOWRT IOR D$LOG "PRINT COL 1" BITS. STA CNWRD JSB REIO DISPLAY THE MESSAGE. DEF *+5 DEF SD2 DEF CNWRD BUFA DEF BUF+APN+2 DEF BUFL JSB OERR OUTPUT ERROR. * * SAVE OUTPUT LINE FOR POSSIBLE RE-PROMPT. * LDA BUFL IGNORE SZA,RSS WRITES WITH JMP NEXT NO DATA. STA OLDLN SAVE LENGTH. CMA,INA GET INA POSITIVE CLE,ERA NUMBER STA TEMP OF WORDS. ADA N40 DON'T SSA LET JMP MVBUF LENGTH LDA N80 GO STA OLDLN OVER CMA,INA 40. CLE,ERA STA TEMP MVBUF LDA BUFA MOVE LDB @ORCD THE JSB .MVW BUFFER. DEF TEMP NOP CCA PROMPT FLAG STA PRFLG := TRUE. * LDA SKIP IF SKIP-LINE-AFTER-PRINT SZA,RSS FLAG IS SET, JMP NEXT * JSB REIO PRINT A BLANK DEF *+5 LINE. DEF SD2 DEF D$LOG DEF BLNKS DEF N1 JSB OERR OUTPUT ERROR. CLA CLEAR SKIP FLAG. STA SKIP * * BUILD A REPLY FOR THE $STDLIST/$STDIN/FCONTROL REQUEST. * NEXT LDA D2 SET BYTE COUNT TO 2 STA BUF+BYT FOR $STDLIST. NEXT1 LDA CCE NEXT2 STA BUF+APN STORE STATUS WORD. LDA BUF+STR 0SET REPLY BIT. IOR BIT15 STA BUF+STR LDA BUF+PRC REVERSE PROCESS NUMBERS. ALF,ALF STA BUF+PRC JSB STWDC STORE WORD COUNT. * JSB BRKCK CHECK FOR OPERATOR BREAK. JMP BREAK YES. GO BUILD BREAK REQUEST. JMP STBLN SEND REPLY. * SKIP NOP SKIP-AFTER-PRINT FLAG. SKP * * ADD BREAK OR CONTROL-Y REQUEST TO END OF $STDLIST/$STDIN * REPLY BEFORE SENDING TO QUEX. (P.PTR POINTS TO WHERE TO * START BUILDING THIS ADDITIONAL REQUEST.) * BREAK STB BRFLG SAVE STREAM TYPE FROM "BRKCK". LDA BUF+BYT SAVE BYTE COUNT FROM 1ST BLOCK. STA TEMP2 INA SET P.PTR TO END OF REPLY. CLE,ERA ADA D8 ADA D$RQB STA P.PTR LDA MSGCL STORE WDCNT/MESSAGE CLASS. JSB D$STW CLA JSB D$STW LDA BRFLG STORE STREAM TYPE. JSB D$STW CLA JSB D$STW LDA BUF+PRC STEAL "FROM/TO" FROM 1ST BLOCK. JSB D$STW LDA P.PTR SAVE CONTROL-Y STA YSEQ# SEQ # ADDR. JSB D$STW CLA JSB D$STW CLA STA P.PTR,I CLEAR BYTE COUNT WORD. LDA TEMP2 RESTORE BLOCK 1 BYTE COUNT. STA BUF+BYT * ISZ P.PTR SET UP BUFL FOR CLASS WRITE. LDA D$RQB CMA,INA ADA P.PTR STA BUFL * JMP SEND1 WRITE TO QUEX (INCLUDE MASTER TCB). * MSGCL OCT 4006 YSEQ# NOP SKP * * SUBR. TO MAP HP3000 MPE FORMS CONTROL TO RTE. * (A) = FORMS CONTROL WORD. * CNTRL NOP STA TEMP FORMS CONTROL WORD. CPA B60 IF OCTAL 60, JMP DBLSP GO SET DOUBLE SPACE. AND B300 SKIP N CPA B200 LINES? JMP SKIPN YES. JSB IFTTY IF LU DEF *+2 TYPE IS DEF D$LOG NON-INTERACTIVE, SZA,RSS JMP CNTRL,I DON'T TRY OTHER CONTROLS. LDA TEMP GET CONTROL WORD. CPA B320 IF9s OCTAL 320, JMP UNDSC GO DO UNDERSCORE THING. JMP CNTRL,I NEITHER. RETURN. * * SKIP N LINES VIA I-O CONTROL CALL. * SKIPN LDA TEMP AND B77 SZA ADA N1 RTE WILL SKIP 1 LINE DURING WRITE. SZA,RSS IF N WAS 0 OR 1, JMP CNTRL,I EXIT! STA TEMP IPRAM FOR I/O CONTROL (# OF LINES) * LDA D$LOG IOR FCN11 STA CNWRD CONTROL WORD WITH FUNCTION CODE. * JSB EXEC I/O CONTROL CALL. DEF *+4 DEF SD3 DEF CNWRD CONTROL WORD. DEF TEMP IPRAM. JSB OERR OUTPUT ERROR. * JMP CNTRL,I RETURN. * * INSERT AN UNDERSCORE AS LAST CHAR. IN MESSAGE. * UNDSC LDB BUFL CMB,INB POSITIVE # MESSAGE BYTES. CLE,ERB E SET IF ODD # BYTES. ADB BUFA ADDR OF WORD FOR UNDERSCORE. * LDA B,I CLEAR DESTINATION BYTE. SEZ,RSS ALF,ALF AND UP377 * IOR "_" INSERT UNDERSCORE. SEZ,RSS ALF,ALF STA B,I * LDA BUFL INCR NEG. BYTE COUNT BY 1. ADA N1 STA BUFL * JMP CNTRL,I RETURN TO DISPLAY SECTION. * * SET FOR DOUBLE SPACE AFTER PRINT. * DBLSP STA SKIP SET SKIP-LINE-AFTER-PRINT FLAG. JMP CNTRL,I RETURN. * B60 OCT 60 B700 OCT 700 B600 OCT 600 B320 OCT 320 B300 OCT 300 B200 OCT 200 B100 OCT 100 B2500 OCT 2500 B3200 OCT 3200 N5 DEC -5 CNWRD NOP FCN11 OCT 1100 "_" OCT 137 ESC BYT 33,0 ESCAPE CHARACTER. * ESCAPE CODES TO HOME CURSOR AND ENTER (WITHOUT CARRIAGE RETURN) HCENT BYT 33,110,33,144,137 SKP * * SUBROUTINE TO TEST AND SERVICE OPERATOR BREAK. * BRKCK NOP LDA OEFLG OUTPUT ERROR SZA FLAG SET? JMP BRK1 YES--IGNORE BREAK CHECK. LDA D$BRK IF NEITHER IOR D$CTY BREAK FLAG SZA,RSS IS SET, JMP BRK1 RETURN. JSB IFBRK bDEF *+1 SZA,RSS HAS THERE BEEN A BREAK? JMP BRK1 NO. TAKE "NO-BREAK" RETURN. * LDA D$INP SET "ECHO INPUT" & IOR B600 "PRINT COL 1" BITS. STA CNWRD JSB REIO DISPLAY DEF *+5 "ENTER CONTROL REQ. (B OR Y)". DEF SD2 DEF CNWRD DEF CMSG DEF D13 JMP BRK1 OUTPUT ERROR. * JSB REIO READ OPERATOR RESPONSE. DEF *+5 DEF SD1 DEF CNWRD DEF INBUF DEF D2 JMP BRK1 INPUT ERROR. * LDA INBUF TEST RESPONSE. AND UP377 ALF,ALF LDB B22 CPA "B" JMP BRK2 BREAK. LDB B25 CPA "Y" JMP BRK2 CONTROL-Y. * JSB REIO NEITHER: DEF *+5 DISPLAY "INVALID INPUT" DEF D2 DEF CNWRD DEF ILMSG DEF D7 * BRK1 ISZ BRKCK SET "NO-BREAK" RETURN. JMP BRKCK,I * BRK2 LDA D$BRK LOAD PROPER CPB B25 FLAG INTO LDA D$CTY A-REG. SZA IF SET, JMP BRKCK,I GO DO IT. JSB REIO OTHERWISE, DEF *+5 DISPLAY DEF D2 "DISABLED". DEF CNWRD DEF DISAB DEF D4 JMP BRK1 * CMSG ASC 13,ENTER CONTROL REQ (B OR Y) ILMSG ASC 7,INVALID INPUT DISAB ASC 4,DISABLED "B" OCT 102 "Y" OCT 131 SKP * SUBROUTINE TO RELEASE THE MASTER CLASS. * CLNUP NOP ENTRY/EXIT. LDA CLASN GET THE CLASS NUMBER. CCE,SZA,RSS IF CLASS NUMBER NEVER ASSIGNED, JMP CLNUP,I RETURN NOW. * RAL,ERA INCLUDE THE NO-WAIT BIT (#15), STA CLASN AND SAVE FOR RELEASE. CREPT CCA SET THE RELEASE RE-TRY SWITCH STA TEMP TO -1. * CLRTN JSB EXEC GO TO RTE TO RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 SPECIFY CLASS GET - NO ABORT. DEF CLASN MASTER CLASS/RELEASE/NO WAIT. DEF D0 DUMMY BUݯFFER ADDRESS. DEF D0 DUMMY BUFFER LENGTH. RSS IGNORE ERRORS. * ISZ TEMP RELEASE PROCESSING COMPLETED? JMP ZRCLS YES. GO CLEAR THE CLASS NUMBER. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP CREPT NO. CONTINUE TO CLEAR REQUESTS. * LDA CLASN GET THE CLASS NUMBER AGAIN. AND CLMSK EXCLUDE THE NO-DE-ALLOCATION BIT (13). STA CLASN RESTORE THE MODIFIED CLASS WORD. JMP CLRTN RETURN FOR FINAL DE-ALLOCATION. * ZRCLS CLA STA CLASN JMP CLNUP,I RETURN. * CLMSK OCT 117777 CLASS NUMBER MASK. SKP * * ERROR PROCESSING SECTION. * DOWN LDB "00" SYSTEM IS SHUT-DOWN: "DS00". JMP GETDS NINIT LDB "01" DS/3000 LINK NOT INITIALIZED. JMP GETDS MTOER LDB "05" MASTER REQUEST TIMEOUT: "DS05". JMP GETDS ILRQ LDB "06" ILLEGAL REQUEST. JMP GETDS RESER LDB "07" "RES" LIST-ACCESS ERROR: "DS07". * GETDS LDA "DS" GET FIRST HALF OF ERROR MESSAGE: "DS". * PASER DST MSGBF SAVE TOTAL ERROR MESSAGE. * JSB CLNUP GO TO CLEAN UP BEFORE EXITING. (A)="DS". * PSER1 LDB MSGAD POINTS TO ERROR MESSAGE ADDRESS. LDA CONWD GET ERROR-RETURN FLAG. ELA POSITION TO FOR TESTING. LDA RETRN GET ERROR ADDRESS SEZ ABORT OR RETURN TO CALLER? JMP D$ABT ABORT! - NO RETURN. CCA SET CONDITION CODE TO CCL. STA ICCC DLD MSGBF GET ERROR CODES AND RETURN TO JMP RETRN,I THE CALLER AT ERROR-RETURN POINT. SPC 3 * * OUTPUT ERROR WAS DETECTED * OERR NOP DST MSGBF SAVE ERROR MESSAGE. STA OEFLG SET OUTPUT ERROR FLAG. JMP OERR,I RETURN. SKP * SUBROUTINE TO HANDLE ABORT MESSAGES. * * A REG = SUSPEND OR ABORT ADDRESS. * B REG = ADDRESS OF 4 CHAR ERROR MESSAGE. * JSB D$ABT (DOES NOT RETURN TO CALLER)ko * D$ABT STA ERCD SAVE ABORT ADDRESS. DLD B,I GET ERROR MESSAGE. DST MSG SAVE ERROR MESSAGE. * JSB CNUMO CONVERT ERROR ADDRESS TO OCTAL. DEF *+3 DEF ERCD DEF ERCD * LDA XEQT GET ADDRESS OF ID SEGMENT. ADA D12 GET TO NAME ADDRESS. STA TEMP SAVE ADDRESS FOR XFER. JSB .DFER MOVE NAME INTO AREA. MSGA DEF AMSG DESTINATION ADDRESS. DEF TEMP,I SOURCE ADDRESS. * JSB .DFER MOVE NAME FOR DS ERROR MESSAGE. DEF PNAM1 DESTINATION ADDRESS. DEF TEMP,I SOURCE ADDRESS. LDB MSGA MOVE A SPACE LAST CHAR OF NAME. ADB D2 LDA B,I AND UP377 IOR B40 STA B,I SAVE IT AGAIN. STA LNAM SAVE FOR LINE 1 ERROR. * LDA D$LOG SZA,RSS IF LOG LU IS ZERO, CLA,INA USE 1. IOR B600 SET "ECHO INPUT" & STA CNWRD "PRINT COL 1" BITS. JSB EXEC SEND 2-LINE ERROR/ABORT MESSAGE. DEF *+5 DEF D2 DEF CNWRD LOG DEVICE GIVEN FOR HELLO CALL. DEF MSG DEF D18 * JSB EXEC TERMINATION REQUEST. DEF *+2 NO RETURN. DEF D6 SPC 1 MSG ASC 3,DS PNAM1 ASC 2, LNAM ASC 1, ERCD ASC 3, BYT 15,12 CR/LF AMSG ASC 8, ABORTED D6 DEC 6 B40 OCT 40 D12 DEC 12 D14 DEC 14 D18 DEC 18 SPC 3 * * FUNCTION FOR RETRIEVAL OF CONDITION CODE. * ICC NOP LDA ICC,I SET RETURN ADDRESS. STA ICC LDA ICCC FETCH CONDITION CODE. JMP ICC,I RETURN. SPC 3 * * SUBROUTINE TO STORE CURRENT PROCESS NUMBER. * * JSB PRCNM * DEF *+2 * DEF ISMP NEGATIVE PROCESS NUMBER. * ISMP NOP PRCNM NOP JSB .ENTR GET ADDRESS OF PROCESS NUMBER. DEF ISMP * LDA ISMP,I GET NEGATIVE PROCESS NUMBER. CMA,INA MAKE POSITIVE. STA D$SMP STORE AS CURRENT PROCESS #. * JSB LOGLU GET TERMINAL'S LU. DEF *+2 DEF TEMP STA D$LOG SAVE AS $STDLIST AND STA D$INP $STDIN DEVICES. * JMP PRCNM,I RETURN. SPC 3 * * SUBROUTINE TO LOAD FROM ALTERNATE MAP. * LODWD NOP MODI2 LDA B,I (RSS IF DMS SYSTEM) JMP LODWD,I XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I SKP * * COMPUTE AND STORE REQUEST WORD COUNT IN FIRST BYTE OF REQUEST. * STWDC NOP LDA BUF+CLS FIRST WORD OF REQUEST BUFFER. AND B377 CLEAR WORD COUNT BYTE. LDB BUF+BYT BYTE COUNT FROM REQUEST. INB CLE,ERB MAKE WORD COUNT. ADB D8 ADD FIXED FORMAT LENGTH. BLF,BLF MOVE TO LEFT BYTE. IOR B MERGE WITH MESSAGE CLASS. STA BUF+CLS STORE FIRST WORD. JMP STWDC,I RETURN. SKP ************************************************************** * SUBROUTINES USED TO SET APPENDAGE AND RETRIEVE PARAMETERS * ************************************************************** SPC 2 *** D$INI: INITIALIZE PARAMETER AND DESTINATION POINTERS. * (USED WITH APPENDAGE-BUILDING SUBROUTINES.) * CALLING SEQUENCE: LDA
* JSB D$INI * D$INI NOP STA U.PTR PTR TO 1ST USER PARAM ADDR. LDA D$RQB ADA D8 STA P.PTR PTR TO APPENDAGE. CLA SET BYTE COUNT WORD STA BUF+BYT IN HEADER TO ZERO. JMP D$INI,I RETURN. SPC 2 * STORE A-REG IN REQUEST BUFFER. *** D$STW: STORE A-REG IN APPENDAGE AND INCREMENT BYTE COUNT WORD. * CALLING SEQUENCE: LDA * JSB D$STW * D$STW NOP LDB BUFSZ CHECK IF STILL ROOM IN BUFFER. ADB D$RQB (IS POINTER AT END OF BUFFER?) CPB P.PTR JMP D$STW,I REQUEST BUFFER OVERFLOW! * STA P.PTR,I STORE WORD. ISZ P.PTR BUMP BUFFER POINTER. LDA BUF+BYT ADA D2 INCREMENT BYTE COUNTER. STA BUF+BYT JMP D$STW,I RETURN. (A) = BYTE COUNT. SPC 2 *** D$PRM: STORE N PARAMETERS IN APPENDAGE. * CALLING SEQUENCE: LDA <-N> * JSB D$PRM * D$PRM NOP STA TEMP SAVE NEG. # PARAMS. NPM LDA U.PTR,I GET ADDR OF NEXT PARAM. SZA IF NOT SPECIFIED, STORE ZERO. LDA A,I JSB D$STW STORE VALUE IN REQ BUFFER. ISZ U.PTR ISZ TEMP JMP NPM LOOP TILL DONE. JMP D$PRM,I RETURN. (A) = BYTE COUNT. SPC 2 *** D$NWD: STORE N-WORD PARAM IN APPENDAGE. * CALLING SEQUENCE: LDA <-N> * JSB D$NWD * D$NWD NOP STA TEMP SAVE NEG. WORD COUNT. LDB U.PTR,I GET ADDR OF PARAM. STB TEMP1 * NWD LDA TEMP1 IF PARAM NOT SPECIFIED, SZA STORE ZERO. LDA TEMP1,I GET NEXT WORD OF PARAM. JSB D$STW STORE IN REQ BUFFER. LDA TEMP1 SZA ISZ TEMP1 ISZ TEMP JMP NWD ISZ U.PTR JMP D$NWD,I RETURN. (A) = BYTE COUNT. SPC 2 *** D$ASC: STORE ASCII STRING IN APPENDAGE. * CALLING SEQUENCE: LDA
* LDB <- MAX # WORDS> * JSB D$ASC * D$ASC NOP STA ADDR SAVE ADDR OF STRING. STB TEMP SAVE MAX # WORDS (NEG.). SZA,RSS JMP ASC2 QUIT IF NOT SPECIFIED. * CLA CPB N25 SET FLAG IF ONLY DELIMITER CCA IS A PERIOD (FORMMSG). STA DMFLG * ASC1 LDA ADDR,I GET NEXT 2 CHARACTERS. SZA,RSS JMP ASC2 GET OUT IF ZERO WORD. JSB D$STW STORE IN REQUEST BUFFER. LDA ADDR,I ALF,ALF LOOK FOR DELIMITER. AND B377 JSB DELIM JMP ASC2 LEFT BYTE WAS DELIMITER. LDA ADDR,I AND B377 JSB DELIM JMP ASC2 RIGHT BYTE WAS DELIMITER. * ISZ ADDR NO DEL6IMITER ENCOUNTERED. ISZ TEMP JMP ASC1 LOOP TILL MAXIMUM REACHED. * LDA BLNKS LIMIT REACHED. STORE BLANKS. JSB D$STW JMP D$ASC,I RETURN. (A) = BYTE COUNT. * ASC2 LDA BUF+BYT JMP D$ASC,I RETURN. (A) = BYTE COUNT. * DELIM NOP CHECK IF (A) = DELIMITER. STA TEMP1 LDB DMFLG INB,SZB JMP DLM1 CPA PEROD STRING IS FORMS MESSAGE. JMP DELIM,I CHARACTER IS A PERIOD. JMP NODLM LET ANYTHING ELSE THROUGH. * DLM1 CPA SLASH NOT FORMMSG STRING. JMP NODLM LET SLASH THROUGH. CPA PEROD JMP NODLM LET PERIOD THROUGH. * ADA NB60 LET 0-9 THROUGH. SSA JMP DELIM,I ADA NB12 SSA JMP NODLM ADA B72 * ADA NEGA LET A-Z THROUGH. SSA ANYTHING ELSE IS A DELIMITER. JMP DELIM,I ADA NGMAX SSA,RSS JMP DELIM,I * NODLM ISZ DELIM DELIMITER NOT REACHED. JMP DELIM,I SPC 2 *** D$ZRO: STORE ZERO IN NEXT N WORDS OF APPENDAGE. * CALLING SEQUENCE: LDA <-N> * JSB D$ZRO * D$ZRO NOP STA TEMP ZRO CLA JSB D$STW ISZ TEMP JMP ZRO JMP D$ZRO,I SPC 3 *** D$IPM: INITIALIZE REPLY POINTERS. * (CALLED BEFORE PICKING UP RETURN PARAMETERS.) * CALLING SEQUENCE: LDA <1ST RETURN PARAM ADDR> * LDB <1ST WORD IN APPENDAGE> * D$IPM NOP STA U.PTR 1ST RETURN PARAM ADDR IN CALL. STB P.PTR 1ST RETURN VALUE IN REPLY BUFFER. JMP D$IPM,I SPC 2 *** D$NPM: PASS N M-WORD RETURN PARAMS TO CALLER. * CALLING SEQUENCE: LDA <-N> * LDB <-M> * JSB D$NPM * D$NPM NOP STA TEMP SAVE NEG. # PARAMS. STB TEMP2 SAVE NEG. # WORDS PER PARAM. NPM1 LDB U.PTR,I GET ADDR OF NEXT PARAM. SZB,RSS JMP NPM3 IGNORE OF PARAM NOT SPEC IFIED. * LDA TEMP2 STA TEMP1 NPM2 LDA P.PTR,I GET NEXT WORD OF PARAM VALUE. STA B,I PASS TO CALLER. INB BUMP TO NEXT WORD OF PARAMETER. ISZ P.PTR BUMP TO NEXT WORD IN REPLY BUFFER. ISZ TEMP1 BUMP PARAM SIZE COUNTER. JMP NPM2 LOOP FOR M WORDS. * NPM3 ISZ U.PTR BUMP TO NEXT PARAM ADDRESS. ISZ TEMP BUMP # PARAMS COUNTER. JMP NPM1 LOOP FOR N PARAMS. JMP D$NPM,I SPC 2 *** D$SPM: PASS SINGLE N-WORD PARAM TO USER. * CALLING SEQUENCE: LDA <-N> * JSB D$SPM * D$SPM NOP STA B B = NEG WORD COUNT. CCA A = ONE PARAM. JSB D$NPM PASS THE N-WORD PARAM. JMP D$SPM,I SKP * * CONSTANTS AND WORKING STORAGE. * B20 OCT 20 B21 OCT 21 B22 EQU D18 B23 OCT 23 B25 OCT 25 B72 OCT 72 B77 OCT 77 B377 OCT 377 UP377 BYT 377,0 D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D7 DEC 7 D8 DEC 8 D10 DEC 10 D13 DEC 13 D20 DEC 20 N1 DEC -1 N3 DEC -3 N4 DEC -4 N8 DEC -8 NB12 OCT -12 N25 DEC -25 N40 DEC -40 NB60 OCT -60 N80 DEC -80 SD1 DEF 1,I SD2 DEF 2,I SD3 DEF 3,I C4S22 BYT 4,22 PREAD C4S23 BYT 4,23 PWRITE C6S20 BYT 6,20 HELLO C7S21 BYT 7,21 PCLOSE D$SMP OCT 0 SESSION MAIN PROCESS NUMBER. D$LOG NOP LU OF LOG DEVICE. D$INP NOP LU OF INPUT DEVICE. D$BRK NOP "BREAK" CHECK FLAG. D$CTY NOP "CONTROL-Y" CHECK FLAG. D$ECH OCT 400 ECHO BIT FOR D$INP. CCE OCT 1000 D$ERR BSS 2 BLNKS ASC 1, PEROD OCT 56 SLASH OCT 57 NEGA OCT -101 NGMAX OCT -33 MSGAD DEF MSGBF MSGBF ASC 2,DS00 ERROR MESSAGE BUFFER. "00" ASC 1,00 "01" ASC 1,01 "05" ASC 1,05 "06" ASC 1,06 "07" ASC 1,07 "DS" ASC 1,DS * BLK#1 NOP PCLSF NOP STATS NOP OCLST NOP INBUF NOP RTNLN NOP MVLEN NOP H&ALN NOP SPCAV 4NOP U.PTR NOP P.PTR NOP TEMP NOP TEMP1 NOP TEMP2 NOP ADDR NOP BRFLG NOP BREAK FLAG DMFLG NOP OEFLG NOP OUTPUT ERROR FLAG BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 CLASN NOP BUFL NOP ICCC NOP LCGW OCT 40006 GLOBAL RN LOCK/CLEAR/WAIT/NO-ABORT. LGW OCT 40002 GLOBAL RN LOCK/WAIT/NO ABORT. CLS20 DEF 20,I CLASS READ-WRITE (NO ABORT). CLS19 DEF 19,I CLASS CONTROL - NO ABORT. CLS21 DEF 21,I CLASS GET - NO ABORT. * PRFLG NOP PROMPT FLAG. OLDLN NOP LENGTH OF LAST WRITE. ORCRD BSS 40 LAST WRITTEN BUFFER. @ORCD DEF ORCRD SEQ# NOP SEQ # STORAGE FOR REPLY VALIDATION. D$TAG DEF *+1 TEMPORARY TAG STORAGE. BSS 20 * BSS 0 ****** SIZE OF D3KMS ****** * END X , 91750-18065 2013 S C0122 &D3KRB              H0101 lwASMB,L NAM D3KRB,0 91750-1X065 REV.2013 791026 MEF: 3K LINK, 304 BFRS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END _  91750-18066 2013 S C0122 &DLGON +              H0101 ASMB,R,Q,C HED DLGON 91750-1X066 REV 2013 * (C) HEWLETT-PACKARD CO.1980 NAM DLGON,7 91750-1X066 REV.2013 800725 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT DLGON,DLGOF,DLGNS * EXT #MAST,#NASR,#RSAX,#TBRN,RNRQ,$OPSY,#NODE EXT #NRVS,.ENTR,LUTRU,.MVW,PGMAD,#LDEF,.DRCT EXT #RQB,LOGLU,.LBT,#DFSN,#NEWX RQB EQU #RQB * SUP * * NAME: DLGON * SOURCE: 91750-18066 * RELOC: PART OF 91750-12014, -12015 * PGMR: JIM HARTSELL * * USER CALLABLE NON-INTERACTIVE LOG-ON UTILITY. * * SUBROUTINE DLGON MUST BE CALLED BY A USER PROGRAM BEFORE * ANY MASTER COMMUNICATION FUNCTIONS WITH A SPECIFIC SESSION * MONITOR ACCOUNT AT A REMOTE HP 1000. DLGON WILL LOG OFF PREVIOUS * SESSION, IF LEFT PENDING. CALLS TO LOCAL NODE ARE ILLEGAL. * * CALLING SEQUENCES: * * LOGON: LOGOFF: NON-SESSION: * * JSB DLGON JSB DLGOF JSB DLGNS * DEF *+5 DEF *+3 DEF *+5 * DEF IERR DEF IERR DEF IERR * DEF NODE DEF NODE DEF NODE * DEF IACCT . DEF JACCT * DEF LEN . DEF LEN * . . . * . (A) = NAT . . (A) = NAT * . ENTRY # . . ENTRY # * * WHERE: * * IACCT ASC 16,USERNAMEXX[.GROUPNAMEX][/PASSWORDXX] * JACCT ASC 5,PASSWORDXX (1ST CHAR = "/" IS OPTIONAL) * * * THE RETURNED IERR CAN BE EITHER -1 -> -7 FROM DLGON ?OR RSM ("RSXX"), * -50 -> -59 FROM DS ("DSXX"), OR +1 -> +13 FROM LOGON ("SMXX"). * "DSERR" WILL DISPLAY THE ASCII VERSION, E.G. "RSXX". SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #R|}EP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP * A EQU 0 B EQU 1 * DLGON NOP ENTRY FOR LOG-ON. LDA DLGON CLB,INB ICODE = 1. JMP PASAD * DLGOF NOP ENTRY FOR LOG-OFF. LDA DLGOF CLB ICODE = 0. JMP PASAD * DLGNS NOP ENTRY FOR NON-SESSION ACCESS. LDA DLGNS LDB B2 ICODE = 2. * PASAD STA RETRN SET UP FOR RETURN ADDRESS. STB ICODE SAVE REQUEST CODE. * CLA STA PRAMS CLEAR OLD PARAM ADDRESSES. STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 JMP ENTER * PRAMS NOP ERROR CODE. NOP NODE NUMBER. NOP ADDR OF ASCII USER-NAME. NOP LENGTH OF USER-NAME (BYTES). * RETRN NOP ENTER JSB .ENTR GET PARAM ADDRESSES. DEF PRAMS * LDA PRAMS+1,I BLOCK DLGON CALLS CPA #NODE TO LOCAL NODE JMP LOCER (ERROR -7). CPA N1 JMP LOCER * JSB .DRCT CLEAR OLD REQUEST. DEF RQB STA TEMP LDB C#MXR CMB,INB CLA STA TEMP,I ISZ TEMP INB,SZB JMP *-3 * STA PRAMS,I CLEAR USER ERROR CODE. STA OLDSN CLEAR "OLD SESSION" FLAG. LDA #NODE INITIALIZE ERROR STA RQB+#ENO REPORTING NODE NUMBER. * * CHECK FOR MISSING PARAMETERS * LDB PRAMS+3 GET LAST PARAM ADDRESS. LDA ICODE GET REQUEST CODE. STA RCODE SAVE FOR RESTORE. SZA,RSS IF ZERO, LDB PRAMS+1 GET LOGOF LAST PARAM ADDRESS. SZB,RSS PARAMETERS SPECIFIED? JMP ILLRQ NO. ERROR. * * CONVERT LU TO DESTINATION NODE. * LDA PRAMS+1,I GET -LU/+NODE. STA TNODE SAVE. SSA,RSS JMP VERFY ALREADY +NODE. * JSB #NRVS DEF *+6 DEF PRAMS+1,I -LU OF NEIGHBOR. DEF TEMP DUMMY. DEF LEVEL LEVEL # OF DEST. NODE. DEF TEMP DUMMY. DEF TNODE RETURNED NODE NUMBER. JMP NSERR ERROR RETURN. (B) = "04". * LDA LEVEL IF DESTINATION NODE SZA,RSS IS AN OLD NODE, JMP OLDND RETURN "RS04". * VERFY JSB #NEWX CHECK FOR NEW EXECUTION. * * IF A LOG-OFF REQUEST, CHECK IF DESTINATION NODE IS NON-SESSION * AND VERIFY THAT A SON IS NOT LOGGING OFF A FATHER'S SESSION (SON MUST * BE THE OWNER (CREATOR) OF THE REMOTE SESSION). * LDA ICODE LOG-OFF REQUEST? SZA JMP CKREQ NO. * LDA TNODE YES. SEE IF DEST. NODE IS IN THE NAT. JSB #NASR SZB,RSS JMP OFRET NO. IGNORE THE LOG-OAhFF. STA OFSID YES. SAVE DEST. SESSION ID. STB NATAD SAVE NAT ENTRY ADDR. SZA IF DESTINATION SESSION ID CPA D254 IS 0 OR 254, JMP RPNL JUST RELEASE PNL & NAT ENTRIES. * FACHK CLA STA BUFR JSB PGMAD GET ID SEG ADDR OF USER. DEF *+3 DEF BUFR DEF XEQT * LDB #LDEF SEARCH PNL FOR ID SEG ADDR. ADB N1 LDB B,I ADDR OF PNL HEADER. PNLST JSB LODWD (CROSS) LOAD ADDR OF NEXT PNL ENTRY. SZA,RSS (A) = ADDR OF NEXT ENTRY. JMP SONOF NOT FOUND. ERROR. * LDB A POINT TO 5TH WORD IN PNL ENTRY. ADB B4 JSB LODWD (CROSS) LOAD 5TH WORD. CPA XEQT OUR ID SEGMENT ADDRESS? JMP BUILD YES. PROCEED WITH LOG-OFF. ADB N4 NO (ALSO NO MATCH IF "BAD ENTRY" JMP PNLST BIT IS SET IN PNL ENTRY). * * DETERMINE IF REQUESTING NON-SESSION ACCESS OR LOGGING ON TO A * NODE THAT STILL HAS AN ACTIVE SESSION OR NON-SESSION "PERMIT" FOR * THIS USER OR HAS ALREADY BEEN LOGGED AS A NON-SESSION-MONITOR NODE. * CKREQ LDA ICODE CHECK REQUEST CODE. CPA B2 JMP CKRQ1 NON-SESSION. CPA B1 RSS LOG-ON. JMP ILLRQ ILLEGAL REQUEST CODE. * CKRQ1 LDA TNODE GET DEST. NODE. JSB #NASR SEARCH NETWORK ACCOUNT TABLE. SZB,RSS (A) = DEST SID (CAN BE 0 OR 254). JMP SONCK NO ENTRY (NO PRIOR SESSION). * STA OFSID SAVE DESTINATION SESSION ID. STB NATAD SAVE ADDR OF NAT ENTRY. CLB,INB SET FLAG TO LOG OFF OLD SESSION BEFORE STB OLDSN LOG ON OR NON-SESSION ACCESS. SZA IF PRIOR WAS LOGGED AS NON-SM NODE, CPA D254 OR IF PRIOR WAS A NON-SESSION ACCESS, JMP RPNL JUST GO RELEASE PNL AND NAT. * CLA PRIOR SESSION: DUMMY THE REQUEST CODE STA ICODE TO "LOGOF" FOR THE TIME BEING. {! JMP FACHK MAKE SURE WE OWN THE SESSION! * * VERIFY THAT A PROGRAM IS NOT TRYING TO LOG ON OR GET NON-SESSION * ACCESS TO A NODE WHERE ANOTHER PROGRAM IN THIS "PROCESS" (SAME * SCHEDULING LU) ALREADY HAS A SESSION. * SONCK CLA,INA INIT SCHEDULING SYSTEM LU STA REALU FOR PNL ENTRY. * JSB LOGLU GET SCHEDULING LU. DEF *+2 DEF TEMP (DUMMY PARAM) * SZA,RSS JMP NAT IF ZERO, USE REALU = 1 FOR PNL. STA TEMP SAVE SCHEDULING LU. * JSB LUTRU MAKE SURE ITS A SYSTEM LU. DEF *+3 DEF TEMP DEF REALU (USE FOR PNL ENTRY LATER) * LDB #LDEF SEARCH PNL. ADB N1 LDB B,I ADDR OF PNL HEADER. PNLSR JSB LODWD GET ADDR OF NEXT PNL ENTRY. SZA,RSS JMP NAT NOT FOUND. ALL CLEAR TO PROCEED. * LDB A POINT TO WORD 3 OF PNL ENTRY. ADB B2 JSB LODWD GET REMOTE NODE #. CPA TNODE SAME AS USER'S DESTINATION? JMP *+3 YES. GO CHECK TERMINAL LU. ADB N2 NO. GO TO NEXT PNL ENTRY. JMP PNLSR INB POINT TO LOCAL TERMINAL LU. JSB LODWD GET TERMINAL LU. AND B377 CPA REALU SAME AS OUR SCHEDULING LU? RSS JMP PNLNX NO. GO CHECK NEXT PNL ENTRY. INB YES. BAD ID SEGMENT? JSB LODWD SSA,RSS JMP SONOF NO. ERROR "RS06". ADB N1 YES. IGNORE PNL. PNLNX ADB N3 GO CHECK NEXT PNL ENTRY JMP PNLSR (COULD BE GOOD ONE AFTER THIS ONE). * * IF REQUEST IS FOR LOG-ON OR NON-SESSION ACCESS, FIND AN * AVAILABLE ENTRY IN THE NETWORK ACCOUNT TABLE (D$NAT). * NAT CLA JSB #NASR SEARCH. SZB,RSS JMP NROOM NONE AVAILABLE. ERROR. STB NATAD OK. SAVE ENTRY ADDRESS. * * BUILD LOGON/LOGOFF/NON-SESSION REQUEST. * BUILD LDA B7 STORE OPREQ STREAM. STA RQB+#STR LDA PRAMS+1,I STORE DESTINATION NODE. STA RQB+#DST * LDA B2 SET COMMAND LEN = 2 BYTES. STA RQB+#CML LDA "XX" STORE COMMAND STRING. STA RQB+#CMS LDA ICODE STORE REQUEST CODE. STA RQB+#LGC * SZA IS THIS A LOG OFF? JMP BLDMO NO. GO CONTINUE BUILDING. * LDA L#LNL YES. SET REQUEST LENGTH. STA RQLEN * LDA TNODE GET NAT INFO (AGAIN). JSB #NASR STB NATAD AND B377 STORE SESSION ID STA RQB+#LNL IN LOGOFF REQUEST BUFFER. JMP SEND GO SEND LOGOFF REQUEST. * * * STORE USER NAME AND/OR PASSWORD IN REQUEST BUFFER. * BLDMO LDA PRAMS+3,I LENGTH IN +WORDS OR -BYTES. SZA,RSS JMP ILLRQ ERROR IF LENGTH = 0. SSA MAKE + BYTES. CMA,INA,RSS ALS STA RQB+#LNL STORE LENGTH IN REQUEST. CMA IF OVER 32 BYTES, ADA K33 SSA JMP NSUCH NAME IS TOO LONG. * LOOP LDB PRAMS+2 GET BYTE ADDR OF LAST CHAR. RBL ADB RQB+#LNL ADB N1 JSB .LBT IF LAST CHAR = BLANK, CPA B40 RSS JMP CORCT LDA RQB+#LNL DECREMENT BYTE LEN IN REQ. ADA N1 STA RQB+#LNL JMP LOOP GO CHECK FOR ANOTHER BLANK. * CORCT LDA RQB+#LNL GET CORRECTED CHAR. COUNT. INA MAKE WORDS. ARS STA TEMP SAVE AS WORD COUNT. ADA L#LNL SET REQUEST LENGTH. STA RQLEN * LDA PRAMS+2 STORE NAME IN REQUEST. LDB D#LUN JSB .MVW DEF TEMP NOP * * SEND REQUEST TO THE DESTINATION HP 1000. * SEND JSB #MAST SHIP THE REQUEST BUFFER. DEF *+7 DEF CONWD NO-ABORT BIT SET IN CONWD. DEF RQLEN REQUEST LENGTH. DEF B0 DEF B0 DEF B0 DEF L#REP MAX ALLOWED REPLY LEN. JMP DSER ERROR RETURN ("DSXX", "RSXX", "SMXX", ETC.). * LDA ICODE LOG-OFF? =SZA,RSS JMP RPNL YES. GO RELEASE PNL ENTRY. * * BUILD PROCESS NUMBER LIST ENTRY IN "RES" FOR LOG-ON AND NON-SESSION. * JSB RNRQ WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT/NO ABORT. DEF #TBRN TABLE-ACCESS RN. DEF TEMP DUMMY. JMP TBLER ** RTE ERROR. * LDA RQB+#SID ISOLATE RETURNED DEST SESSION ID. AND B377 STA TEMP * JSB #RSAX ADD PROCESS # LIST ENTRY. DEF *+6 DEF K8 DEF REALU LOGGING LU. DEF TEMP DEST. SESSION ID. DEF TNODE DEST. NODE. DEF B0 MPE/RTE BIT = RTE. * SSB ANY ERRORS? JMP TBLER YES. * * COMPLETE THE ENTRY IN THE NETWORK ACCOUNT TABLE (D$NAT) FOR * LOG-ON AND NON-SESSION ACCESS. * LDB NATAD ENTRY ADDRESS. LDA TNODE STA B,I STORE NODE NUMBER. INB LDA RQB+#SID AND B377 STA B,I STORE RETURNED DEST SESSION ID. INB (CAN BE 0 OR 254) CLA STA B,I CLEAR ADDR OF ASCII USER NAME. INB STA B,I CLEAR EXECW SEQ #. * LDA NATAD LOAD UP NAT ENTRY NUMBER FOR REMAT. JMP RETRN,I RETURN TO THE USER. * * REMOVE AN ENTRY FROM THE PROCESS # LIST IN "RES". * RPNL JSB #RSAX DEF *+4 DEF K10 REMOVE AN ENTRY. DEF OFSID DEST SESSION ID. DEF TNODE DEST NODE NUMBER. * * DELETE ENTRY IN NETWORK ACCOUNT TABLE. * LDB NATAD GET POINTER TO NATX ADB B2 ENTRY (IF ANY) IN LDB B,I REMAT'S #RMSM ROUTINE. SZB,RSS JMP OLNEW NO NATX. CPB #DFSN JMP OLNEW (SKIP "DEFAULT SESSION") CLA CLEAR NATX ENTRY STA B,I (ASCII ACCOUNT NAME FOR LDA B THIS REMOTE SESSION). INB JSB .MVW DEF K10 NOP * OLNEW LDA OLDSN WAS ]THIS AN OLD SESSION SZA OR NON-SESSION ACCESS? JMP GOBAK YES. STILL NEED TO LOG-ON. * LDB NATAD NO. GET NAT ENTRY ADDRESS. CLA RELEASE THE ENTRY. STA B,I LDA B INB JSB .MVW DEF B4 NOP * OFRET CLA JMP RETRN,I RETURN TO THE USER. * GOBAK CLA RELEASE ENTRY, BUT USE IT FOR STA NATAD,I LOG-ON OR NON-SESSION "PERMIT". STA OLDSN CLEAR "OLD SESSION" FLAG. LDA RCODE RESTORE ORIGINAL REQUEST CODE STA ICODE (LOG-ON OR NON-SESSION REQUEST). JMP SONCK GO DO LOG-ON. * NSUCH DLD "SM04 ACCOUNT NAME IS TOO LONG. JMP NGOOD NROOM DLD "RS03 LIMIT REACHED ON # SESSIONS. JMP NGOOD OLDND DLD "RS04 NO S.M. AT OLD NODES. JMP NGOOD SONOF DLD "RS06 SON PROG ATTEMPTED LOGON OR LOGOFF. JMP NGOOD LOCER DLD "RS07 LOG-ON/OFF TO LOCAL NODE. JMP NGOOD NSERR DLD "DS04 INVALID NODE/LU. JMP NGOOD TBLER DLD "DS07 "RES" TABLE ACCESS ERROR. JMP NGOOD ILLRQ DLD "DS09 ILLEGAL REQ CODE, OR MISSING PARAM. * NGOOD DST RQB+#EC1 KEEP "DSERR" HAPPY BY STUFFING LDA #NODE ERROR INFO IN REPLY BUFFER. IOR BIT15 STA RQB+#ENO LDA RQB+#ECQ AND NOTQ STA RQB+#ECQ * DSER LDA RQB+#EC2 GET ERROR NUMBER. LDB RQB+#ENO ASCII? SSB,RSS JMP DSER1 NO. CLB YES. CONVERT TO BINARY. RRR 4 GET LEAST SIGNIFICANT DIGIT. BLF STB TEMP SAVE IT TEMPORARILY. RRR 4 GET TENS DIGIT. AND B17 MPY K10 MULTIPLY BY TEN. ADA TEMP ADD UNITS DIGIT. * DSER1 LDB RQB+#EC1 CPB "DS" IF "DSXX", ADA K50 ADD 50. CPB "SM" IF NOT "SMXX", RSS (I.E. DSXX/RSXX), CMA,INA NEGATE. SZA IF 0 (RS00/SM00), L<:6 JMP DSER2 DLD "RS04 DST RQB+#EC1 LDA N4 MAP TO -4. JMP RTERR * DSER2 CPB "DS" IF NOT "DS", JMP RTERR OR CPB "SM" "SM", JMP RTERR OR CPB "RS" "RS", JMP RTERR THEN LDA N59 USE -59 CATCH-ALL. * RTERR STA PRAMS,I RETURN ERROR CODE. * CLA JMP RETRN,I RETURN TO CALLER. * * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS. * LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE. RAR,SLA SKIP IF NON-DMS. JMP *+3 LDA B,I NON-DMS. JMP LODWD,I XLA B,I DMS CROSS-LOAD. JMP LODWD,I SKP * * CONSTANTS AND WORKING STORAGE. * B0 OCT 0 B1 OCT 1 B2 OCT 2 B4 OCT 4 B7 OCT 7 B17 OCT 17 B40 OCT 40 B377 OCT 377 BIT15 OCT 100000 NOTQ OCT 177417 D254 DEC 254 K8 DEC 8 K10 DEC 10 K33 DEC 33 K50 DEC 50 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N59 DEC -59 "XX" ASC 1,XX "SM" ASC 1,SM "RS" ASC 1,RS "DS" ASC 1,DS "SM04 ASC 2,SM04 "RS03 ASC 2,RS03 "RS04 ASC 2,RS04 "RS06 ASC 2,RS06 "RS07 ASC 2,RS07 "DS04 ASC 2,DS04 "DS07 ASC 2,DS07 "DS09 ASC 2,DS09 BUFR BSS 3 D#LUN DEF RQB+#LUN OFSID NOP NATAD NOP ICODE NOP RCODE NOP TNODE NOP LEVEL NOP TEMP NOP XEQT NOP OLDSN NOP CONWD OCT 100000 LGW OCT 40002 REALU NOP RQLEN NOP L#LNL ABS #LNL+1 L#REP ABS #REP+1 C#MXR ABS #MXR * BSS 0 SIZE OF DLGON. * END "<  91750-18067 2013 S C0122 &DEXEC              H0101 sASMB,Q,C HED DEXEC: DS/1000 REMOTE EXEC ROUTINE *(C) HEWLETT-PACKARD CO.1980* NAM DEXEC,7 91750-1X067 REV.2013 800924 ALL SUP * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAME: DEXEC * SOURCE: 91750-18067 * RELOC: 91750-1X067 * PGMR: C. HAMILTON [ 07/28/77 ] * MODIF'D: GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S * MODIF'D: JDH [790213] FOR DS REQUEST EQUATED OFFSETS. * MODIF'D: CCH [08/05/80] FOR 91750. SPC 1 * (DISTRIBUTED EXECUTIVE) IS THE DS/1000 USER INTERFACE FOR * 'TRANSPORTABLE' CALLS TO EITHER THE LOCAL, OR REMOTE-NODE RTE SYSTEM. * * WILL ACCEPT ALL VALID REQUEST CODES FOR 'LOCAL' EXECUTION. * * FOR EXECUTION AT A REMOTE NODE, WILL ACCEPT REQUEST CODES: * 1, 2, 3, 6, 9, 10, 11, 12, 13, 23, 24, 25, <99> * ONLY * * * ** UNACCEPTABLE REQUESTS WILL BE REJECTED WITH A "DS06" ERROR! * ** "IO01" IS RETURNED UPON DETECTION OF INCORRECT, MISSING, OR * TOO MANY (>9) PARAMETERS. * ** "IO04" WILL BE RETURNED FOR BUFFER-ERROR SPECIFICATIONS: * REMOTE READ/WRITE BUFFER LENGTH GREATER THAN 512 WORDS, * INTERACTIVE WRITE LENGTH > READ LENGTH, 'Z' BUFFER LENGTH =0. * ** "SC01" INDICATES A MISSING SCHEDULING PARAMETER. * ** "SC05" INDICATES AN IMPROPER PROGRAM NAME SPECIFICATION. * ** ERROR QUALIFIERS SET TO: 0-SYSTEM, 1-DEXEC, 2-EXECM, 3-EXECW, 4-#RQUE * * REQUEST CODES: 1,2,3,6,10,11,12,13,25,99 WILL BE TRANSMITTED TO THE REMOTE * NODE, VIA STREAM #5, TO BE PROCESSED BY . MASTER (THIS NODE), * AND SLAVE (REMOTE NODE) TIMEOUTS, ESTABLISHED WITH , WILL BE * USED TO PROCESS THESE RE!QUESTS. REQUEST CODES: 9,23,24 WILL BE * TRANSMITTED TO THE REMOTE NODE, VIA STREAM #3, TO BE PROCESSED BY * . A LONG MASTER TIMEOUT (APPROX. 20 MIN.) WILL BE ALLOWED, * IN ORDER TO PROVIDE SUFFICIENT TIME FOR SCHEDULE-WITH-WAIT REQUESTS. * * CALLING SEQUENCE: CALL DEXEC(NODE,P1,P2,P3,P4,P5,P6,P7,P8,P9) * * RETURN (X&Y INTACT) : - NORMAL COMPLETION, IF REQUEST CODE SIGN =0 * CONTAIN 'EXEC' RETURN INFORMATION * * : ERROR DETECTED: ABORT & PRINT MESSAGE, IF RC#15 =0 * * : - FOR DETECTED ERRORS, IF RC#15 =1 * CONTAIN ASCII ERROR CODES * * : - FOR NORMAL COMPLETION, IF RC#15 =1 * CONTAIN 'EXEC' RETURN INFORMATION * * NODE - SPECIFIES CALL-EXECUTION LOCATION: LOCAL=-1, REMOTE= 0 TO 32767 * [ CALL WILL ALSO EXECUTE, LOCALLY, IF THE 'LOCAL' NODE IS USED ] * * P1 TO P9 - NORMAL 'EXEC' CALLING PARAMETERS (P1 = REQUEST CODE, ETC.) * * WILL ALLOW THE USER TO PERFORM A COMBINED, INTERACTIVE, * WRITE-READ OPERATION IN A SINGLE CALLING SEQUENCE. SUCH A REQUEST * WILL BE MOST USEFUL FOR EFFICIENTLY COMMUNICATING WITH A REMOTE * OPERATOR. TO SPECIFY AN INTERACTIVE WRITE-READ: REQUEST CODE =1, * CONWORD BIT#11 =1, P8 = WRITE BUFFER ADDRESS, AND P9 = WRITE * BUFFER LENGTH (<=READ BUFFER LENGTH). * * * RCODE=99: PROGRAM STATUS; P2:PGM.NAME ADDR; P3: OPTIONAL STATUS ADDR. * RTN: #15=1: SHORT I.D.,#3-0: STATUS, = 0. * ERR: ='DS', = -1. * * * NOTE: FOR RC=9/23, IF ICODE BIT#11=1, A CLONE PROGRAM MAY BE CREATED, * * IF THE DESTINATION NODE CONTAINS SESSION MONITOR. * * IS AN ALTERNATE ENTRY INTO WHICH MAY BE CALLED WHENEVER * THE USER DESIRES TO PERFORM A REMOTE READ, WRITE, OR I/O STATUS REQUEST * WHICH MUST REFER TO A SYSTEM LOGICAL UNIT NO. GREATER THAN 63 DECIMAL. ** SUCH REQUESTS WILL BE PERFORMED VIA THE 'XLUEX' PROCESSOR IN THE REMOTE * NODE. [BIT#12 IS SET IN TRANSMITTED REQUEST CODE PARAMETER, TO NOTIFY * THAT THE REQUEST CONTAINS A DUAL CONTROL WORD.] * * CALLING SEQUENCE: CALL DLUEX(NODE,ICODE,CONWD,P3,P4,P5,P6) * * WHERE: ICODE = 1(READ)/2(WRITE)/3(CONTROL)/13(I/O STATUS) * * CONWD IS A POINTER TO A TWO WORD INTEGER ARRAY: * * * DOUBLE ('XLUEX') CONTROL WORD: * * WORD #1 * *15*14*13*12*11*10* 9* 8* 7* 6* 5* 4* 3* 2* 1* 0* * +-----------------------------------------------+ * ! S! RESERVED ! LOGICAL UNIT ! * +-----------------------------------------------+ * NOTE: WORD #1,S-BIT SPECIFIES NO LU MAPPING USED. * * WORD #2 * *15*14*13*12*11*10* 9* 8* 7* 6* 5* 4* 3* 2* 1* 0* * +-----------------------------------------------+ * ! X! X! X! Z! I! FUNCTION ! RESERVED ! X=DON'T CARE * +-----------------------------------------------+ * NOTE: I-BIT#11 IS INTERACTIVE WRITE-READ FLAG. * * , AN ACCESSIBLE ENTRY POINT, INITIALLY CONTAINS 0; IS SET =$OPSY * IN THE LOCAL NODE, WHEN IS FIRST CALLED; IS SET =$OPSY * FROM THE REMOTE NODE, WHEN A REQUEST IS SUCCESSFULLY COMPLETED BY A * LEVEL 1 NODE; IS SET =0, WHEN A COMMUNICATION ERROR IS DETECTED. * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L] #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR 5jDEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SPC 1 * * LENGTH DEFINITIONS FOR REQUEST BUFFERS. * L#I/O ABS #KEY+1 REQ LEN FOR DEXEC(1),(2),(3),(13) L#TYR ABS #TYR+1 REQ LEN FOR DEXEC(11) L#ST3 ABS #PM2+1 REQ LEN FOR DEXEC(25) L#PGN ABS #PGN+3 BASE FOR DEXEC(6,9,10,12,23,24,25,99) SPC 10 * * > > > > > C A U T I O N < < < < < < < < < < * SPC 10 * USE CAUTION IF THE PARAMETER PORTION CHANGES FOR THE VARIOUS * REQUESTS. SUBROUTINE NAMP INITIALIZES THE LENGTH TO THE END OF * THE PROGRAM NAME (L#PGN) FOR ICODES 6,9,10,12,23,24,25,99. * THE REMAINDER OF THE LENGTH IS COMPUTED ON THE FLY AS PARAMETERS * ARE MOVED TO THE REQUEST BUFFER. * * ADJUSTMENTS ARE AUTOMATIC IF ONLY THE REQUEST HEADER CHANGES. * SKP ENT DEXEC,DLUEX,D#OPS EXT .ENTR,$LIBR,$LIBX,$OPSY,EXEC,REIO,XLUEX EXT #MAST,#NODE,#RQB,#TILT,PGMAD EXT .ADX,.CYA,.DSX,.ISX,.ISY,.LAX,.LDX,.LDY,.MVW EXT .SAX,.STX,.STY DEXEC NOP JMP *+2 BYPASS ENTRY. DLUEX NOP REMOTE EXTENDED-LU ENTRY. DST SAVEA SAVE FOR RETURN-PARAMETER CHECKS. JSB .STX SAVE REGISTER. DEF SAVEX JSB .STY SAVE THE REGISTER. DEF SAVEY ERA,ALS MOVE TO SIGN BIT. SOC IF THE OVERFLOW BIT IS SET, INA THEN SET BIT #0 ALSO. STA SAVEO SAVE THE STATUS OF . LDA DLUEX IF ENTRY WAS VIA , SZA,RSS THEN SAVE ITS CONTENTS FOR RETURN. LDA DEXEC GET THE RETURN POINTER. STA EXIT SAVE FOR '.ENTR' PROCESSING. STA SAVEN SAVE FOR 'DEXEC'/'DLUEX' DECISIONS. JSB .LDX DEF D12 CLA STA RQB+#ECQ INITIALIZE ERROR QUALIFIER =0(SYSTEM). INIT0 JMP INIT FIRST PASS, ONLY; 'NOP', THEREAFTER. JSB .SAX INITIALIZE PARAMETER AREA DEF PRAMS-1 JSB .DSX JMP *-3 JMP GETPR GO TO OBTAIN PARAMETER ADDRESSES. SPC 1 CALEX JSB RQLEN,I LOCAL-EXECUTION CALL TO EXEC/REIO/XLUEX PRAMS REP 10 PARAMETER ADDRESSES/LOCAL EXECUTION AREA NOP NOP (TEMP) NOP (TEMP+1) ERTST SEZ,RSS LOCAL EXECUTION: ANY ERRORS DETECTED? ISZ EXIT NO. ESTABLISH RETURN TO . DST RQB+#EC1 SAVE FOR RETRIEVAL BY CALLER. JMP RSTEO GO TO RESTORE REGISTERS & RETURN. SPC 1 EXIT NOP GETPR JSB .ENTR GET DIRECT ADDRESSES DEF PRAMS FOR THE USER-SPECIFIED PARAMETERS. * LDA N#DBS INITIALIZE THE DATA BUFFER STA RMNDR REMAINDER CHECK VALUE TO MAXIMUM. LDA DABFA INITIALIZE NEXT AVAILABLE LOCATION STA DBLOC POINTER TO BEGINNING OF DATA BUFFER. LDA $OPSY INITIALIZE THE OPSYSTEM IDENTIFIER STA D#OPS TO REFER TO THE LOCAL NODE. * LDA PRAMS+1 GET THE ADDRESS OF THE REQUEST CODE. SZA,RSS WAS THE PARAMETER PROVIDED? JMP ERDS6 NOT PROVIDED, ERROR! * LDA PRAMS+1,I GET THE REQUEST CODE. AND CLNMS REMOVE 'CLONE-OK' BIT(#11)--IF ANY. STA RCODE SAVE FOR POSSIBLE USE IN LOCAL REQUEST. RAL,CLE,ERA REMOVE THE NO-ABORT BIT, AND SAVE IN STA ICODE ICODE FOR MAPPING & POST PROCESSING. * LDB A CARRY MASKED REQUEST CODE IN . LDA PRAMS,I GET THE DESTINATION CPA #NODE FOR US ? JMP LOCAL YES. GO TO LOCAL PROCESSING. INA,SZA,RSS IS IT AN ABSOLUTE LOCAL REFERENCE? JMP LOCAL YES. GO TO LOCAL PROCESSING. * SPLOC JSB .LDX GET MAX. REQ/REPLY LENGTH. DEF C#DLW INITIALIZE BUFFER SIZE COUNT IN . CLA,CCE =0: BUFFER INIT; =1: CONWORD PREP. JSB .SAX IN ITIALIZE THE DEF RQB-1 REQUEST BUFFER JSB .DSX TO CONTAIN JMP *-3 ALL ZEROES. * STA WRLEN SET THE 'NO DATA' STA RDLEN DEFAULT CONDITIONS. ERA SET THE 'ERROR-RETURN' FLAG FOR STA CONWD THE <#MAST> CALLING SEQUENCE. * LDA PRAMS,I GET THE DESTINATION STA RQB+#DST SAVE IT IN THE REQUEST LDA D5 GET THE STREAM TYPE STA RQB+#STR SET IT IN THE REQUEST * LDA ICODE GET THE REQUEST CODE CPA D99 IF THE REQUEST IS FOR PROGRAM STATUS, JMP PGMST THEN PROCESS IT INDEPENDENTLY. * SZA REQUEST CODE =0? ADA UPLIM NO. SEE IF IT'S WITHIN SSA,RSS THE RANGE: 0 < RC < 27 ? JMP ERDS6 ERROR, OUT OF RANGE: RC=0, OR RC>26! LDA PRAMS+2 SZA,RSS WAS A THIRD PARAMETER SPECIFIED? JMP ERIO1 NO, ERROR! * SKP LDA SAVEN IF THE ENTRY CPA DEXEC WAS VIA , THEN CLA,RSS AVOID SETTING THE FLAG; LDA BIT12 ELSE, INCLUDE BIT#12 IOR ICODE AND THE CALLER'S REQUEST CODE TO STA RQB+#ICD CONFIGURE THE REQUEST BUFFER ENTRY. * * SELECT THE PRE-PROCESSOR ROUTINE, VIA MAPPED REQUEST CODE. * LDB ICODE MAP USER'S REQUEST CODE, ADB SUBAD USING THE PRE-PROCESS MENU. JMP B,I GO DO IT. * * PRE-PROCESSOR JUMP TABLE * SUBAD DEF SUBS-1,I SUBS DEF ICI/O READ RC=01 DEF ICI/O WRITE RC=02 DEF ICI/O CONTROL RC=03 DEF ERDS6 * TRACK ALLOCATION RC=04 DEF ERDS6 * TRACK RELEASE RC=05 DEF ICOD6 PROGRAM TERMINATION RC=06 DEF ERDS6 * PROGRAM SUSPEND RC=07 DEF ERDS6 * SEGMENT LOAD RC=08 DEF SCHW r SCHEDULE W/WAIT RC=09 DEF ICD10 SCHEDULE W/O WAIT RC=10 DEF ICD11 TIME RC=11 DEF ICD12 TIME SCHEDULE RC=12 DEF ICI/O I/O STATUS RC=13 DEF ERDS6 * GET STRING RC=14 DEF ERDS6 * GLOBAL TRACK ALLOCATE RC=15 DEF ERDS6 * GLOBAL TRACK RELEASE RC=16 DEF ERDS6 * CLASS READ RC=17 DEF ERDS6 * CLASS WRITE RC=18 DEF ERDS6 * CLASS CONTROL RC=19 DEF ERDS6 * CLASS WRITE/READ RC=20 DEF ERDS6 * CLASS GET RC=21 DEF ERDS6 * SWAP CONTROL RC=22 DEF SCHW QUEUE-SCHEDULE W/WAIT RC=23 DEF SCHW QUEUE-SCHEDULE W/O WAIT RC=24 DEF PARST PARTITION STATUS RC=25 DEF ERDS6 * MEMORY STATUS (RTE-IV) RC=26 * * = REMOTE REQUEST NOT SUPPORTED. * UPLIM ABS SUBAD-* REQUEST CODE LIMIT-VALUE:-(MAX.RCODE +1) HED DEXEC: PRE-PROCESSORS * (C) HEWLETT-PACKARD CO. 1980 * * PRE-PROCESSING FOR READ, WRITE, CONTROL, AND I/O STATUS (RC=1,2,3,13). * ICI/O DLD PRAMS+2,I GET CONTROL WORD(S). RC=1,2,3,13 STA RQB+#CNW SET IN REQUEST CCE PREPARE FOR A ENTRY. LDA SAVEN IF THIS IS A CPA DEXEC NORMAL REQUEST, CLB,CLE THEN CLEAR , CLEAR , AND STB RQB+#CWX CONFIGURE CONWORD EXTENSION. SEZ,CLE,RSS IF THIS WAS A ENTRY, LDB RQB+#CNW THEN RETRIEVE CONWORD FROM REQUEST. BLF POSITION FOR LATER TEST OF BITS#11,12. STB CONSV SAVE FOR FUTURE USE. CLA LDB ICODE IF THIS IS AN CPB D13 I/O STATUS REQUEST, JMP SET0 N THEN FORCE OPTIONAL KEYWORD =0 * LDA PRAMS+9,I ELSE, GET THE KEYWORD--IF ANY, SET0 STA RQB+#KEY AND ADD IT TO THE OUTBOUND REQUEST. ADB DM3 IF THIS IS A READ OR WRITE REQUEST, SSB,RSS SKIP TO PROCESS THE DATA BUFFER; JMP OPTPR ELSE, BYPASS DATA PROCESSING. * LDB PRAMS+4 GET THE BUFFER-LENGTH ADDRESS. RC=1,2 SZB,RSS WAS IT SUPPLIED? JMP ERIO1 NO BUFFER LENGTH PROVIDED, ERROR! * JSB LENCK GO VERIFY & GET BUFFER WORD COUNT. STB RQB+#BFL CONFIGURE BUFFER LENGTH INTO REQUEST. * LDB ICODE GET THE REQUEST CODE. SLB IF THIS IS A READ(1) REQUEST, STA RDLEN THEN CONFIGURE READ LENGTH FOR <#MAST>; SLB,RSS ELSE, IF THIS IS A WRITE(2) REQUEST, STA WRLEN THEN CONFIGURE 'WRLEN' FOR <#MAST>. * LDA PRAMS+3 GET THE BUFFER ADDRESS. SZA,RSS WAS IT SUPPLIED? JMP ERIO1 NO BUFFER, ERROR: IO01! * STA OUTBF INITIALIZE <#MAST> TO REFER BOTH STA INBUF INPUTS & OUTPUTS TO USER'S DATA BUFFER. SLB IF THIS IS A READ REQUEST, JMP OPTPR THEN NO NEED TO MOVE DATA. * LDB CONSV GET THE SHIFTED CONWORD. SLB IF THIS IS A 'Z' BUFFER REQUEST, JSB MDATA THEN MOVE USER'S DATA TO LOCAL BUFFER. * OPTPR CLA PREPARE FOR MISSING PARAMETER. RC=3,13 LDA PRAMS+5,I GET FIRST OPTIONAL PARAMETER STA RQB+#PM1 ADD PARAMETER-OR 0-TO REQUEST BUFFER. * CLA PREPARE FOR MISSING PARAMETER. LDA PRAMS+6,I GET SECOND OPTIONAL PARAMETER STA RQB+#PM2 ADD PARAMETER-OR 0-TO REQUEST BUFFER. * LDA CONSV RETRIEVE THE SHIFTED CONWORD. AND HILO ISOLATE INTERACTIVE BIT#11 AND Z BIT#12. SZA,RSS IF NEITHER IS SET, JMP CHEK3 THEN GO TO CHECK FOR A CONTROL REQUEST. * LDB ICODE GET THE REQUEST CODE. CPB D1 IF THIjS IS A READ REQUEST, SSA,SLA,RSS CHECK FOR BOTH BITS SET JMP *+2 ONLY ONE IS SET, SO CONTINUE JMP ERIO1 BOTH ARE SET: ERROR IO01! * LDB PRAMS+6 GET ADDRESS FOR WRITE/Z-BUFFER LENGTH. JSB LENCK GO VERIFY & GET 'WRITE' WORD COUNT. LDB WRLEN CONFIGURE REQUEST TO SHOW THE OFFSET STB RQB+#ZOF OF 'Z' BUFFER FROM START OF DATA BUFFER. ADB A COMPUTE TOTAL DATA BUFFER LENGTH. LDA ICODE GET REQUEST CODE, AGAIN. CPA D13 IF THIS IS AN I/O STATUS REQUEST, STB RDLEN PREPARE <#MAST> TO RECEIVE DATA, CPA D13 AND ALSO BYPASS THE SPECIAL JMP MOVEZ INTERACTIVE WRITE-READ PROCESSING. * STB WRLEN CONFIGURE TRANSMITTED DATA LENGTH. * CPA D1 CHECK AGAIN FOR A READ REQUEST. JMP IRW? READ: GO TO CHECK FOR INTERACTIVE W/R. JMP MOVEZ NOT A READ: BYPASS INTERACTIVE CODE. * IRW? LDB CONSV GET SHIFTED CONWORD. SSB,RSS INTERACTIVE WRITE-READ? JMP MOVEZ NO. IGNORE SPECIAL LENGTH CHECK. * LDA TEMP+1 RETRIEVE THE WRITE LENGTH CMA,INA AND MAKE IT NEGATIVE. ADA RDLEN IF THE WRITE LENGTH SSA IS GREATER THAN THE 'READ' LENGTH, JMP ERIO4 THEN THE REQUEST IS INVALID! * LDA RDLEN FORCE ADEQUATE SAM TO BE STA WRLEN ALLOCATED AT RECEIVING NODE. LDA CONWD GET THE <#MAST> CONTROL WORD. ARS SET THE LONG TIMEOUT BIT(#14). STA CONWD RESTORE CONWD (140000B). * MOVEZ LDA PRAMS+5 GET THE SECOND BUFFER ADDRESS SZA,RSS IF NONE WAS SPECIFIED, JMP ERIO1 THEN THE REQUEST IS INVALID! * LDB ICODE IF THIS IS NOT SLB A WRITE REQUEST, THEN JMP SETZA THERE IS NO NEED TO MOVE USER DATA. * SKP JSB MDATA MOVE USER'S DATA TO LOCAL BUFFER. LDA DABFA REFER <#MAST> TO THE LOCAL SElTZA STA OUTBF OR USER'S TRANSMISSION BUFFER. * CHEK3 LDA ICODE IF THE REQUEST CPA D3 IS FOR I/O CONTROL, THEN CLA,RSS MORE PARAMETERS MUST BE PROCESSED; JMP I/OND ELSE, PROCESSING IS COMPLETE. * LDA PRAMS+3,I GET FIRST OPTIONAL CONTROL PARAMETER. STA RQB+#PRM ADD IT TO THE REQUEST BUFFER. CLA PREPARE FOR MISSING PARAMETER. LDA PRAMS+4,I GET SECOND OPTIONAL CONTROL PARAMETER. STA RQB+#PR2 PLACE IT INTO REQUEST BUFFER. * I/OND LDA L#I/O GET THE REQUEST LENGTH AND GO JMP SETLN TO CONFIGURE THE <#MAST> CALL. * SPC 3 ICOD6 LDB PRAMS+9 IF MORE THAN EIGHT PARAMETERS RC=06 SZB,RSS WERE PASSED, OR IF THE CPB PRAMS+3 'INUM' PARAMETER WAS NOT PASSED, JMP ERIO1 THEN THE CALL IS INCORRECT; JMP ICD10 ELSE, GO COMPLETE THE REQUEST. * SKP PGMST STA RQB+#ICD PROGRAM STATUS SHARES SCHED CODE. RC=99 * ICD10 JSB NAMP GO TO PROCESS THE PROGRAM NAME. RC=10 JSB .LDX BUILD LOOP COUNTER DEF DM7 LOOP3 JSB .LAX GET PARAMETER ADDRESS DEF PRAMS+10 SZA,RSS IS IT THERE? JMP DON10 NO-EXIT LDA A,I YES, GET ITS VALUE JSB .SAX STORE INTO REQUEST DEF RQB+#IBL+1 JSB .ISY ADVANCE THE PARAMETER COUNT. JSB .ISX PROCESSING STRING-LENGTH PARAMETER? JMP LOOP3 NO, CONTINUE LDB PRAMS+9 YES. GET THE STRING-LENGTH ADDRESS. JSB LENCK GO TO CHECK THE STRING-BUFFER LENGTH. STA WRLEN CONFIGURE WRITE LENGTH FOR <#MAST>. LDB PRAMS+8 GET THE STRING BUFFER ADDRESS. STB OUTBF CONFIGURE '#MAST' TO PASS DATA. * DON10 JSB .CYA GET THE PARAMETER COUNT JMP SETLN GO TO ESTABLISH REQUEST LENGTH. * SPC 1 ICD11 LDA L#TYR GET REQUEST LENGTH AND GO TO RC=11 JMP SETLN ESTABLISH TIME REQUEST LENGTH. SPC 1 { ICD12 JSB NAMP GO TO PROCESS THE PROGRAM NAME. RC=12 * JSB .LDX SET A LOOP COUNTER DEF D3 CLA LDA PRAMS+5,I GET 6TH PARAMETER SSA JMP LOOP1 JSB .ADX ABSOLUTE TIME, MORE PARAMETERS DEF D3 * LOOP1 JSB .LAX GET A PARAMETER ADDRESS DEF PRAMS+2 SZA,RSS JMP ERSC1 ABSENT, ERROR LDA A,I GET THE PARAMETER JSB .SAX SET IT IN THE REQUEST DEF RQB+#PGN+2 JSB .ISY ADVANCE THE PARAMETER COUNT JSB .DSX ALL DONE ? JMP LOOP1 NO, CONTINUE * JSB .CYA GET THE PARAMETER COUNT. JMP SETLN READY TO SEND * SKP PARST LDA PRAMS+3 DO THEY HAVE ANY ROOM ? RC=25 SZA,RSS JMP ERIO1 NO, GET OUT! * * LDA PRAMS+5 USER PREPARED TO ACCEPT 3 PARAMETERS? SZA,RSS JMP ERIO1 NO. THE CALL IS INCORRECT! * CLA LDA PRAMS+2,I GET CALLER'S PARTITION NO. PARAMETER. STA RQB+#CNW CONFIGURE CALLING SEQUENCE. * LDA L#ST3 GET THE REQUEST LENGTH AND GO TO JMP SETLN ESTABLISH I/O STATUS REQUEST LENGTH. SPC 2 SCHW LDA PRAMS+1,I IF THE USER SPECIFIED XOR RCODE THAT CREATION OF A CLONE SZA,RSS WAS DESIRED, THEN SKIP; JMP SCHW1 ELSE, BYPASS SETTING BIT#11. * CPA BIT11 IF THE 'CLONE-OK' BIT(#11) IS NOT SET, CPB D24 OR, IF IT IS SET, AND RC=24, THEN JMP ERDS6 THE REQUEST IS NOT ACCEPTABLE: 'DS06'! * IOR ICODE CONFIGURE THE 'CLONE-OK' BIT(#11) STA RQB+#ICD INTO THE TRANSMITTED REQUEST PARAMETER. * SCHW1 LDB D3 SET THE STREAM-TYPE STB RQB+#STR FOR THE SCHEDULE-WITH-WAIT MONITOR. RBR,RBR MODIFY THE <#MAST> CONTROL WORD FOR STB CONWD WRITE & LONG TIMEOUT (140000B). JMP ICD10 PROCESS ALL PARAMETERS. * SKP * CHECK VALIDITY OF BUFFER LENGTH SPECIFICATIhONS: DATA+Z <= #DBS WORDS. * LENCK NOP = DON'T CARE, = ADDRESS OF LENGTH. CLA PREPARE TO RETURN WORD LENGTH =0. SZB,RSS IF THE LENGTH WAS NOT SPECIFIED, JMP LENCK,I RETURN WITH =0. * LDB B,I GET THE BUFFER LENGTH. STB TEMP SAVE USER'S BUFFER LENGTH SPEC. SSB,RSS WORDS OR -BYTES? JMP WORDS POSITIVE WORDS. BRS NEGATIVE BYTES--CONVERT TO -WORDS. CMB,INB MAKE THAT +WORDS WORDS STB TEMP+1 SAVE ACTUAL LENGTH, IN WORDS. LDA B SAVE +WORDS IN FOR RETURN. ADB RMNDR CHECK FOR ACCEPTABLE LENGTH SSB,RSS JMP ERIO4 >512, TOO MUCH * STB RMNDR SAVE REMAINING LOCATION COUNT. LDB TEMP RETURN: A=WORDS, B=USER SPECIFIED LENGTH. JMP LENCK,I RETURN TO CALLER. * * MOVE DATA FROM USER'S BUFFER INTO LOCAL DATA BUFFER. * MDATA NOP A=USER BUFFER ADDRESS, B=DON'T CARE. LDB TEMP+1 GET MOVE LENGTH (SET BY 'LENCK'). SZB,RSS IF LENGTH IS ZERO, JMP MDATA,I RETURN NOW. * LDB DBLOC DESTINATION IS NEXT DATA BUFFER LOC'N. JSB .MVW MOVE USER'S DATA DEF TEMP+1 TO LOCAL DATA BUFFER. NOP STB DBLOC UPDATE NEXT LOCATION POINTER. JMP MDATA,I RETURN: = MEANINGLESS. * * VERIFY, AND MOVE PROGRAM NAME TO REQUEST BUFFER; INITIALIZE PARAM. COUNT. * NAMP NOP CHECK AND MOVE PROGRAM NAME. LDA PRAMS+2 GET ADDRESS OF PROGRAM NAME. LDB A,I IF THE FIRST TWO CHARACTERS SZB,RSS ARE NULLS, THEN JMP ERSC5 THE CALL IS INCORRECT! * LDB NAMA GET POINTER TO NAME, IN REQUEST JSB .MVW MOVE THE NAME TO THE REQUEST DEF D3 NOP JSB .LDY INITIALIZE THE PARAMETER COUNTER. DEF L#PGN JMP NAMP,I RETURN * SKP * SEND THE REMOTE EXEC REQUEST VIA "#MAST" AND AWAIT REPLY * SELTLN STA RQLEN ESTABLISH REQUEST LENGTH FOR <#MAST>. * JSB #MAST CALL MASTER REQUEST INTERFACE ROUTINE DEF *+8 DEF CONWD CONTROL WORD DEF RQLEN REQUEST LENGTH OUTBF DEF * CONFIGURED DATA BUFFER ADDRESS--IF ANY. DEF WRLEN WRITE DATA LENGTH -- IF ANY DEF RDLEN READ DATA LENGTH -- IF ANY DEF C#DLW MAXIMUM REPLY LENGTH EXPECTED =15 WORDS. INBUF DEF * CONFIG. REPLY DATA ADDRESS--IF ANY. JMP ERROR * ERROR DETECTED BY "#MAST"--REPORT IT * ADA RQBFP COMPUTE ADDRESS OF OP-SYSTEM IDENTIFIER. LDB A,I GET REMOTE OP-SYSTEM IDENTIFIER, STB D#OPS AND MAKE IT AVAILABLE FOR CALLER. * LDB ICODE IF THE REQUEST CODE WAS FOR A: CPB D11 - TIME REQUEST, THEN THE JMP IPD11 TIME VALUES MUST BE POST-PROCESSED; CPB D13 - DEVICE-STATUS REQUEST, THEN THE DEVICE JMP IPD13 PARAMETERS NEED POST-PROCESSING; CPB D25 - PARTITION-STATUS REQUEST, THEN THE JMP IPD13 PARTITION PARAMETERS NEED PROCESSING; CPB D99 - PROGRAM-STATUS REQUEST, THEN CHECK THE JMP IPD13 STATUS PARAMETER FOR POST-PROCESSING. * SKP HED DEXEC: POST-PROCESSING * (C) HEWLETT-PACKARD CO. 1980 * IPOST LDA RQB+#ENO SSA ANY ERROR ? JMP ERROR YES LOCND EQU * LDA PRAMS+1,I GET ICODE SSA WAS THE NO ABORT BIT SET ? ISZ EXIT YES PUSH RETURN ADDRESS * LDB ICODE GET THE REQUEST CODE. CPB D9 SCHEDULE WITH WAIT? CCA,RSS YES. SET VALUE FOR PARAMETER CHECK. CPB D23 QUEUE SCHEDULE WITH WAIT? CCA,RSS YES. SET VALUE FOR PARAMETER CHECK. JMP ATEND NO. PARAMETER PROCESSING NOT REQUIRED. * LDB SAVEB GET CALLER'S ORIGINAL CONTENTS. CPA RQB+#XML IF RETURNED PARAMETERS, THEN JMP MVPRM GO MOVE PARAMETERS TO ID SEGM8ENT. JMP RESTX IGNORE FROM REPLY BUFFER. * MVPRM CLA INITIALIZE NAME ARRAY TO INDICATE STA TEMP REQUEST FOR RETURN OF 'THIS' ID ADDR. JSB PGMAD GET DEF *+3 'THIS' PROGRAM'S DEF TEMP I.D. SEGMENT DEF TEMP+1 ADDRESS. LDB SAVEB GET CALLER'S ORIGINAL CONTENTS OF . SZA,RSS IF 'PGMAD' CALL FAILED ( =0), JMP RESTX BYPASS RETURN OF PARAMETERS; ISZ TEMP+1 ELSE, SET POINTER TO ID SEG. WORD#2. LDA IRTNP SOURCE: RETURNED PARAMETERS IN REPLY. LDB TEMP+1 DEST'N: SET INTO CALLER'S ID SEGMENT. * JSB $LIBR GAIN ACCESS TO PROTECTED AREA. NOP XMAP1 JSB .MVW MOVE 'PRTN' PAREMETERS [RTE-IV:JSB .LDX] DEF D5 INTO CALLER'S ID SEGMENT. XMAP2 NOP [RTE-IV: MWI] LDB TEMP+1 POINT CALLER'S -REG. TO PARAMETERS. JSB $LIBX RESTORE PROTECTION DEF *+1 AND RETURN TO DEF RESTX COMPLETE PROCESSING. * ATEND LDB RQB+#XML GET FROM THE REPLY BUFFER. RESTX JSB .LDX RESTORE THE ORIGINAL CONTENTS DEF SAVEX JSB .LDY OF BOTH THE & REGISTERS. DEF SAVEY RSTEO LDA SAVEO GET ORIGINAL STATE FOR . CLO INITIALIZE OVERFLOW TO CLEAR STATE. SLA,ELA RESTORE , AND IF WAS SET, STO THEN RESTORE IT TOO. CLA CLEAR THE ALTERNATE STA DLUEX ENTRY-POINT INDICATION. LDA RQB+#EC1 SET FOR RETURN TO CALLER. JMP EXIT,I RETURN TO CALLER SKP IPD11 LDA IRTNP GET ADDRESS OF THE TIME VALUES. LDB PRAMS+2 GET USER'S BUFFER ADDRESS JSB .MVW PASS 5 WORDS TO THE USER DEF D5 NOP LDB RQB+#TYR GET THE CURRENT 'YEAR'. STB PRAMS+3,I PASS THE YEAR (OPTIONALLY) JMP IPOST FINISH THE JOB SPC 1 IPD13 LDA RQB+#ST1 GET THE FIRST RETURN-PARAMETER. B STA PRAMS+3,I PASS: EQT5/STARTING PAGE/PROG. STATUS CPB D99 IF THE REQUEST WAS FOR PROGRAM STATUS, JMP ER99? THEN CHECK FOR NUMERIC ERROR; * CLA PREPARE FOR UNREQUESTED PARAMETER. LDB RQB+#ST2 GET THE NEXT RETURN-PARAMETER. STB PRAMS+4,I RC=13: EQT4/IPT6 RC=25: NO. PAGES. * LDA ICODE GET REQUEST CODE LDB CONSV AND SHIFTED CONWORD. CPA D13 IF THIS IS AN I/O STATUS REPLY, SLB,RSS AND A 'Z' BUFFER WAS SPECIFIED, SKIP. JMP GETOP NOT 'Z'. GO GET OPTIONAL PARAMETERS. * LDA RQB+#XML GET RETURN LENGTH PARAMETER. CPA RQB+#EQ5 A&B MUST BE EQUAL, IF DATA WAS RETURNED. CMA,SSA,INA IF NOT A NEGATIVE WORD LENGTH, JMP IPOST THEN NO 'Z' DATA HAS BEEN RETURNED. * STA RQB+#XML SAVE POSITIVE WORD COUNT. LDA DABFA SOURCE IS LOCAL DATA BUFFER. LDB PRAMS+5 DESTINATION IS USER'S BUFFER. JSB .MVW RETURN THE STATUS DEF RQB+#XML INFORMATION TO THE CALLER. NOP JMP IPOST COMPLETE THE PROCESSING. * GETOP CLA PREPARE FOR UNREQUESTED PARAMETER. LDB RQB+#ST3 RC=13:LU STATUS/$DVTP;RC=25:PAR. STATUS. STB PRAMS+5,I RETURN TO USER--IF REQUESTED (A, IF NOT) CLA PREPARE FOR UNREQUESTED PARAMETER. LDB RQB+#ST4 RC=13: $DVTP+1 (RTE-L). STB PRAMS+6,I RETURN TO USER--ELSE, TO A. JMP IPOST COMPLETE THE PROCESSING. * ER99? CCA IF EXECM CPA RQB+#EC2 DETECTED AN ERROR, THEN JMP ERROR TAKE THE ERROR PATH; ELSE, JMP IPOST GO COMPLETE NORMAL PROCESSING. * HED DEXEC: ERROR PROCESSING * (C) HEWLETT-PACKARD CO. 1980 * * DEXEC ERROR ROUTINES. * ERDS6 LDB "06" IMPROPER REQUEST: "DS06". LDA "DS" JMP ERCQ * ERIO1 LDB "01" INCORRECT,MISSING,OR TOO MANY PARAMETERS JMP GETIO * ERIO4 LDB "04" IMPROPER BUFFER SPECIFICATION. * GETIO LDA "IO" ERROfBR: "IO0X". JMP ERCQ * ERSC1 LDB "01" MISSING SCHEDULEING PARAMETER. JMP GETSC * ERSC5 LDB "05" INCORRECT PROGRAM NAME. * GETSC LDA "SC" ERROR: "SC0X". * *** MAINTAIN ORDER OF NEXT TWO INSTRUCTIONS *** ERCQ CCE,RSS SET FLAG: ESTABLISH ERROR QUALIFIER. NECQ CLE CLEAR FLAG: DO NOT MODIFY QUALIFIER. *********************************************** DST RQB+#EC1 SET ERROR CODES INTO REQ.BUFR ERRA EQU *-1 ERROR MESAGE ADDRESS [DEF RQB+#EC1]. SEZ,RSS ESTABLISH AN ERROR CODE QUALIFIER? JMP ERROR NO. IT IS ALREADY SET. LDA B21 YES. SET QUALIFIER =1(DEXEC), AND STA RQB+#ECQ MESSAGE LEVEL =1, FOR USER RETRIEVAL. LDA #NODE GET THE LOCAL NODE NUMBER. IOR BIT15 FORM ERROR NODE NO. W/ASCII FLAG. STA RQB+#ENO SAVE FOR USER RETRIEVAL. ERROR CLA CLEAR THE ALTERNATE- STA DLUEX ENTRY INDICATOR, STA D#OPS AND THE REMOTE $OPSY LOC'N. LDA PRAMS+1,I GET ICODE SSA NO ABORT BIT SET ? JMP ATEND YES, IT IS * CCA ADA EXIT WE HAVE THE ADDRESS OF THE JSB LDB ERRA GET ADDRESS OF THE ERROR MESSAGE JSB #TILT WE DO NOT COME BACK FROM THIS CALL * "01" ASC 1,01 "04" ASC 1,04 "05" ASC 1,05 "06" ASC 1,06 "DS" ASC 1,DS "IO" ASC 1,IO "SC" ASC 1,SC * HED DEXEC: LOCAL PROCESSING * (C) HEWLETT-PACKARD CO. 1980 * LOCAL LDA #NODE GET LOCAL NODE FOR USER ERROR ANALYSIS. CPB D99 IF THIS IS A PROGRAM STATUS REQUEST, JMP LOCST THEN PROCESS IT INDEPENDENTLY; * IOR BIT15 ELSE, PREPARE REQUEST BUFFER STA RQB+#ENO FOR USER ERROR RETRIEVAL. * CPB D1 IF THIS IS A READ REQUEST, JMP *+2 THEN SKIP FOR FURTHER CHECKING; JMP LCHEK ELSE, CONTINUE LOCAL PROCESSING. * LDA PRAMS+2 GET ADDRESS OF CONWORD(S). LDB SAVEN IF THIS IS A REFERENCE TO AN +| CPB DLUEX EXTENDED LOGICAL UNIT NUMBER, INA THEN POINT TO SECOND WORD OF PAIR. LDA A,I GET THE CONTROL WORD. ALF IF THE INTERACTIVE BIT(#11) SSA IS SET, THEN THE REQUEST MUST BE JMP SPLOC PASSED TO FOR PROCESSING. * LCHEK LDB GETPR+1 GET ADDRESS OF DEF'S FOR CALL. JSB .LDX UP TO 9 PARAMETERS; MORE = ERROR; DEF DM10 LOCL INB ADVANCE THE RETURN POINTER. JSB .LAX GET A PARAMETER ADDRESS DEF PRAMS+11 SZA,RSS PRESENT ? JMP LOC1 NO * JSB .ISX MORE THAN 10 PARAMETERS PASSED? JMP LOCL NO. CONTINUE CHECKING. JMP ERIO1 YES. TOO MANY--BUFFER MAY BE DESTROYED! * LOC1 STB PRAMS SET THE "DEF RETURN" DLD ERCQ GET ERROR-DETECTION INSTRUCTIONS. DST PRAMS,I INSERT AT RETURN LOCATIONS. * LDB RCODA GET POINTER TO REQUEST CODE VALUE. LDA PRAMS+1,I IF THIS IS A LOCALLLY PROCESSED XOR RCODE REQUEST, WITH THE 'CLONE-OK' BIT SET, SZA THEN, REFER TO THE MASKED STB RCODP REQUEST CODE; IT KNOWS NOT OF BIT#11. * LDA XLUX GET POINTER TO 'XLUEX'. LDB SAVEN IF THE USER CALLED CPB DLUEX VIA THE ENTRY, THEN JMP LOCLN GO TO ESTABLISH 'XLUEX' AS THE TARGET. * LDB ICODE GET REQUEST CODE. LDA EXECX GET "EXEC" ADDRESS ADB DM3 SSB,RSS IS IT READ OR WRITE? JMP LOCLN NO, DO "EXEC" CALL * LDB PRAMS+5 SZB,RSS OPT.PARAMETERS SPECIFIED? LDA REIOX NO, OK TO USE REIO! LOCLN STA RQLEN SAVE ADDR FOR MP CHECK LDB $OPSY IF THIS IS CPB DM31 AN RTE-L SYSTEM, JMP *+2 THEN SKIP TO COMPENSATE; JMP GETRX ELSE, BYPASS EXEC-CALL MODIFICATION. * LDB JSBIN GET THE NORMAL JSB,I INSTRUCTION. CPA EXECX IF THIS ISm TO BE A CALL TO , STA CALEX THEN CONVERT JSB,I INTO FUNNY 'L' CODE. CPA REIOX IF THIS IS TO BE A CALL TO , STB CALEX THEN RESTORE THE JSB,I INSTRUCTION. * GETRX JSB .LDX RESTORE REGISTER,[LDX USED IN INIT] DEF SAVEX DLD SAVEA AND THE REGISTERS, JMP CALEX AND GO EXECUTE THE CALL. * LOCST STA RQB+#ENO SET ERROR NODE: NO SIGN(NUMERIC). JSB PGMAD GET THE CURRENT STATUS DEF *+2 FOR THE USER-SPECIFIED DEF PRAMS+2,I PROGRAM NAME. SZA DOES THE PROGRAM EXIST? JMP GETST YES. GO TO PROCESS THE STATUS. * LDA B21 ESTABLISH ERROR QUALIFIER =1, AND STA RQB+#ECQ MESSAGE LEVEL ALSO =1, FOR RETRIEVAL. LDA "DS" NO. SET ='DS' FOR ERROR INDICATION, CCB AND = -1, FOR USER RETRIEVAL. STB PRAMS+3,I RETURN ERROR TO USER'S PARAM.--IF ANY. JMP NECQ TAKE THE ERROR EXIT. * GETST LDA B GET THE PROGRAM'S STATUS WORD. AND B17 ISOLATE THE STATUS BITS(#3-0), AND RAL,ERA SET SHORT I.D. BIT(#15)--IF TRUE. STA PRAMS+3,I RETURN IT TO CALLER'S PARAMETER--IF ANY. CLB =0 FOR GOOD RETURN. DST RQB+#EC1 CONFIGURE ERROR INFO IN HEADER. STB RQB+#XML ENSURE RETURNED = 0 JMP LOCND GO TO COMPLETE THE CALL. * SKP * INITIALIZATION: CALLED FIRST ENTRY, ONLY; USES PARAM. AREA TO SAVE SPACE. * ORG PRAMS MAKE DOUBLE USE OF CODE SPACE. * INIT LDB CALEX GET THE 'JSB RQLEN,I' INSTRUCTION. STB JSBIN SAVE FOR POSSIBLE RESTORATION. LDB $OPSY IF THIS IS CPB DM9 AN RTE-IV SYSTEM, THEN JMP CNFGX CONFIG. FOR X-MAP PARAM. RETURN; JMP NOMAP ELSE, NO CHANGES ARE REQUIRED. * CNFGX LDB GETRX GET A 'JSB .LDX' (ASSUMES B.P. LINK) STB XMAP1 IT PREPARES 'X' FOR 'MWI'. LDB MWINS GET 'MWI' INSTRUCTION AN~|xD INSTALL IT STB XMAP2 TO MOVE PARAMS. INTO I.D. SEGMENT. * NOMAP STA INIT0 NO NEED TO EVER JMP INIT0+1 CALL THIS CODE AGAIN. * ASMER EQU ERTST-* ASSEMBLY ERROR = OVERFLOW OF PRAMS AREA. * ORR * * HED DEXEC: CONSTANTS AND STORAGE * (C) HEWLETT-PACKARD CO. 1980 * A EQU 0 B EQU 1 RQB EQU #RQB RQBFP DEF #RQB-1 TEMP EQU PRAMS+10 TEMPORARY STORAGE.(2 WDS.) SAVEA NOP SAVEB NOP SAVEO NOP SAVEX NOP SAVEY NOP SAVEN NOP 'ENT' SAVE FOR 'DEXEC'/'DLUEX' DECISIONS. C#DLW ABS #DLW MAX. REQUEST/REPLY LENGTH. N#DBS ABS -#DBS-1 BUFFER LENGTH VALIDITY-CHECKING CONSTANT. DM3 DEC -3 DM7 DEC -7 DM9 DEC -9 DM10 DEC -10 DM31 DEC -31 BIT11 OCT 4000 BIT12 OCT 10000 BIT15 OCT 100000 B17 OCT 17 B21 OCT 21 D1 DEC 1 D3 DEC 3 D5 DEC 5 D9 DEC 9 D11 DEC 11 D12 DEC 12 D13 DEC 13 D23 DEC 23 D24 DEC 24 D25 DEC 25 D99 DEC 99 JSBIN NOP STORAGE FOR 'JSB RQLEN,I' INSTRUCTION. MWINS MWI MOVE WORDS INTO ALTERNATE MAP. CONWD NOP CONSV NOP SHIFTED CONWD: SIGN=BIT#11, LSB=BIT#12 CLNMS OCT 173777 BIT#11 EXCLUSION MASK. D#OPS NOP LOCAL/REMOTE OP-SYSTEM IDENTIFIER. DBLOC NOP NEXT LOCATION IN DATA/Z BUFFER. HILO OCT 100001 ICODE NOP RCODA DEF RCODE POINTER TO LOCAL REQUEST CODE PARAMETER. RCODE NOP .......... " " " " RCODP EQU PRAMS+1 ADDRESS OF RCODE CALLING PARAMETER. RDLEN NOP RMNDR NOP 1'S COMPLEMENT: REMAINING BUFFER LOC'NS. RQLEN NOP WRLEN NOP IRTNP DEF RQB+#RPM ADDRESS OF RETUTNED PARAMETERS. NAMA DEF RQB+#PGN EXECX DEF EXEC REIOX DEF REIO XLUX DEF XLUEX DABFA DEF DABUF DABUF BSS #DBS DATA/Z BUFFER. * SIZE EQU *-DEXEC SIZE OF (OCTAL). * END ~ + 91750-18068 2013 S C0122 &DINIT              H0101 |ASMB,Q,R,C,N IFZ HED DS/1000 INITIALIZATION--SHUTDOWN VERSION REV 2013 NAM DINIT,19,26 91750-16069 REV 2013 800820 ALL (SD) EXT .CAY,.LAY,.SAX,.ADX,.ADY EXT #BUSY,#PNLH,PGMAD,#MAST,#RQB XIF IFN HED DS/1000 INITIALIZATION--NON-SHUTDOWN VERS, REV 2013 NAM DINIT,19,26 91750-16068 REV 2013 800820 ALL (NSD) XIF SPC 1 EXT READF,CLOSE,OPEN,RNRQ,PRTN,XLUEX,IFTTY EXT EXEC,MESSS,$LIBR,$LIBX,$OPSY,#PKUP,PARSE,#RSAX EXT D$XS5,D$LID,D$RID EXT .MVW,.CAX,.DSX,.LDX,.CMW,CLRQ SPC 1 EXT #MA1,#MA2,#MA3,#DISM EXT #RR1,#RR2,#RR3,#RR5 * RES ENTRY POINTS EXT #ST04,#ST10,#MRTH,$BMON,#NMSC,#LV EXT #FWAM,#NULL,#QRN,#LDEF EXT #SWRD,#NODE,#NRV,#NCNT,#EXHC,#EXTC EXT #GRPM,#NCLR,#SCLR,#RFSZ EXT #CNOD,#LEVL,#GTOP,#LU3K EXT #POOL,#MTBL,#RSM,#MAHC,#MARN,#MCTR SPC 1 ENT #PRNT,#READ,#PRSB,#INBF,#PRNL,#EXFR,#CLSB ENT #ABRT,#SYSR,#MSKD,#RNSB,#RSM.,#MA1.,#MA2. * SUP * * NAME: DINIT * SOURCE: 91750-18068 * RELOC.: 91750-16068 (NON-SHUTDOWN VERSION) %DINIT * 16069 (SHUTDOWN VERSION) %DINIS * PGMR: LYLE WEIMAN * TOM MILNER * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * USE "Z" OPTION TO INCLUDE SHUTDOWN CAPABILITY * USE "N" OPTION TO EXCLUDE SHUTDOWN CAPABILITY * SPC 2 * DINIT IS USED TO INITIALIZE * THE DISTRIBUTED SYSTEMS NETWORK THROUGH ESTABLISHMENT OF THE * REQUIRED RESOURCES (CLASS NUMBERS, RESOURCE NUMBERS, TRANSACTION * LISTS, POINTERS, TIMERS, AND CONSTANWBTS), THROUGH THE ACTIVATION * OF 'LISTEN' MODE FOR EACH SPECIFIED COMMUNICATION LINE INTERFACE, * AND BY SCHEDULING THOSE MONITOR-PROGRAMS WHICH SERVICE INCOMING * REQUESTS FROM REMOTE NETWORK NODES. SPC 3 * ONLY THE SHUTDOWN VERSION OF 'DINIT' HAS ANY USE AFTER INITIALIZATION. * (SEE LIST OF COMMANDS BELOW, UNDER "SECONDARY MODE OF EXECUTION") SKP * +----------------------------------------------------------------+ * |SCHEDULING FOR INITIALIZATION: | * +----------------------------------------------------------------+ * * *ON,DINIT,(INPUT LU OR NAMR),(ERROR LU) * * SCHEDULE TO ACCEPT RESPONSES FROM A PERIPHERAL DEVICE, OR, * IN A DISC-BASED SYSTEM (WITH STRING PASSAGE), A FILE. * * NOTE: IF SCHEDULING PARAMETERS ARE NOT SUPPLIED, LU #1 IS THE DEFAULT. * IF THE (INPUT LU) IS LINKED TO AN INTERACTIVE DEVICE, * INTERROGATORY REMARKS WILL BE DISPLAYED ON THE DEVICE. * THE (ERROR LU), IF SPECIFIED, MUST BE LINKED TO AN * INTERACTIVE DEVICE. * * *ON,DINIT,FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * SCHEDULE TO ACCEPT RESPONSES FROM A FILE IN RTE-M. * * NOTE: ANY ERRORS WILL BE REPORTED ON LU #1; WILL THEN ABORT. * * CALL EXEC(10,NAME,-1,ICLAS,IRELN) * * USE A START-UP PROGRAM TO SCHEDULE WITH RESPONSES PASSED * IN I/O CLASS AND LENGTH . (THIS MODE IS INDICATED * BY A NEGATIVE FIRST PARAMETER.) THIS WORKS FOR RTE-M AND -L ONLY. * * NOTE: ANY LINE IN THE INPUT FILE WHICH BEGINS WITH AN * ASTERISK (*) IS TREATED AS A COMMENT. * * +--------------------------------------------------------------+ * |INITIALIZATION QUERIES AND VALID RESPONSES (IN NORMAL ORDER): | * +--------------------------------------------------------------+ * * NOTE: CONTROL FILE RESPONSES CONSIST OF 1 RECORD / RESPONSE. * /A : ABORT IS A VALID RESPONSE TO ALCL QUERIES. * * /DINIT: SYSTEMS CONNECTED TO THIS NODE * /DINIT: HP 1000? * /DINIT: HP 3000? * * /DINIT: NO. OF ACTIVE TRANSACTIONS? <1-100 (/D =DEFAULT OF 20) * NOTE: EACH TRANSACTION USES 5 WORDS OF SAM.> * * /DINIT: HOW MANY NODES REQUIRE MSG ACCOUNTING? <0 TO # NODES, * ANSWER TO THIS QUESTION PROVIDES TABLE SPACE FOR MESSAGE * ACCOUNTING. ANSWER 0 IF NONE DESIRED >. * * --- NOTE --- * THE FOLLOWING QUESTIONS ARE ASKED ONLY IF A HP3000 * IS CONNECTED. * * /DINIT: MAX NO. OF CONCURRENT HP3000 USERS? <1-10 (/D=DEFAULT OF 4) * NOTE: EACH CONCURRENT USER REQUIRES 14 WORDS OF SAM > * * /DINIT: LU OF HP3000? * * /DINIT: LOCAL ID SEQUENCE? <15 CHAR MAX: /E IF NONE. * NOTE: ASKED ONLY FOR MODEM LINK > * * /DINIT: REMOTE ID SEQUENCE? <15 CHAR MAX: /E IF NONE * NOTE: ASKED ONLY FOR MODEM LINK >. * * --- END HP3000 OPTION --- * * * /DINIT: LOCAL CPU #? < RANGE: 0 TO 32767, * DEFINES LOCAL NODE #> * * /DINIT: NUMBER OF NODES? * * /DINIT: NUMBER OF RE-ROUTING LINKS? < 0-32767, THIS DEFINES * THE SIZE OF RE-ROUTING TABLES. THIS QUESTION IS ASKED * ONLY IF RE-ROUTING IS GENERATED INTO THE NODE. * * /DINIT: CPU#[,LU][,TIMEOUT][,UPGRADE LEVEL][,N][,MA][,MA TIMEOUT]? * * * * * <"N" : =INDICATES THIS IS A NEIGHBOR (IE., ONE HOP AWAY) * NODE. THIS IS REQUIRED IF NEGATIVE LU ADDRESSING * IS GOING TO BE USED. * <"MA" : INDICATES THAT MA IS REQUIRED FOR THIS NODE. * THIS CANNOT BE THE LOCAL NODE. > * [,COST] * * < ANY VALID LINK LU (IE., DEVICE TYPE 65 OR 66) IN THE * RANGE 1-255. NOTE: THE FIRST N LU'S CORRESPONDS TO * THE NUMBER OF RE-ROUTING LINKS ANSWER ABOVE. THAT IS * IF THERE ARE 2 RE-ROUTING LINKS THEN ONLY THE FIRST * 2 LU'S WILL BE CONSIDERED RE-ROUTEABLE. THIS QUESTION IS * REPEATED UNTIL THE USER ENTERS "/E".> * * --- END OF HP1000 OPTION --- * * * /DINIT: MONITOR NAME? * * * /DINIT: INPUT # OF FILES: <1 TO 255 (TOTAL FILES OPEN TO ALL NODES)> * < NOTE: ASKED ONLY FOR /D OPTION, OR WHEN SPECIFIED> * * /DINIT: NETWORK USER SECURITY CODE? * THIS SECURITY CODE MUST BE KNOWN TO ALL USERS OF 'REMAT', AS IT * IS REQUIRED TO USE THE "SWITCH" COMMAND. * * /DINIT: NETWORK MANAGEMENT SECURITY CODE? (ENTER ASCII AS FOR ABOVE * SECURITY CODE) * THIS CODE IS REQUIRED FOR THE FOLLOWING: * 1) NODE QUIESCENCE * 2) QUIESCENT NODE RE-START * 3) TIMIN@G MODIFICATION * 4) SHUTDOWN (IF OPTION PRESENT) * 5) CHANGING NRV * IT IS NOT NECESSARY FOR THIS CODE TO BE KNOWN BY ANYONE * EXCEPT THE NETWORK MANAGER. * DO NOT FORGET THE CODES YOU USE, AS THEY CANNOT BE OBTAINED AGAIN! * * * FOLLOWING INITIALIZATION, THE PROGRAM TERMINATES. * * IF RUN AGAIN, THE NON-SHUTDOWN VERSION WILL PRINT THE MESSAGE: * * "NODE ALREADY INITIALIZED" * * THAT IS, THE NON-SHUTDOWN VERSION IS USEFUL ONLY FOR * INITIALIZING THE NODE. * * THE SHUTDOWN VERSION WILL PRINT: * * "SHUTDOWN?" * * SHUTDOWN WILL PROCEED ONLY IF THE USER RESPONDS WITH "YES". * SKP * +--------------------------------------------------------------+ * |SCHEDULING FOR SECONDARY MODE OF OPERATION: | * +--------------------------------------------------------------+ * * (INPUT LU# OR FILE),(ERROR LU#) * / * *ON,DINIT, : -1,CLASS #,RECORD LENGTH * FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * IN SECONDARY MODE, SCHEDULING WITH AN INTERACTIVE TERMINAL * AS THE (INPUT LU#) DEVICE, OR UNDER THE CONTROL OF A COMMAND FILE, * WILL ALLOW THE USER TO SELECT SEVERAL POSSIBLE OPERATIONS. * * +-------------------------------------------------------------------+ * |SECONDARY MODE QUERIES AND VALID RESPONSES: | * +-------------------------------------------------------------------+ * * * ----------- TO SHUTDOWN DS ACTIVITY & RELEASE RESOURCES --- * * /DINIT: SHUTDOWN? YES * /DINIT: SYSTEM SHUTDOWN * /DINIT: # ACTIVE TCBS: NNNNN * /DINIT: # ACTIVE REMOTE SESSIONS: NNNNN * /DINIT: NETWORK MANAGEMENT SECURITY CODE? * THE NETWORK MANAGEMENT SECURITY CODE MUST BE ENTERED CORREC'TLY, * OR 'DINIT' WILL ABORT. IF A NON-ASCII CODE IS ENTERED, THE * QUESTION WILL BE REPEATED. * END DINIT (TERMINATION MESSAGE) * * "SHUTDOWN" MAY BE INVOKED WHENEVER DINIT IS SCHEDULED IN THE * SECONDARY MODE. WHEN SHUTDOWN IS COMPLETE, ALL RESOURCES OF * ANY KIND WHICH WERE ALLOCATED TO NETWORK-RELATED ACTIVITY * DURING THE PREVIOUS INITIALIZATION ARE RETURNED TO RTE. * THIS INCLUDES ALL CLASS NUMBERS, CLASS BUFFERS, RESOURCE NUMBERS, * NETWORK-RELATED PROGRAMS (GRPM,RTRY,QCLM,UPLIN,QUEX,QUEZ, * RPCNV,RQCNV,QUEUE,ETC.) AND ALL ALLOCATED SAM ARE RETURNED TO RTE. * * THIS MEANS ALL SYSTEM RESOURCES * * ALL COMMUNICATION LOGICAL UNITS * DEFINED IN THE NRV ARE CLEARED: THEY WILL NOT RESPOND TO INCOMING * MESSAGES. ALL SLAVE MONITORS ARE ABORTED AND THEIR CLASS NUMBERS * AND ANY BUFFERS OUTSTANDING ARE CLEARED (NOTE: ALL FILES CURRENTLY * OPEN TO 'RFAM' WILL BE LOST. FILES WHICH HAVE BEEN WRITTEN ON WILL * BE CORRUPTED). ALL MASTER PROGRAMS WAITING * FOR REPLIES ARE GIVEN A MASTER TIME-OUT ERROR. IF THEY REPEAT THEIR * REQUEST, THEY WILL RECEIVE A DS00 ERROR. * * THEREFORE, USE CARE IN DETERMINING WHEN TO RE-INITIALIZE. * * THE NEXT TIME DINIT IS SCHEDULED, IT WILL REQUEST INITIALIZATION. * * THE USER SHOULD ALSO BE AWARE THAT WHENEVER DS/1000 IS * INITIALIZED, A BLOCK OF SAM IS ALLOCATED SEMI-PERMANENTLY FOR THE * DS-RELATED TABLE AREAS (TCBS, NRV, ETC.). IT IS NOT RETURNED TO * RTE UNTIL DS IS SHUTDOWN OR THE SYSTEM IS RE-BOOTED. INITIALIZING * DS WHILE OTHER PROGRAMS HAVE SAM: BLOCKS ALLOCATED WILL FRAGMENT SAM: * THAT IS, IT MAY DIVIDE THE "LARGEST POSSIBLE SAM BLOCK" (THE * SIZE OF WHICH RTE DETERMINES AT BOOT-UP) INTO TWO PORTIONS. IT WILL * THEN NOT BE POSSIBLE FOR A PROGRAM TO OBTAIN SUCH A LARGE BLOCK, * ALTHOUGH RTE WON'T KNOW THIS, WHICH MAY CAUSE A "DEADLOCK" CONDITION: * THE PROGRAM WILL BE WAITING FOR A BLOCK WHICH CAN NEVER BE GRANTED. * IT WILL BE PLACED INTO UNAVAILABLE MEMORY SUSPENSION DURING THIS * TIME, WHICH WILL HAVE THE SIDE EFFECT OF PREVENTING ANY * OTHER PROGRAMS OF LOWER PRIORITY FROM GAINING ANY SAM AT ALL, * EVEN SMALL BLOCKS WHICH COULD BE GRANTED (THIS IS A POLICY ENFORCED * BY RTE WHOSE PURPOSE IS TO ASSURE THAT HIGH-PRIORITY PROGRAMS * ARE NOT LOCKED OUT BECAUSE A SERIES OF SMALL-BLOCK SAM ALLOCATIONS * BY LOW-PRIORITY PROGRAMS PREVENTS A LARGE BLOCK FROM EVER BECOMING * FREE). THIS IN TURN MAY FORCE MORE PROGRAMS INTO UNAVAILABLE * MEMORY SUSPENSION THAN ACTUALLY BELONG THERE. * * THIS LEADS TO THE CONCLUSION THAT IT MAY BE HAZARDOUS (IN TERMS * OF AVOIDING DEADLOCKS AND MAXIMIZING OVERALL THRUPUT) TO * FREQUENTLY RE-INITIALIZE THE DS SYSTEM. IT ALSO FOLLOWS THAT IT * SHOULD BE INITIALIZED ON BOOT-UP. HOWEVER, THE USER WHO NEEDS TO * SHUT THE SYSTEM DOWN OCCASIONALLY, AND THEN START IT UP AGAIN * AND WHO CANNOT AFFORD TO SHUT THE SYSTEM DOWN TO RE-BOOT, SHOULD * TRY TO ARRANGE FOR INITIALIZATION TO OCCUR AT TIMES WHEN THE * OTHER DEMANDS UPON SAM ARE VERY SMALL OR NON-EXISTENT. * * * NOTE 1: THE NUMBER OF ACTIVE TCBS AND # OF ACTIVE HP 3000 SESSIONS * ARE PRINTED IN ORDER TO GIVE SOME INDICATION OF THE RELATIVE * DISTRIBUTED-SYSTEMS REMOTE ACTIVITY. IF THERE EXIST EITHER ACTIVE * TCBS OR ACTIVE HP 3000 SESSIONS, THEN SHUTTING DOWN WILL PROBABLY * INTERFERE WITH SOME USER OF THE SYSTEM (THAT IS, TERMINATE ALL * HIS PROCESSES ABNORMALLY, PERHAPS CAUSING OPEN FILES TO BE CORRUPTED * OR, IN EXTREME CASES, PERHAPS DESTROYING A REMOTE DATA BASE). * IT IS STRONGLY RECOMMENDED THAT THE USER FIRST BROADCAST HIS * INTENTION TO SHUT THE SYSTEM DOWN TO ALL REMOTE USERS, GIVING * THEM TIME TO CLOSE THEIR FILES AND LOG OFF BEFORE DOING SO. * * IF THE SECURITY CODE ENTERED IS NON-NUMERIC, OR DOES NOT MATCH * THE ORIGINAL SET-UP SECURITY CODE, SHUTDOWN WILL NOT OCCUR. * IF YOU HAVE ASKED FOR SHUTDOWN, BUT DECIDE YOU DON'T WANT TO AFTER * SEEING THAT THE SYSTEM IS BEING USED, ENTER A ZERO FOR THE SECURITY * CODE (OR ANY NUMERIC, OR ANY INCORRECT SECURITY CODE). * * NOTE 2: ONCE SHUTDOWN HAS BEEN COMPLETED, THE NEXT TIME DINIT * IS SCHEDULED IT WILL ENTER THE INITIALIZATION MODE. SKP * * ERROR MESSAGES--INTERPRETATION AND APPROPRIATE ACTION: * ----------------------------------------------------- * * [ ALL MESSAGES ARE PRECEDED BY "/DINIT:"] SPC 1 * CLASS I/O ERROR - A REQUIRED CLASS NUMBER CANNOT BE ALLOCATED. * IS ABORTED. THIS ERROR MAY REQUIRE * RE-GENERATION WITH A LARGER ALLOTMENT OF CLASS NO'S. * * * END DINIT - NORMAL COMPLETION MESSAGE. THE TEN CHARACTERS * COMPRISING THE MESSAGE ARE ALSO RETURNED IN THE 5-WORD * TEMPORARY STORAGE AREA OF A SCHEDULER'S I.D. SEGMENT. * THEY MAY BE RECOVERED THROUGH THE USE OF . * IF HAS BEEN ABORTED, THE FIVE WORDS OF * RETURNED-DATA CONSIST OF: 100000B,ER, L,ST,EN * * ERROR: MON?: AAAAA * - THE SPECIFIED MONITOR IS NOT IN THE SYSTEM. * ABORT , USING /A COMMAND, AND THEN LOAD * THE MONITOR INTO THE SYSTEM. RE-START . * * ERROR: STAT: AAAAA * - THE MONITOR'S STATUS IS NOT 'DORMANT', AND * THEREFORE IT CANNOT BE SCHEDULED. * ABORT , USING /A COMMAND, AND THEN USE * RTE OPERATOR COMMANDS TO CHANGE THE STATUS. * * FILE ERROR - IMPROPER RESPONSE TO "INPUT # OF FILES". RETRY. * * INVALID NAME! - MONITOR NAME IS NOT RECOGNIZED BY . RETRY. * * INVALID RESPONSE! - OPERATOR ENTRY ERROR. RETRY. * (NO # RETRY ALLOWED FOR QUIESCENT OR RE-START MODE) * * DINIT ABORTED -IF INITIALIZATION WAS IN PROGRESS, THEN ALL ALLOCATED * RESOURCES HAVE BEEN RETURNED TO RTE. * * NODE SPEC. ERROR -IMPROPER NODAL REFERENCE VALUE. ABORTED! * CORRECT INITIALIZATION ANSWERS AND RESTART . * * LU ERROR IMPROPER LU# SPECIFIED, OR LU# NOT LINKED TO * COMMUNICATION LINK DRIVER. RETRY. * * THIS LU ALREADY HAS A NEIGHBOR! * - THE NEIGHBOR BIT WAS SET FOR TWO DIFFERENT NODES * USING THE SAME LU. EITHER ABORT DINIT OR INPUT * THE LINE AGAIN CORRENTLY. * * INVALID TIMEOUT! THE TIMEOUT VALUE SPECIFIED WAS NOT IN THE RANGE * 0-1275. EITHER ABORT DINIT OR INPUT THE LINE * AGAIN CORRECTLY. * * INVALID UPGRADE LEVEL! * - THE UPGRADE LEVEL IS NOT IN THE RANGE 0-15. EITHER * ABORT DINIT OR INPUT THE LINE AGAIN CORRECTLY. * * NO SYSTEM MEMORY! - INSUFFICIENT SYSTEM AVAILABLE MEMORY FOR USE BY * THE NETWORK. SYSTEM CANNOT BE INITIALIZED. * IS ABORTED. RE-GENERATION OF RTE MAY * BE REQUIRED. * * READ ERROR - END-OF-FILE OR FMGR ERROR HAS BEEN DETECTED * ON THE INPUT DEVICE/FILE. THE QUESTION IS REPEATED * ON THE (ERROR LU) DEVICE. THE USER MAY SUPPLY THE * REQUIRED RESPONSE FROM THIS DEVICE. * * RN ERROR - A REQUIRED RESOURCE NUMBER CANNOT BE ALLOCATED; * IS ABORTED. RE-GENERATION, WITH A LARGER * ALLOTMENT OF RESOURCE NUMBERS, MAY BE REQUIRED. * * TR FILE ERROR - THE FILE MANAGER CANNOT PROCESS THE FILE * WHICH WAS SPECIFIED IN THE SCHEDULING * PARAMETERS. CORRECT THE FILE PROBLEM, * , AND RE-SCHEDULE . * * WARNING XXXXX IS A REQUIRED DS/1000 PROCESSOR! * - DS/1000 WILL NOT RUN CORRECTLY UNTIL THIS * PROGRAM IS LOADED. IF THE PROGRAM IS 'UPLIN', * DINIT WILL ABORT. IF NOT, DINIT WILL CONTINUE, * BUT THE PERFORMANCE IS UNPREDICTABLE UNTIL THIS * MODULE IS LOADED. 'UPLIN' WILL SCHEDULE THE * MODULE WHEN IT IS LOADED AUTOMATICALLY. * * NODE ALREADY INITIALIZED * - (NON-SHUTDOWN VERSION ONLY). ONCE DS/1000 IS * INITIALIZED THERE IS NOTHING MORE FOR 'DINIT' TO * DO. * * ANSWER YES OR NO - THE QUESTION REQUIRES A "YES" OR "NO" ANSWER SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS 9IEQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV XXXX 790420 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, LSTEN, REMAT * * * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SKP PRAM BSS 5 SPC 2 *** THREE SCHEDULING PARAMETERS ARE SET UP BY #PKUP *** * * PARAMETER MASK FOR #PKUP-- PMASK BYT 3,1 3 PARAMETERS, 1ST IS NAMR. * *** NOTE: DO NOT CHANGE ORDER OF NEXT 4 LINES! NAME BSS 4 RTE FILE NAMR PARAMETERS. ISEC BSS 1 ICR BSS 5 PRM2 NOP ERROR LU/CLASS NUMBER (2ND PARAM) PRM3 NOP RECORD LEN (3RD PARAM) * DEFLU NOP DEFAULT LU NUMBER. SPC 2 * DEFINE MASTER TCB FORMAT * SEQ# -EQU 2 OFFSET TO SEQUENCE NUMBER MSCLS EQU 3 MASTER CLASS NUMBER SKP DINIT EQU * JSB #PKUP GET THE DEF *+4 PARAMETERS DEF PMASK FOR LOCAL USE. DEF NAME DEF DEFLU * LDA @ENMG INITIALIZE ADDRESS OF RETURN PARAMS TO STA $RTRN 'FATHER' PROGRAM LDA $OPSY GET THE SYSTEM SPECIFICATIONS. RAR,RAR BIT#15: 1=DMS BIT#0: 1=RTE, 0=RTE-M. STA OPTYP SAVE THE USEFUL SYSTEM SPECIFICATIONS. SSA,RSS JMP NODMS THIS IS A NON-DMS SYSTEM * DLD XSBAI GET THE CROSS-STORE INSTRUCTION, DST STLNK AND CONFIGURE THE TWO NULL-LINK DST STERM INSTRUCTIONS FOR DMS OPERATION. DST LOOP3 DLD XCBAI DST NCHEK DLD MWII DST STNOP DLD MWFI PICK UP MWF INSTRUC DLD XLABI PICK UP XLA B,I DST DSNR8 IFZ DST DSNR4 DST DSNR5 DST DSNR7 DST DSNR9 XIF * * PICK UP READ LU NODMS LDA NAME GET THE INPUT LU--IF ANY. LDB #FWAM GET "ALREADY-INITIALIZED" INDICATOR. STB ONTWO SAVE IN OPTION 1/2 FLAG WORD CLB INITIALIZE EQUIPMENT TYPE CODE STB TYPEQ TO INDICATE AN INTERACTIVE DEVICE. STB CLFLG CLEAR CLASS I/O FLAG. STB LINE# CLEAR INPUT LINE NUMBER COUNT * LDB DEFLU IF LU NOT SUPPLIED, USE DEFAULT. SZA SUPPLIED? LDB A YES AND BT137 LU OR FILE? SZA CLB FILE...CLEAR FILE FLAG STB RLU SAVE READ LU OR 0 (FILE). SZB,RSS LU OR FILE? JMP LSTN1 FILE * JSB TTY? CHECK DEF RLU READ LU. SZB,RSS TTY? STA RLU SAVE AS INPUT LU STB TYPEQ SAVE INPUT DEVICE EQUIPMENT CODE. * * PICK UP ERROR LU LSTN1 LDA PRM2 SZA IS ERROR LU SUPPLIED? JMP LSTN2 YES...SAVE IT. LDA RLU NO. GET THE INPUT LU. SZA,RSS IS INPUT FROM FILE? JMP SDFLU YES...USE DEFAULT. LSTN2 STA ERLU SAVE ERROR LU * JSB TTY? CHECK DEF ERLU ERROR LU. SZB INTERACTIVE? SDFLU LDA DEFLU NO...SET TO DEFAULT. STA ERLU * JSB CHCKN SEE IF ERROR DEVICE IS A FILE JMP LSTN3 NOT FILE * LDA NAME WAS 1ST PARAMETER SSA NEGATIVE? JMP CLASS YES--DO CLASS READ. * JSB OPEN OPEN THE ANSWER FILE DEF *+7 DEF INDCB DEF TEMP1 ERROR-RETURN LOC'N. DEF NAME FILE NAME LOC'N. DEF ZERO EXCLUSIVE OPEN. DEF ISEC SECURITY CODE (OR 0). DEF ICR CARTRIDGE NO. (OR 0). SSA,RSS ERRORS? JMP LSTN3 OPEN WAS SUCCESSFUL. * JSB SYSER SYSTEM ERROR DEF TRFM "TR FILE ERROR" * LSTN3 EQU * LDB ONTWO OPTION 1/2 FLAG SZB OPTION 1? IFN JMP NINZD NO SECONDARY MODE FOR NON-SHUTDOWN XIF IFZ JMP OPTN2 NO...OPTION 2 XIF JMP INITL INITIALIZE THE NODE! * IFN NINZD JSB SYSER NODE HAS ALREADY BEEN INITIALIZED DEF .NINZ XIF * * SET UP DCB FOR DUMMY READFS DMDCB OCT 0,0 DIRECTORY ADDR DEC 2 FILE TYPE DEC 1,1 TRACK,SECTOR OF FILE DEC 2 # OF SECTORS (128 WORDS TOTAL) RECL BSS 1 RECORD LEN (3RD PARAMETER) D128 OCT 200 1 BLOCK IN DCB DEC 96 # SECTORS/TRACK OPNFL BSS 1 "OPEN" FLAG DEC 1,1 CURRENT TRACK,SECTOR DEF INDCB+16 ADDRESS OF DCB DATA OCT 100000 DATA IS IN DCB DEC 1 RECORD # DEC 0 EXTENT # @DMDC DEF DMDCB @DCB DEF INDCB * CLASS STA CLFLG SET CLASS I/O FLAG < 0. LDA $BMON CHECK FOR NEW DCB FORMAT SZA +0 NEW? JMP ABORT NEW FORMAT NOT ALLOWED. LDA PRM3 GET RECORD STA RECL LENGTH. JSB #GTOP OBTAIN "OPEN" FLAG STA OPNFL AND SAVE IT. JSB EXEC MOVE DEF *+5 DCB DEF CLS21 DATA DEF PRM2 VIA DEF INDCB+16 CLASS DEF D128 I/O. JMP ABORT [ERROR RETURN] LDA @DMDC MOVE LDB @DCB DCB HEADER JSB .MVW INFORMATION. DEF D15 NOP JMP LSTN3 CONTINUE WITH NORMAL PROCESSING. SKP *---------------------------------------------------------------+ * INITIALIZATION CONTROL SECTION. | *---------------------------------------------------------------+ INITL JMP *+4 ENTER HERE FOR FIRST RUN JSB QUERY INVALID RESPONSE DEF IVRES JMP *+3 JSB PRINT TELL USER: DEF MSG1 "SYSTEMS CONNECTED TO THIS NODE:" * LDA ASC10 ASK USER TO SPECIFY JSB CPUCK "HP 1000?" RMSA NOP * LDA ASC30 ASK USER TO SPECIFY JSB CPUCK "HP 3000?" RM3K NOP 3000 FLAG * IOR RMSA \ MAKE SURE SZA,RSS > AT LEAST ONE TYPE NODE JMP INITL+1 / WAS SPECIFIED *---------------------------------------------------------------+ * BEGIN TO GET SAM REQUIREMENTS | *---------------------------------------------------------------+ JSB PRINT ASK THE USER TO SPECIFY THE: DEF MSG0 " NO. OF ACTIVE TRANSACTIONS?" JMP *+3 TRERR JSB QUERY IMPROPER REPLY TO # OF TRANSACTIONS DEF IVRES LDA D20 INITIALIZE DEFAULT NO. STA PRAM OF TRANSACTIONS =20. JSB READ READ THE RESPONSE. CPA B1 IF THE RESPONSE WAS NUMERIC, JMP SVALU GO TO PROCESS IT; ELSE, DETERMINE CPB /D IF DEFAULT VALUE IS TO BE USED. JMFP SDFLT USE THE DEFAULT VALUE (20). JMP TRERR INVALID RESPONSE - ASK AGAIN * SVALU STB PRAM SAVE NO. OF TRANSACTIONS, TEMPORARILY. SSB,RSS IF VALUE NEGATIVE--INFORM USER OF ERROR. CMB,INB,SZB,RSS NEGATE THE NUMBER & CHECK FOR ZERO. JMP TRERR * ERROR: NUMBER IS INVALID--TRY AGAIN * ADB D100 ADD THE MAXIMUM ALLOWABLE NO. (100). SSB IS THE SPECIFIED NO. ALLOWABLE? JMP TRERR NO. GO INFORM HIM OF THE ERROR! * SDFLT LDB PRAM GET THE NUMBER OF TRANSACTIONS. CMB,INB FORM A LOOP COUNT STB NTCBS SAVE THE LOOP COUNT. LDA PRAM GET THE NUMBER OF TRANSACTIONS. MPY TCBSZ CALCULATE: MEMORY SIZE(WORDS) = SZB,RSS SSA CHECK SAM SIZE JMP TOBIG STA SZTCB SAVE SIZE OF TCB AREA STA SAMSZ START OUT W/ SAMSZ= SIZE OF TCB AREA * CLA FIND OUT HOW MUCH SAM TO ALLOCATE FOR JSB #DISM REMOTE SESSIONS SSA JMP TOBIG CHECK SAM SIZE STA POOLZ SAVE SIZE ADA SAMSZ ADD TO SIZE OF SAM REQ'D SSA CHECK SAM SIZE JMP TOBIG STA SAMSZ * LDA RMSA ANY RTE-TO-RTE SZA NODES? JSB #MA1 COMPUTE SIZE OF M.A. TABLES SSA CHECK SAM SIZE JMP TOBIG STA MASIZ SAVE SIZE OF M.A. TABLES ADA SAMSZ SSA CHECK SAM SIZE JMP TOBIG STA SAMSZ * LDA RM3K SZA,RSS JMP #1K? NO HP3000--SKIP BELOW CODE *---------------------------------------------------------------+ * GET 3K PARAMETERS | *---------------------------------------------------------------+ JSB PRINT ASK USER TO SPECIFY DEF MSG4 "MAX NO. CONCURRENT HP3000 USERS?" JMP *+3 #3K? JSB QUERY ASK USER AGAIN DEF IVRES * LDA B4 INITIAzLIZE DEFAULT NUMBER OF STA TST#+1 CONCURRENT USERS = 4 JSB READ READ RESPONSE CPA B1 RESULT NUMERIC? JMP SVAL1 YES--PROCESS IT CPB /D DEFAULT WANTED? JMP SDFL1 USE DEFAULT OF 4 JMP #3K? SVAL1 STB TST#+1 SAVE # OF USERS SSB,RSS IF NEGATIVE--ERROR CMB,INB,SZB,RSS NEGATE NUMBER & CHECK FOR ZERO JMP #3K? REPORT ERROR ADB D10 ADD MAXIMUM NUMBER ALLOWED (10) SSB BEYOND RANGE? JMP #3K? YES--REPORT ERROR SDFL1 LDA TST#+1 MPY D14 SZB,RSS SSA CHECK SAM SIZE JMP TOBIG STA TSTSZ SAVE # WORDS IN TST. ADA SAMSZ ADD NO. WORDS FOR TRANSACTIONS SSA CHECK SAM SIZE JMP TOBIG STA SAMSZ STORE TOTAL SAM NEEDED *-- INITIALIZE THE 3000 LINK JSB PRINT ASK THE USER DEF D3MS1 "LU OF HP3000?". D3010 JSB READ GET THE RESPONSE. CPA B1 IF THE RESPONSE WAS NUMERIC, JMP D3020 GO TO PROCESS IT; ELSE DETERMINE D3ER1 JSB QUERY DEF LUERM "LU ERROR". JMP D3010 TRY AGAIN. * D3020 STB LU3K# SAVE HP3000 LU INTERNALLY FOR NOW. LDA B IOR BIT15 STA LU1 CLB STB LU2 SET SUB-FUNCTION = 0 * JSB XLUEX GO TO RTE DEF *+4 TO GET THE DEF SD13 EQUIPMENT TYPE-CODE DEF LU1 LINKED TO THE LU # DEF PRINT SUPPLIED BY THE USER. JMP D3ER1 INVALID LU. * CLA STA D$XS5 D$XS5 := 0 (HARD-WIRED) LDA PRINT ISOLATE THE ALF,ALF EQUIPMENT AND B77 TYPE-CODE. CPA B66 DVA66, OR JMP D3025 CPA B67 DVG67, JMP #1K? JMP D3ER1 IT IS AN INVALID LU. * D3025 LDA B2 SWTCH := 2 (MODEM) STA D$XS5 * * GET LOCAL AND REMOTE2 ID SEQUENCES. * * JSB PRINT ASK THE USER DEF D3MS4 "LOCAL ID SEQUENCE?" JSB READ GET THE RESPONSE. LDA PRNTL GET # BYTES THAT WERE INPUT. CPB /E IF ID SEQ NOT WANTED, CLA LENGTH IS 0 LDB D$LID JSB STRID STORE LOCAL ID SEQ IN "RES". * JSB PRINT ASK THE USER DEF D3MS5 "REMOTE ID SEQUENCE?" JSB READ GET THE RESPONSE. LDA PRNTL GET # BYTES THAT WERE INPUT. CPB /E IF ID SEQ NOT WANTED, CLA LENGTH IS 0 LDB D$RID INB SKIP WORD FOR RETURN PARAM. JSB STRID STORE REMOTE ID SEQ IN "RES". * #1K? LDA RMSA IF THERE ARE NO HP 1000 LINKS, SZA,RSS THEN SKIP JMP SGCO FOLLOWING BLOCK. * * GET SIZE OF NRV ENTRIES * JSB PRINT ASK FOR NUMBER OF NODES DEF NUMB? JMP *+3 INIT1 JSB QUERY NODE SPEC ERROR - ASK USER AGAIN DEF NOSZR JSB READ GET THE ANSWER. CPA B1 NUMERIC? RSS JMP INIT1 NO, PRINT ERROR SZB ZERO? SSB OR NEGATIVE? JMP INIT1 YES--ERROR! STB NRVSZ SAVE # ENTRIES IN NRV CMB,INB SET MAX. HOP COUNT STB MHCT# STB NCNT * * CALL RE-ROUTING ROUTINE HERE TO FIND OUT SIZE OF RE-ROUTING TABLE * * (B) = - # OF NODES JSB #RR1 SSA CHECK SAM SIZE JMP TOBIG STA RRSIZ SAVE SIZE OF RE-ROUTING TABLE ADA SAMSZ ADD TO SIZE OF SAM REQ'D SSA JMP TOBIG STA SAMSZ * * COMPUTE AMOUNT OF SAM REQUIRED: * TCBS, PNLS, NRV, RSM, RR, MA TABLES (SOME OPTIONAL) LDA NRVSZ COMPUTE # WORDS NEEDED FOR NRV MPY NRVS. SZB,RSS SSA CHECK SIZE OF SAM JMP TOBIG STA SZNRV ADA SAMSZ SSA JMP TOBIG STA SAMSZ * * DLD CNLODE INITIALIZE RES NODAL ADDRESSES DST #CNOD * *---------------------------------------------------------------+ * ALLOCATE CLASS AND RESOURCE NUMBERS, INITIALIZE TCB NULL | * LIST AND TRANSACTION STATUS TABLE AREA. | * | * POINTER NAME: SAM AREA DIVIDED AS FOLLOWS: | * +--------------------+ | * #FWAM-------------------> ! TCB ! | * ! AREA ! | * +--------------------+ | * #TST--------------------> ! TST AREA ! | * +--------------------+ | * #NRV--------------------> ! NRV AREA ! | * +--------------------+ | * #MTBL-------------------> ! M.A. AREA ! | * +--------------------+ | * ! RE-ROUTING TABLES: ! | * ! ! | * #LV---------------------> ! LINK VECTOR TABLE ! | * ! ! | * #CM---------------------> ! "COST" MATRIX ! | * +--------------------+ | * #POOL-------------------> ! REMOTE SESSION ! | * ! TABLES ! | * +--------------------+ | * | * SIZE OF ENTIRE AREA STORED IN #SAVM. | *---------------------------------------------------------------+ SPC 2 SGCO EQU * LDA SAMSZ SET-UP SAM BLOCK STA TEMP SAVE TOTAL WORDS REQUIRED LDA DM3 STA cRETRY SET # OF RETRIES FOR "DELAY" ROUTINE SREPT JSB #RSAX GO TO THE DEF *+4 SYSTEM RESOURCE-CONTROL ROUTINE, DEF ZERO TO REQUEST SYSTEM AVAILABLE MEMORY, DEF TEMP IN THE AMOUNT SPECIFIED BY THE USER. DEF LSECD * SSA,RSS REQUEST GRANTED? JMP SETPS YES. GO TO SET POINTERS JSB DELAY NO. IT'S NOT AVAILABLE NOW--WAIT. JMP NOMER * RETRIES EXHAUSTED: INFORM USER! JMP SREPT TRY AGAIN FOR MEMORY ALLOCATION. * SETPS EQU * JSB CLEAR CLEAR OUT 'RES' AREA LDA #FWAM ADA SZTCB AFTER THE T.C.B.S STA TST# ADA TSTSZ THE N.R.V. AREA FOLLOWS IMMEDIATELY STA #NRV AFTER THE TST STA NPNT ADA SZNRV THE M.A. TABLE AREA FOLLOWS IMMEDIATELY STA #MTBL AFTER THE NRV ADA MASIZ THE RE-ROUTING TABLES FOLLOW IMMEDIATELY STA #LV AFTER THE M.A. TABLES ADA RRSIZ THE REMOTE SESSION TABLE FOLLOWS IMMEDIATELY STA #POOL AFTER THE RR TABLES CLA IF THERE IS NO SESSION ANYWHERE CPA POOLZ IN THE NET, THEN ZERO STA #POOL THE POOL POINTER * JSB RNSUB GET A RESOURCE NUMBER DEF TBRN. FOR THE TABLE-ACCESS RN. JSB RNSUB GET A RESOURCE NUMBER DEF QRN. FOR THE SYSTEM-QUIESCENT RN. * LDA RM3K SZA,RSS JMP SGPP NO HP3000--SKIP THIS CODE * CCA GET A JSB CLSUB CLASS NUMBER DEF QXCL. FOR "QUEX" JSB RNSUB GET A RESOURCE NUMBER DEF QZRN. FOR "QUEZ" LISTEN MODE JSB RNRQ GLOBAL LOCK RN DEF *+4 DEF GLOCK DEF QZRN# DEF TEMP1 JSB RNSUB GET A RESOURCE NUMBER DEF CLRN. FOR QUEX CLEANUP CCA JSB CLSUB GET A CLASS NUMBER DEF RQCV. FOR REQUEST CONVERTER < CCA JSB CLSUB GET A CLASS NUMBER DEF RPCV. FOR REPLY CONVERTER * LDA RMSA SZA,RSS JMP NULNK JUMP IF NO DS/1000 * SGPP CLA GET A JSB CLSUB CLASS NUMBER DEF GRPM. FOR THE GENERAL PRE-PROCESSOR MODULE. CLA GET A JSB CLSUB CLASS NUMBER DEF RTRY. FOR THE WRITE RETRY MODULE CLA GET A JSB CLSUB CLASS NUMBER DEF QCLM. FOR THE ERROR LOG MONITOR. NULNK EQU * * * = # OF NODES IN NRV LDA NRVSZ JSB #MA2 SETUP MA VARIABLES * LDA NRVSZ SET SIZE OF NRV CMA,INA STA #NCNT * * GET DEFAULT SESSION USER NAME (IF NEEDED) * CLA,INA JSB #DISM * LDA RMSA ARE THERE SZA,RSS HP 1000 LINKS? JMP INRES NO, SKIP THIS BLOCK * * THIS BLOCK SETS UP THE ROUTE VECTORS * JSB PRINT ASK FOR THE CPU # DEF LOC? JMP *+3 LCPU? JSB QUERY ASK USER AGAIN FOR CPU# DEF NOSZR JSB READ READ CPU NUMBER CPA B1 NUMERIC? CLE,SSB YES--NEGATIVE? JMP LCPU? * IMPROPER RESPONSE! STB #NODE SAVE CPU NUMBER IN RES JMP GETN0 * TOBIG JSB SYSER TOO MUCH SAM REQUESTED DEF MUCHO NOMER JSB SYSER SAM CANNOT BE ALLOCATED DEF NOMEM SKP *---------------------------------------------------------------+ * GET NRV INFORMATION FROM USER | *---------------------------------------------------------------+ GETN0 CLA STA MAP+1 CLEAR OUT NEIGHBOR BIT MAP LDA MAP LDB MAP INB JSB .MVW DEF D15 NOP JMP GETN * $CPU JSB QUERY NODE SPEC. ERROR DEF NOSZR JMP GETN+2 $DUP JSB QUERY MULTIPLE NEIGHBORS ON SAME LU DEF MNAY JMP GETN+2 $LU JSB QUERY INVALID LU! DEF LUERM JMP GETN+2 $TO JSB QUERY INVALID TIMEOUT DEF TOBAD JMP GETN+2 $LVL JSB QUERY INVALID UPGRADE LEVEL DEF INLVL JMP GETN+2 * GETN EQU * JSB PRINT ASK FOR NRV DATA: DEF NODEF "CPU#,LU,TIMEOUT,UPGRADE LEVEL,N,MA?" LDA #LEVL DEFAULT: TIMEOUT=0, LEVEL=CURRENT STA NRV2 CLA DEFAULT: NEIGHBOR=FALSE, LU=0 STA NRV3 JSB READ GET RESPONSE. SZA,RSS NULL ENTRY? JMP $CPU . YES, INVALID CPA B2 ASCII? JMP $CPU . YES, BADO BADO ... STB NRV1 SAVE CPU NUMBER SSB CPU # NEGATIVE? JMP $CPU * INVALID RESPONSE! LDA NRVSZ GET THE NUMBER OF NODES. ADA NCNT SUBTRACT NUMBER NOT YET PROCESSED, SZA,RSS IF NONE PROCESSED YET, JMP STNOD BYPASS DUPLICATE CPU# CHECK. JSB .CAX INITIALIZE COUNTER =CPU#'S PROCESSED. LDA #NRV GET POINTER TO FIRST CPU#. NCHEK NOP [DMS XCB GOES HERE FOR RTE-III/IV] CPB A,I IF THIS NODE IS A DUPLICATE, JMP $CPU THEN YELL ABOUT IT! ADA NRVS. ADVANCE POINTER TO NEXT CPU#. JSB .DSX ALL CPU#'S BEEN CHECKED? JMP NCHEK NO. CONTINUE CHECKING. * STNOD EQU * LDA PARSB+5 GET THE LU--IF ANY. LDB PARSB+4 WAS LU SZB DEFAULTED? STA NRV3 SAVE IN TEMPLATE. LDB PARSB+8 GET TIMEOUT SPECIFICATION TYPE. CPB B2 IF THE PARAMETER IS INVALID, JMP $TO THEN SCREAM ABOUT IT! LDA PARSB+9 GET TIME-OUT SPECIFICATION SZB DEFAULTED? JMP *+4 LDA NRV2 ALF,ALF AND B377 CMA,INA,SZA,RSS IF IT IS NULL, OR ZERO, JMP MSGFM THEN IGNORE IT. SSA,RSS T/O<0? JMP $TO YES, ERROR LDB A ADB D1275 SSB JMP $TO JSB CFSEC ALF,ALF POSITION TO HIGH HALF-WORD * MSGFM EQU * HERE TO MERGE UPGRADE LEVEL NUMBER STA TEMP LDB PARSB+12 IS THIS NUMERIC, OR CPB B2 DEFAULTED? JMP $LVL NO, SCREAM ABOUT IT. LDA PARSB+13 GET UPGRADE LEVEL NUMBER SSA NEGATIVE? JMP $LVL YES, SCREAM ABOUT IT. SZB,RSS DEFAULTED? LDA NRV2 YES LDB A ADB NMXLV > MAX LEVEL SSB,RSS ALLOWED? JMP $LVL . YES LEVEL ERROR IOR TEMP MERGE TIME-OUT & UPGRADE LEVEL NUMBER STA NRV2 *---------------------------------------------------------------+ * CHECK VALIDITY OF NRV | * NRV1 = CPU NODE NUMBER | * NRV2 = TIME-OUT/MSG FMT # | * NRV3 = NEIGHBOR/COMM-LINK LU | * | * VALIDITY CHECKS: IF COMM-LINK LU # 0, THEN VERIFY THAT | * IT'S A BONAFIDE COMMUNICATION LINK DRIVER. | * | * ADDITIONAL PROCESSING: | * MULTIPLE NEIGHBORS ON THE SAME LU ARE FLAGGED AS | * ERRORS. | * | * "NEIGHBOR BIT SET IN NRV3 IF NRV1 = LOCAL NODE #, AND | * LEVEL # FORCED TO LOCAL NODE'S LEVEL, AS TAKEN FROM | * #LEVL IN "RES". | * | * IF THE MESSAGE FORMAT LEVEL FOR THE NODE IS NOT THE | * SAME AS THE LOCAL NODE, THEN A FLAG IS SET WHICH WILL | * CAUSE THE MESSAGE CONVERTERS (INCNV, OTCNV) TO BE | * SCHEDULED LATER. | *-----vZ----------------------------------------------------------+ * LDB PARSB+17 GET "NEIGHBOR" INDICATOR, IF ANY LDA NRV3 LOAD LU WORD CPB "N "NEIGHBOR" INDICATOR SET? RSS . YES, CHECK FOR MULTIPLE NEIGHBORS JMP LINK? . NO, CHECK FOR COMM LINK * SZA,RSS IGNORE CHECKING FOR LU=0 JMP LINK? JSB SMF MAP LU INTO BIT MAP STA SMF AND SAVE BIT TEMPORARILY AND B,I TEST BIT SZA JMP $DUP BIT IS SET - BADO BADO IOR SMF BIT IS CLEAR OK, SET BIT IN MAP STA B,I LDA NRV3 IOR B400 SET NEIGHBOR BIT IN NRV STA NRV3 * LINK? AND B377 CHECK THAT LU SPECIFIED SZA,RSS IS A BONA FIDE COMMUNICATION JMP LUOK LU JSB LUTST JMP $LU ILLEGAL LU--TAKE ERROR EXIT JMP $LU IT'S NOT A GOOD LU! SCREAM ABOUT IT! * LUOK LDB NRV1 IF THIS ENTRY IS FOR THE LOCAL NODE, THEN LDA NRV3 CPB #NODE SET THE "NEIGHBOR" BIT. IOR B400 STA NRV3 LDA NRV2 CPB #NODE LOCAL NODE ENTRY? LDA #LEVL YES, FORCE LOCAL NODE UPGRADE LEVEL. STA NRV2 XOR #LEVL IF MESSAGE FORMAT NOT SAME AS LOCAL NODE, AND B17 THEN SET FLAG TO CAUSE MESSAGE SZA CONVERTERS TO BE ISZ MSCFL SCHEDULED. * *-- CHECK/SETUP MESSAGE ACCOUNTING FOR THIS NODE LDA MSTO# = MASTER TIMEOUT JSB #MA3 CHECK IF MA WANTED FOR THIS NODE * *-- SETUP REROUTING LINK VECTOR LDA NRV1 = NODE # LDB PARSB+4 = PARSE BUFFER TYPE CODE JSB #RR2 SPC 2 * HERE TO MOVE NRV TEMPLATE TO NEXT NRV ENTRY JSB $LIBR LOWER SYSTEM DEFENSES NOP LDA @NRV1 LOAD SOURCE ADDRESS LDB NPNT LOAD DESTINATION ADDRESS JSB .LDX LOAD # WORDS TO MOVE DEF NRVS. STNOP JSB .MVW [MWI IF IN DMS CPU] DEF NRVS. NOP JSB $LIBX RESTORE SYSTEM PROTECTIONS DEF *+1 DEF *+1 * LDA NPNT UPDATE ADA NRVS. POINTER STA NPNT * ISZ NCNT HAVE ALL NODES BEEN PROCESSED YET? JMP GETN NO, CONTINUE SPC 2 LDA MSCFL ARE THERE ALIEN-FORMAT NODES SZA,RSS IN THE NETWORK? JMP INRES NO. * * ASSIGN CLASS NUMBERS FOR MESSAGE CONVERTERS * CCA ASSIGN A JSB CLSUB CLASS NUMBER FOR DEF INCV. "INCNV" CCA ASSIGN A JSB CLSUB CLASS NUMBER FOR DEF OTCV. "OTCNV" JMP INRES SPC 1 * * SMF- MAPS LU INTO ADDRESS AND BIT POSITION * SMF NOP STORAGE MAPPING FUNCTION CLB DIV D16 STA SMF1 LDA B IOR SMF2 FORMAT SHIFT INSTRUCTION STA *+2 CLA,INA DEF *-* (MODIFIED TO LSL XX) SZA,RSS CLA,INA 2**0 = 1 LDB SMF1 ADB MAP --> MAP RECORD JMP SMF,I SMF1 BSS 1 SMF2 LSL 16 SKELETON INSTRUCTION MAP DEF *+1 BSS 16 NEIGHBOR BIT MAP * * * * * * * * DO NOT CHANGE ORDER OF NEXT TWO STATEMENTS * * * * * CNODE OCT -1 CURRENT-USER NODE; -1=INACTIVE. OCT -1 DOWN-LOAD NODE: INITIAL VALUE. * NCNT NOP NODE LOOP COUNTER (-NO. OF NODES). NPNT NOP LOCAL NRV TABLE POINTER. * * NRV ENTRY TEMPLATE. DO NOT DISTURB ORDER! * * NOTE: NRV1 & NRV2 ARE USED IN THE "ABORT" ROUTINE TO * CLEAR "LISTEN" MODE IN THE DRIVER, AS A COUNTER & A POINTER, * RESPECTIVELY. NRV1 NOP STORAGE FOR CPU NUMBER NRV2 NOP STORAGE FOR TIME-OUT/UPGRADE LEVEL # NRV3 NOP STORAGE FOR COMMUNICATION LINK LU @NRV1 DEF NRV1 * SAMSZ NOP # WORDS IN SAM BLOCK TSTSZ NOP A # WORDS IN TST NRVSZ NOP # WORDS IN NRV * MSCFL IS A FLAG, CONTAINING 0, OR > 0 IF ALIEN MESSAGE FORMAT * NODES EXIST IN NETWORK. THAT IS, IF MSCFL = 0 AT THE END OF THE NRV * SPECIFICATION ENTRIES (AT INITIALIZATION TIME), THEN THE MESSAGE * FORMAT CONVERTERS DO NOT NEED TO BE SCHEDULED. OTHERWISE, THEY DO. MSCFL DEC 0 SKP *---------------------------------------------------------------+ * ROUTINE TO INITIALIZE THE "RES" AREA | *---------------------------------------------------------------+ * INRES EQU * LDA NTCBS COUNT FOR NUMBER OF TCBS STA TEMP JSB $LIBR GAIN ACCESS TO NOP SYSTEM RESOURCES. LDA #FWAM GET THE ADDRESS OF THE S.A.M. BLOCK, STA #NULL AND INITIALIZE HEAD OF NULL LIST. STA B LINK JMP SLOPX * SLOOP ADB TCBSZ THE STLNK STB A,I NULL [CONTAINS XSB A,I: DMS] NOP LIST [NOP: RTE-II, DEF A,I: DMS] STB A WITH SLOPX ISZ TEMP FIVE- JMP SLOOP WORD CLB NULL STERM STB A,I ENTRIES. [CONTAINS XSB A,I: DMS] NOP [NOP: RTE-II, DEF A,I: DMS] * * CPB RM3K DS/3000 ENABLED? JMP INIT NO, BYPASS THIS CODE * LDA TSTSZ JSB .CAX X-REG := # WORDS IN TST LDA TST# GET POINTER TO TST AREA * LOOP3 STB A,I [XSB A,I FOR DMS] NOP STORE INA ZEROES JSB .DSX IN JMP LOOP3 TST * * INITIALIZE ALL GLOBAL RN'S, CLASS NUMBERS, AND COUNTERS IN 'RES'. * INIT LDA QCLM# GET THE CLEANUP MONITOR'S CLASS NO. CCE ALR,ERA REMOVE THE BUFFER SAVE BIT & SET NO WAIT BIT STA QCLM# SAVE THE CLASS WORD. * LDA LSBFA SOURCE = LOCAL BUFFER. LDB #SCLR DESTN = DATA AREA. JSB .MVW MOVE THE DATA TO <RES>. DEF MVSIZ NOP * JSB $LIBX RESTORE MEMORY PROTECTION DEF *+1 DEF *+1 * LDA RMSA ARE THERE HP 1000 LINKS? SZA,RSS JMP MONIT NO, SKIP NEXT BLOCK JMP LUEN ENABLE LU'S * * * * DO NOT CHANGE ORDER OF ENTRIES (MATCHES ORDER IN )!! * THIS TABLE IS COPIED INTO AN AREA OF "RES" AT THE END OF * THE INITIALIZATION PHASE. 1ST LOCN ADDRESS IS CONTAINED * IN 'LSBFA', THE NUMBER OF WORDS TO MOVE IS GIVEN BY * 'MVSIZ'. * LSBFA DEF TBRN# LOCAL 'RES' DATA BUFFER ADDRESS. TBRN# NOP TABLE-ACCESS RESOURCE NUMBER. QRN# NOP SYSTEM-QUIESCENT RESOURCE NUMBER. GRPM# NOP GENERAL PRE-PROCESSOR CLASS NUMBER. QCLM# NOP QUEUE CLEAN-UP MONITOR'S CLASS NUMBER. NOP ACTIVE TRANSACTION COUNTER. MSTO# ABS 256-9 MASTER-REQUEST TIMEOUT(LOWER BYTE -9). ABS 256-6 SLAVE-REQUEST TIMEOUT(LOWER BYTE -6). RTRY# NOP WRITE-RETRY MODULE'S CLASS NUMBER. NOP #MAST QUIESCENT WAIT INTERVAL. NOP NODE SECURITY CODE. OCT 6000 REMOTE-BUSY REJECT RETRY COUNT (-3). INCV# NOP INCOMING MSG CNVTR CLASS # OTCV# NOP OUTBOUND MSG CNVTR CLASS # MHCT# NOP MAXIMUM HOP COUNT MDCT# DEC -10 MAX.# TIMES A LINK CAN GO DOWN IN 5 MIN RPCV# NOP HP3000 REPLY CONVERTER CLASS NO. RQCV# NOP HP3000 REQUEST CONVERTER CLASS NO. LU3K# NOP LU NUMBER OF HP3000 QZRN# NOP QUEZ RN CLRN# NOP QUEX CLEAN-UP RESOURCE NUMBER QXCL# NOP QUEX CLASS NO. TST# NOP HP3000 TRANS. STATUS TBL. ADDR NOP SIZE OF TST MVSIZ ABS *-TBRN# NUMBER OF WORDS TO MOVE INTO 'RES' AREA. * * END OF FIXED-ORDER TABLE * SKP *---------------------------------------------------------------+ * THIS BLOCK ENABLES THE HP 1000 LINKS. | *---------------------------------[------------------------------+ * LUEN EQU * JSB PRINT DEF UPLUM " LINE LU?_" JSB READ READ A RECORD CPA B1 WAS INPUT BINARY? JMP SAVLU YES. GO TO PROCESS THE LU. CPB /E END OF LIST? JMP MONIT YES. RETURN LUERR JSB QUERY DEF LUERM "LU ERROR" JMP LUEN+2 TRY AGAIN * SAVLU STB NRV3 SAVE TEMPORARILY. CPB #LU3K HP3000 LU? JMP LUEN . YES, IGNORE 3K LINES * GO VERIFY THAT LU IS LINKED TO A VALID COMMUNICATION DRIVER. JSB LUTST NOP ILLEGAL LU JMP LUERR NOT A COMMUNICATION DRIVER--ERROR * JSB LUSET GO TO SET UP & ENABLE THE LU. JMP LUERR * RTE-DETECTED ERROR--TRY AGAIN! * * CALL RE-ROUTING ROUTINE TO SET THIS LU IN TABLE * (PARSB CONTAINS PARSED RESPONSE TO LAST QUESTION) JSB #RR3 JMP LUEN GO TO REQUEST ANOTHER LU NUMBER. SKP *---------------------------------------------------------------+ * SCHEDULE REQUESTED SLAVE MONITORS | *---------------------------------------------------------------+ MONIT EQU * JSB PRINT "MONITOR?" DEF MONMS JSB READ GET USER'S RESPONSE CPB /E DONE? JMP GETSC . YES CPB /D DEFAULT? JMP ALLMN . YES SCHEDULE ALL REMAINING MONITORS * LDA MNMON STA MCTR NUMBER OF MONITORS LDA @MON STA MPTR PTR TO 1ST MONITOR SRT ENTRY * * LOOK FOR THE MONITOR REQUESTED * MON1 EQU * LDA @MNAM LDB MPTR,I ADB D2 --> NAME IN SRT JSB .CMW DEF D3 NOP JMP MON2 FOUND HIM! NOP ISZ MPTR ISZ MCTR JMP MON1 TRY AGAIN... * JSB ERROR "INVALID MONITOR NAME" DEF INVNM JMP MONIT * MON2 LDB MPTR,I --> SRT ENTRY JSB PMON PROCESS MONITOR JMP MONIT SPC 2 MPTR BSS 1 MCTR BSS 1 @MNAM DEF PARSB+1 SPC 3 * PROCESS ALL MONITORS * ALLMN EQU * LDA MNMON STA MCTR LDA @MON STA MPTR --> [.] --> 1ST MONITOR SRT ENTRY ALL1 LDB MPTR,I --> MONITOR SRT ENTRY JSB PMON PROCESS MONITOR ISZ MPTR ISZ MCTR JMP ALL1 JMP GETSC SPC 3 * ROUTINE TO ASSIGN CLASS, SETUP LIST HEADER, AND SCHEDULE * A SLAVE MONITOR. ON ENTRY --> SRT ENTRY. * PMON NOP STB PMON3 STB PMON4 LDA D1 CHECK IF MONITOR ALREADY AND B,I PROCESS AND BYPASS IF SZA IT HAS BEEN. JMP PMON,I * LDA PMON3,I 3K MONITOR? SSA,RSS JMP PMON2 . NO CONTINUE LDA #LU3K 3K CONNECTED? SZA,RSS JMP PMON,I . NO RETURN * PMON2 CLA GET A CLASS # FOR MONITOR JSB CLSUB PMON3 DEF *-* SRT ENTRY ADDRESS * LDB PMON3 --> SRT JSB CALC COMPUTE LIST HEADER ADDRESS INB --> CLASS WORD IN HEADER LDA @CLAS,I STA B,I MOVE IN CLASS * INB --> PGM NAME IN HEADER STB PMON5 LDA PMON3 ADA D2 --> PGM NAME IN SRT JSB .MVW MOVE NAME INTO LIST HEADER DEF D3 NOP * INA --> ABORTABLE BIT LDA A,I GET ABORT BIT IOR PMON5,I STA PMON5,I AND MERGE IT WITH NAME * LDB PMON4 CPB @RFAM REQUEST TO SCHEDULE RFAM? RSS . YES JMP PMON7 . NO JUST SCHEDULE JSB PRINT "INPUT # OF FILES" DEF FILMG JMP *+3 PMON6 JSB QUERY DEF FERMG "FILE ERROR" JSB READ CPA D1 NUMERIC? RSS . YES OK JMP PMON6 . NO BADO BADO... STB #RFSZ SAVE FILE/DCB COUNT FOR RFAM * PMON7 EQU * JSB SCHED SZ SCHEDULE MONITOR PMON4 DEF *-* SZA,RSS IF <> 0 THEN MONITOR NOT SCHEDULED. BACK-OUT JMP PMON,I RETURN * LDB PMON4 --> SRT JSB SNUFF MONITOR NOT SCHEDULED, BACKOUT RESOURCES JMP PMON,I * PMON5 DEF *-* ADDRESS OF PGM NAME IN SLAVE HEADER SPC 3 * SCHEDULE PROGRAM (P+1 --> SRT ENTRY, RETURNS 0 IF OK) * SCHED NOP LDA SCHED,I RAL,CLE,SLA,ERA RESOLVE INDIRECT ADDRESS LDA A,I INTO DIRECT ADDRESS STA SCHD4 SRT ADDRESS ISZ SCHED INA LDB A,I --> CLASS INA --> PROGRAM NAME (SRT+2) DST SCHD1 * JSB EXEC SCHEDULE PGM WITHOUT WAIT DEF *+5 DEF SCHNW SCHD1 DEF *-* DEF *-* PARM #1 (PROGRAM CLASS) DEF ERLU PARM #2 JMP SCHD2 ERROR RETURN SZA,RSS JMP SCHD3 GOOD RETURN - UPDATE FLAGS DLD ASTAT STATUS ERROR SCHD2 DST SERR LDA SCHD1 LDB @SCHD JSB .MVW MOVE IN MONITOR NAME DEF D3 NOP JSB ERROR PRINT PGM SCHEDULE ERROR DEF SMES CCA SET ERROR INDICATOR - COULDN'T SCHEDULE JMP SCHED,I RETURN * SCHD3 EQU * PROGRAM SCHEDULED -- UPDATE FLAGS LDA SCHD4,I IOR D1 SET "SCHEDULED" FLAG STA SCHD4,I CLA INDICATE SCHEDULE SUCCESSFUL JMP SCHED,I RETURN * SCHD4 BSS 1 ASTAT ASC 2,STAT SMES DEF *+2 DEF D9 ASC 3,ERROR: SERR ASC 6,EEEE XXXXX @SCHD DEF SERR+3 SCHNW DEF 10,I SKP *---------------------------------------------------------------+ * GET SECURITY CODES FROM THE USER | *---------------------------------------------------------------+ GETSC EQU * JSB SECOD SET NETWORK USER ACCESS SECURITY CODE FOR THIS NODE. DEF SECMS STB #SWRD JSB SECOD SET NETWORK MANAGEMENT ACCESS SECURITY CODE DEF SECNM STB #NMSC JMP SQUE SPC 2 * ROUTINE TO ASK FOR, OBTAIN & VERIFY A SECURITY CODE * SPECIFIED IS IN ASCII. * SECOD NOP LDA SECOD,I LOAD ADDRESS OF "PROMPT" MESSAGE STA SCOD. SAVE IN-LINE DLD ECHO TEMPORARILY REMOVE THE 'ECHO' BIT SWP DST ECHO ISZ SECOD BUMP RETURN POINTER * SCOD0 EQU * JSB PRINT ASK FOR SECURITY CODE SCOD. NOP ADDRESS OF "PROMPT" MSG STORED HERE JSB READ INPUT RESPONSE CPA B2 RESPONSE ASCII? RSS YES,... JMP SCOD0 NO, TRY AGAIN. DLD ECHO RESTORE ECHO BIT SWP DST ECHO LDB PARSB+1 SPC 1 UNL JSB S LST JMP SECOD,I RETURN. SPC 1 * SUBROUTINE TO OBTAIN NETWORK MANAGEMENT ACCESS SECURITY CODE NMSCX NOP JSB SECOD DEF SECNM "NETWORK MANAGEMENT SECURITY CODE?" CPB #NMSC CODES MATCH? JMP NMSCX,I YES, RETURN JMP ABORT NO--TOUGH LUCK UNL S NOP BLF,BLF CMB JMP S,I LST SPC 1 SECMS DEF *+2 DEF D14 ASC 14,NETWORK USER SECURITY CODE?_ SECNM DEF *+2 DEF D17 ASC 17,NETWORK MANAGEMENT SECURITY CODE?_ SKP *---------------------------------------------------------------+ * SCHEDULE QUEUEING PROCESSORS | * | * 1000-1000 LINKS GRPM, RTRY, QCLM | * 1000-1000 LINKS W/ OLD NODES - INCNV, OTCNV | * 3000 LINK - RQCNV, RPCNV | *---------------------------------------------------------------+ SQUE EQU * LDA RMSA 1000-1000 LINKS? SZA,RSS JMP SQUE1 . NO CHECK 3000 * JSB SCHED SCHEDULE GRPM DEF GRPM. SZA JSB QWARN  JSB SCHED SCHEDULE RTRY DEF RTRY. SZA JSB QWARN JSB SCHED SCHEDULE QCLM DEF QCLM. SZA JSB QWARN LDA #MCTR MA IN SYSTEM? SZA,RSS JMP SQUE0 . NO CONTINUE * JSB EXEC PUT 'MATIC' INTO TIME LIST DEF *+6 DEF D12N INITIAL OFFSET SCHEDULE DEF MA1.+2 PROGRAM NAME DEF D2 RESOLUTION (2=SECONDS) DEF D1 MULTIPLE (1=EVERY SECOND) DEF DM2 RUN AFTER 2 SECONDS JMP *+4 ERROR! COULD NOT SCHEDULE MATIC! JMP SQUE0 DEF MA1. SRT ADDRESS FOR ERROR PROCESSING NOP FAKE OUT QWARN JSB QWARN * * IF OLDER NODES SCHEDULE CONVERTERS * SQUE0 LDA MSCFL SZA,RSS JMP SQUE1 NO OLDER NODES * JSB SCHED SCHEDULE INCNV DEF INCV. SZA JSB QWARN JSB SCHED SCHEDULE OTCNV DEF OTCV. SZA JSB QWARN * * IF 3000 LINK, THEN SCHEDULE 3K PROCESSORS * SQUE1 LDA RM3K SZA,RSS JMP TERM NO 3K LINK * JSB SCHED SCHEDULE RQCNV DEF RQCV. SZA JSB QWARN JSB SCHED SCHEDULE RPCNV DEF RPCV. SZA JSB QWARN JMP TERM SPC 2 QWARN NOP WARN USER THAT A REQUIRED LDB QWARN DS/1000 PROCESSOR ADB DM3 CANNOT BE SCHEDULED LDA B,I --> SRT ADA D2 --> PGM NAME LDB @QMSG ADB D7 --> WHERE TO PUT NAME JSB .MVW MOVE NAME DEF D3 NOP JSB ERROR WARN USER @QMSG DEF QWMSG JMP QWARN,I SKP *---------------------------------------------------------------+ * PROGRAM TERMINATION PROCESSOR. | *---------------------------------------------------------------+ TERM CLA CPA #FWAM SAM ALLOCATED? JMP *+3 NO CPA ONTWO S IS THIS INITIAL ENTRY? JSB SUPLN YES! SCHEDULE "UPLIN" JSB CHCKN WAS THERE A FILE JMP TERM1 NO...DON'T CLOSE IT LDA CLFLG IS IT A DUMMY DCB? SSA JMP TERM1 YES...DON'T CLOSE IT * JSB CLOSE CLOSE DEF *+3 THE DEF INDCB CONTROL DEF TEMP1 FILE. * TERM1 LDA $RTRN IF PROGRAM IS BEING ABORTED CPA @ABPR THEN IGNORE JMP TERM3 THE END MESSAGE. * JSB PRNTX GO TO PRINT THE @ENMG DEF ENDMG TERMINATION MESSAGE--SANS HEADER. * TERM3 EQU * ISZ $RTRN BUMP POINTER ISZ $RTRN TO ACTUAL MESSAGE JSB PRTN RETURN ERROR INFORMATION DEF *+2 TO THE BATCH PROCESSOR $RTRN NOP (CONTAINS DEF TO ENMSG OR ABRTM) JSB EXEC GO TO THE DEF *+2 RTE EXECUTIVE DEF D6 TO TERMINATE SKP * SUBROUTINE TO ASK CPU QUESTIONS & INTERPRET RESPONSES CPUCK NOP STA MSG2+4 JSB PRINT PRINT THE QUESTION DEF MSG2 JSB READ READ THE RESPONSE CLA,INA CPB "YE" YES? JMP CPUC2 YES, SET THE FLAG CLA CPB "NO" NO? JMP CPUC2 CLEAR FLAG JSB QUERY INFORM USER OF ERROR DEF ERR1 "ANSWER YES OR NO" JMP CPUCK+4 RETRY QUESTION * CPUC2 STA CPUCK,I SET CPU FLAG ISZ CPUCK SET CORRECT RETURN ADDRESS JMP CPUCK,I RETURN * ASC10 ASC 1,10 ASC30 ASC 1,30 * D14 DEC 14 SKP D100 DEC 100 DM100 DEC -100 * * RRSIZ NOP SIZE OF RE-ROUTING TABLES NTCBS NOP NUMBER OF TCBS ALLOCATED. MASIZ NOP SIZE OF M.A. TABLES (IN WORDS) SZNRV NOP SIZE OF NRV AREA (IN WORDS) SZTCB NOP SIZE OF TCB AREA (IN WORDS) POOLZ NOP SKP *---------------------------------------------------------------+ * ****** SYSTEM RESOURCE TABLE ****** M | * CONTAINS INFO ABOUT ALL PROGRAMS, CLASSES, AND | * RESOURCE NUMBERS ALLOCATED. FORMAT IS AS FOLLOWS: | * | * +0 FLAGS (SEE BELOW) | * +1 @RS ADDRESS OF WHERE TO PUT CLASS/RN | * +2 PGM (OPTIONAL) PROGRAM NAME | * +5 STREAM (OPTIONAL) STREAM WORD | * +6 ABORT (OPTIONAL) ABORTABLE BIT | * +7 CLASS (OPTIONAL) SAVE AREA FOR CLASS WORD | * | * FLAGS | * --------------------- | * OCT 1 PROGRAM SCHEDULED | * OCT 2 CLASS # ALLOCATED | * OCT 4 RN ASSIGNED | * OCT 040000 SLAVE MONITOR | * OCT 100000 NEEDED ONLY FOR THE 3K | *---------------------------------------------------------------+ SPC 1 #MON EQU 11 NUMBER OF SLAVE MONITORS MNMON ABS -#MON @MON DEF MON START OF MONITORS @RFAM DEF M6. RFAM ENTRY ADDRESS * SRT DEF *+1 START OF SYSTEM RESOURCE TABLE DEF UPLI. MON EQU * START OF SLAVE MONITOR LIST DEF M1. ORDER OF THE FOLLOWING IS FIXED DEF M2. " DEF M3. " DEF M4. " DEF M5. " DEF M6. " DEF M7. " DEF M8. " DEF M9. " DEF M10. DEF M11. END OF FIXED ORDER... ADD MONITORS AFTER HERE DEF TBRN. DEF QRN. DEF QXCL. DEF QZRN. DEF CLRN. { DEF RQCV. DEF RPCV. DEF GRPM. DEF RTRY. DEF QCLM. DEF INCV. DEF OTCV. DEF RSM. DEF MA1. DEF MA2. DEF EX1. DEF EX2. SRTLN ABS *-SRT-1 NUMBER OF SRT ENTRIES SPC 1 *-- SLAVE MONITORS M1. OCT 040000 DEF *+6 ASC 3,DLIST DIRECTORY LIST MONITOR DEC 1 STREAM 1 NOP NO ABORT BSS 1 CLASS M2. OCT 140000 DEF *+6 ASC 3,CNSLM HP3K CONSOLE MONITOR DEC 2 STREAM 2 OCT 100000 OK TO ABORT BSS 1 CLASS M3. OCT 040000 DEF *+6 ASC 3,EXECW SCHEDULE-WITH-WAIT MONITOR DEC 3 STREAM 3 OCT 100000 OK TO ABORT BSS 1 CLASS M4. OCT 040000 DEF *+6 ASC 3,PTOPM PROGRAM TO PROGRAM MONITOR DEC 4 STREAM 4 NOP NO ABORT! BSS 1 CLASS M5. OCT 040000 DEF *+6 ASC 3,EXECM REMOTE EXEC-REQUEST MONITOR DEC 5 STREAM 5 NOP NO ABORT! BSS 1 CLASS M6. OCT 040000 DEF *+6 ASC 3,RFAM REMOTE FILE ACCESS MONITOR DEC 6 STREAM 6 NOP NO ABORT! BSS 1 CLASS M7. OCT 040000 DEF *+6 ASC 3,OPERM REMOTE OPERATOR-REQUEST MONITOR DEC 7 STREAM 7 OCT 100000 OK TO ABORT BSS 1 CLASS M8. OCT 040000 DEF *+6 ASC 3,VCPMN VIRTUAL CONTROL PANAL MONITOR DEC 8 STREAM 8 NOP NO ABORT! BSS 1 CLASS M9. OCT 040000 DEF *+6 ASC 3,PROGL ABSOLUTE PROGRAM LOADING MONITOR DEC 9 STREAM 9 NOP NO ABORT! BSS 1 CLASS M10. OCT 040000 DEF *+6 ASC 3,RDBAM REMOTE DATA BASE ACCESS MONITOR DEC 10 STREAM 10 NOP NO ABORT! BSS 1 CLASS M11. OCT 40000  DEF *+6 ASC 3,APLDX 'MINI-APLDR' FOR MEMORY-BASED RTE-LS DEC 11 STREAM 11 OCT 100000 OK TO ABORT BSS 1 CLASS NUMBER * TBRN. NOP DEF TBRN# QRN. NOP DEF QRN# QXCL. OCT 100000 DEF QXCL# ASC 3,QUEX QZRN. OCT 100000 DEF QZRN# ASC 3,QUEZ CLRN. NOP DEF CLRN# RQCV. OCT 100000 DEF RQCV# ASC 3,RQCNV RPCV. OCT 100000 DEF RPCV# ASC 3,RPCNV GRPM. NOP DEF GRPM# ASC 3,GRPM RTRY. NOP DEF RTRY# ASC 3,RTRY QCLM. NOP DEF QCLM# ASC 3,QCLM INCV. NOP DEF INCV# ASC 3,INCNV OTCV. NOP DEF OTCV# ASC 3,OTCNV UPLI. NOP NOP ASC 3,UPLIN #RSM. EQU * RSM. NOP DEF #RSM ASC 3,RSM #MA1. EQU * MA1. NOP DEF #MARN RN FOR TABLE ACCESS ASC 3,MATIC #MA2. EQU * MA2. NOP DEF #MAHC MA HOLD CLASS EX1. NOP DEF #EXHC EXECM HOLD CLASS EX2. NOP DEF #EXTC EXECM WORK CLASS SKP * * DELAY SUBROUTINE: DELAY EXECUTION FOR 1-SECOND. * SET (BEFORE ENTRY) TO NEGATIVE NUMBER OF PASSES * ALLOWED THROUGH , BEFORE RETURN TO P+1 ERROR-RETURN. * NORMAL RETURN IS TO P+2, FOLLOWING DELAY OF 1-SECOND. * DELAY NOP ENTRY/EXIT: DELAY SUBROUTINE. JSB EXEC WAIT DEF *+6 1 SECOND DEF D12 TO ALLOW DEF ZERO SYSTEM DEF B1 CONDITIONS TO DEF ZERO CHANGE DEF DM100 AS REQUIRED. ISZ RETRY IF RETRY COUNT IS NOT EXHAUSTED, ISZ DELAY THEN SET RETURN TO P+2; ELSE, IF JMP DELAY,I EXHAUSTED, RETURN TO P+1--ERROR! * RETRY NOP RE-TRY COUNTER * SKP * * SUBROUTINE TO STORE ID SEQUENCE IN "RES". * (A) = # BYTES * (B) = ADDRESS IN "RES". * INBUF = ASCII INPUT BUFFER (ADDR = DINBF). * STRI3D NOP STB TEMP1 DESTINATION ADDR. * LDB A IS # BYTES .LE. 16? ADB DM17 SSB,RSS LDA D16 NO. TRUNCATE TO 16 BYTES. STA TEMP1,I STORE # BYTES. SZA,RSS JMP STRID,I IF NO ID, RETURN STA B BRS GET LAST CHARACTER IN BUFFER. ADB M1 ADB DINBF LDA B,I AND D255 CPA D32 IS IT A BLANK? JMP STR1 YES. LDA TEMP1,I NO. ARE THERE 16 BYTES? CPA D16 RSS JMP STR2 NO. STR1 LDA B,I YES. CLEAR THE BLANK (OR 16TH BYTE), AND DM256 STA B,I LDA TEMP1,I AND DECREMENT BYTE COUNT. ADA M1 STA TEMP1,I INA STR2 ISZ TEMP1 CLE,ERA NO. OF WORDS TO STORE. SZA,RSS JMP STRID,I IF NO ID, RETURN LDB TEMP1 DESTINATION ADDRESS STA TEMP1 # OF WORDS LDA DINBF SOURCE ADDRESS JSB .MVW PERFORM MOVE DEF TEMP1 NOP * JMP STRID,I RETURN TO CALLER * D32 DEC 32 SKP * SPC 1 * UTILITY SUBROUTINE CFSEC NOP ENTRY/EXIT CCB CONVERT SECONDS TO DIV B5 FIVE SECOND INTERVALS. ADB B2 IF THE REMAINDER IS SSB THREE OR MORE, ADA M1 ROUND TO NEXT INTERVAL. SZA,RSS INSIST UPON A CCA MINIMUM COUNT = -1. AND D255 MASK OFF HIGH BITS JMP CFSEC,I RETURN * D255 DEC 255 SKP * SUBROUTINE TO VERIFY THAT LU IS LINKED TO COMMUNICATION LINK DRIVER. * CALLING SEQUENCE: * "NRV3" CONTAINS LU # TO TEST. * P JSB LUTST * P+1 * P+2 * P+3 * LUTST NOP LDA NRV3 CONFIGURE DOUBLE-WORD LU IOR BIT15 STA LU1 CLA STA LU2 JSB XLUEX GO TO OBTAIN DEF *+4  THE EQUIPMENT TYPE DEF SD13 CODE FOR THE DEF LU1 SPECIFIED LOGICAL UNIT. DEF LUSET JMP LUTST,I TAKE THE ERROR EXIT! ISZ LUTST BUMP RETURN TO P+1 * LDA LUSET GET STATUS WORD. ALF,ALF AND B77 ISOLATE THE EQUIPMENT TYPE-CODE. CPA B65 IS THE LU LINKED TO 'DVA65'? ISZ LUTST YES. TAKE GOOD EXIT (P+2). CPA B66 LINKED TO DVA 66? ISZ LUTST YES. TAKE GOOD EXIT (P+2) JMP LUTST,I NO. ERROR: RETURN TO P+1. * LU1 NOP NOTE: LU1 & LU2 MUST BE TOGETHER! LU2 NOP NOTE: LU1 & LU2 MUST BE TOGETHER! BIT15 OCT 100000 OPT NOP SPC 2 * SUBROUTINE TO SET-UP & ENABLE A COMMUNICATION LINK * LUSET NOP * LDA NRV3 GET THE LOGICAL UNIT NUMBER. AND B377 MASK LU FIELD STA OPT IOR BIT15 STA LU1 CONFIGURE DOUBLE-WORD LU LDA B3000 SET FOR ENABLE LISTEN REQUEST STA LU2 * JSB XLUEX GO TO RTE DEF *+4 TO REQUEST THAT DEF SD3 'COMMUNICATION DRIVER' SET UP & DEF LU1 ENABLE CONFIGURED LU DEF OPT LISTEN MODE FOR THE LU JMP LUSET,I * RTE-DETECTED ERROR--TRY AGAIN! * ISZ LUSET ADJUST FOR "GOOD" RETURN RAR POSITION BIT 1 TO LSB SLA,RSS INITIALIZATION ERROR? JMP LUSET,I NO, GOOD INITIALIZATION, RETURN TO THE CALLER. * * PRINT MESSAGE: INITIALIZATION FAILED, LU NN * LDA NRV3 CONVERT LU NUMBER TO ASCII AND B377 JSB DECML DEF CNER. JSB PRINT PRINT THE MESSAGE DEF CNERR JMP LUSET,I RETURN TO CALLER SPC 3 SKP * * DECML- CONVERTS BINARY TO DECIMAL (LEFT JUSTIFIED) * = BINARY * JSB DECML * DEF WHERE TO PUT 6 CHARACTERS * EXT .MBT,.SBT * DECML NOP STA DEC8. SAVE LDB DECML,I d ISZ DECML CLE,ELB CONVERT TO BYTE ADDRESS STB DEC7. LDA @SPAC JSB .MBT MOVE IN SPACES DEF D6 NOP LDA DEC8. LDB DEC7. SSA,RSS NEGATIVE NUMBER? JMP DEC1. . NO CMA,INA STA DEC8. SSA SPECIAL LOW NUMBER (-32768)? JMP DEC4. . YES LDA DASH JSB .SBT DEC1. STB DEC7. SAVE OUTPUT POINTER LDA DTBL STA D D --> DIVISOR TABLE LDA DM4 STA DEC5. STA DEC6. CLEAR OUTPUT FLAG (SET TO 1) * DEC2. LDB DEC8. LSR 16 DIV D,I ISZ D STB DEC8. REMAINDER SZA OUTPUT OTHER THAN ZERO? JMP *+4 . YES OUTPUT IT LDB DEC6. SSB OK TO OUTPUT? JMP DEC3. . NO FINISH LOOP IOR "0" STA DEC6. SET OUTPUT FLAG (BIT15=0) LDB DEC7. --> OUTPUT FIELD JSB .SBT STB DEC7. SAVE OUTPUT FIELD DEC3. ISZ DEC5. JMP DEC2. * LDA DEC8. := ONES DIGIT LDB DEC7. --> OUTPUT IOR "0" JSB .SBT JMP DECML,I AND RETURN * DEC4. LDA @32K MOVE IN -32768 JSB .MBT DEF D6 NOP JMP DECML,I RETURN SPC 2 @32K DBL *+1 ASC 3,-32768 @SPAC DBL *+1 ASC 3, DTBL DEF *+1 DEC 10000 DEC 1000 DEC 100 DEC 10 * "0" OCT 60 DASH ASC 1,-- * DEC5. BSS 1 DEC6. BSS 1 BIT15=1 NO OUTPUT; BIT15=0 OUTPUT D BSS 1 DEC7. BSS 1 DEC8. BSS 1 SKP ZERO EQU M1.+6 D1 EQU M1.+5 D2 EQU M2.+5 D3 EQU M3.+5 D4 EQU M4.+5 D5 EQU M5.+5 D6 EQU M6.+5 D7 EQU M7.+5 D8 EQU M8.+5 D9 EQU M9.+5 D10 EQU M10.+5 D11 DEC 11 D12 DEC 12 D12N DEF 12,I D13 DEC 13 D15 DEC 15 D16 DEC 16 D17 DEC 17 D20 DEC 20 D26 DEC 26 D36 DEC 36 D1275 DEC 1275 DM2 DEC -2 NMXLV EQU DM2 -(MAXIMUM ALLOWABLE UPGRADE LEVEL + 1) DM3 DEC -3 DM16 DEC -16 DM17 DEC -17 DM256 DEC -256 B1 EQU D1 B2 EQU D2 B4 EQU D4 B5 EQU D5 B17 EQU D15 B65 OCT 65 B66 OCT 66 B67 OCT 67 B77 OCT 77 B377 OCT 377 B400 OCT 400 B3000 OCT 3000 BT137 OCT 37700 BLNKS ASC 1, TWO ASCII BLANKS (" ") SD3 OCT 100003 SD13 OCT 100015 M1 EQU CNODE XSBAI XSB A,I DMS: CROSS-STORE VIA ALTERNATE MAP. XCBAI XCB A,I CROSS-COMPARE XLABI XLA B,I MWII MWI MOVE TO ALTERNATE MAP NOP (THIS 'NOP' REQ'D HERE!) MWFI MWF MOVE FROM ALTERNATE MAP NOP (THIS 'NOP' REQ'D HERE!) LSECD DEC 3360 SECURITY CODE FOR SAM ALLOCATION CALL RLU NOP ECHO OCT 400 ECHO BIT < DO NOT CHANGE > NOP NON ECHO BIT < THIS ORDER ! > * TEMP1 NOP /A ASC 1,/A /D ASC 1,/D /E ASC 1,/E "YE" ASC 1,YE C#FCD ABS #FCD L#PCB ABS #PCB+3 "NO" ASC 1,NO TYPEQ NOP CLFLG NOP ONTWO NOP OPTYP NOP SPC 3 A EQU 0 B EQU 1 GLOCK OCT 100002 TEMP NOP TCBSZ EQU D6 # WORDS IN EACH TCB ENTRY INBFS EQU D20 INBUF BSS 20 PARSB BSS 34 INDCB BSS 144 USED FOR ANSWER FILES. SPC 1 * DEFINE NRV SIZE NRVS. EQU D3 SIZE OF NRV ENTRY SKP * CLASS NUMBER ALLOCATION SUBROUTINE. * * ENTER: = -1 CLEAR BITS 15 & 14 * - SRT ENTRY ADDRESS * NOTE: DE-ALLOCATION ERRORS ARE IGNORED! * BSS 1 (STORAGE) CLSUB NOP ENTRY/EXIT: CLASS SUBROUTINE. STA CLSUB-1 SAVE FLAG LDB CLSUB,I GET THE CLASS NUMBER ADDRESS. ISZ CLSUB SET RETURN TO . RBL,CLE,SLB,ERB RESOLVE INDIRECTS LDB B,I TO DIRECT ADDRESS STB @F ADDRESS OF SRT FLAG INB LDB B,I EFFECTIVE ADDRESS OF CLASS LOCATION STB @CLAS * JSB CLRQ ALLOCATE A CLASS NUMBER DEF *+4 DEF CLACD  CLASS ALLOCATION CODE @CLAS DEF *-* CLASS NUMBER ADDRESS STORED HERE DEF ZERO JMP CLERR --ERROR RETURN SSA ALLOCATION ERROR? JMP NOCL# NO CLASS NUMBERS. LDA D2 IOR @F,I SET CLASS ALLOCATED BIT STA @F,I * LDA @CLAS,I SET PROPER BITS IN CLASS NUMBER ALR,RAR CLEAR "NO WAIT" BIT IOR CBITS SET "SAVE BUFFER" & "NO DE-ALLOCATE" BITS LDB CLSUB-1 SSB ALR,RAR STA @CLAS,I JMP CLSUB,I RETURN TO CALLER * NOCL# JSB SYSER CATASTROPHIC ERROR: DEF NOCL. NO CLASS NUMBERS SPC 2 * @F BSS 1 CLACD OCT 140001 ALLOCATE CLASS, NO-WAIT, NO ABORT CLS18 OCT 100022 CLS21 OCT 100025 CBITS OCT 60000 * CLERR JSB SYSER GO TO INFORM THE USER OF A DEF CLSER CATASTROPHIC CLASS-PROCESSING ERROR. * * SKP * RESOURCE NUMBER ALLOCATION ROUTINE. * ENTER: & - DON'T CARE (DESTROYED ON RETURN) * - ADDRESS OF SRT ENTRY * NOTE: RN'S ARE LOCKED LOCALLY, TO PREVENT USE UNTIL COMPLETES. * RNSUB NOP ENTRY/EXIT: RN ALLOCATION/RELEASE RTN. LDA RNSUB,I GET THE STORAGE ADDRESS FOR THE RN. ISZ RNSUB RAL,CLE,SLA,ERA RESOLVE INDIRECT ADDRESSES LDA A,I TO DIRECT ADDRESS STA @F SAVE ADDRESS OF SRT FLAG INA LDA A,I EFFECTIVE ADDRESS OF WHERE TO PUT RN STA RNAD CONFIGURE THE CALL WITH RN ADDRESS. * JSB RNRQ GO TO RTE TO REQUEST A DEF *+4 GLOBALLY ALLOCATED/LOCALLY LOCKED DEF GALC RESOURCE NUMBER. RNAD NOP DEF RNST DUMMY STATUS INFO STORAGE. JMP RNERR ERROR! LDA D4 IOR @F,I SET "RN ALLOCATED BIT" STA @F,I JMP RNSUB,I OR NORMAL COMPLETION: RETURN. * RNERR JSB SYSER ALLOCATION ERROR: INFORM THE CALLER. DEF RNERM CATASTROPHIC ERROR--NO RETURN! * GA LC OCT 140021 GLOBAL ALLOCATE/LOCAL LOCK/NO ABORT RNST EQU SECOD RN STATUS STORAGE (NOT USED). SKP * SCHEDULE , THE TRANSACTION MONITOR & CLEANUP PROGRAM, * TO RUN EVERY FIVE SECONDS. * SUPLN NOP CLA,INA STA UPLI. SET SCHEDULED BIT JSB EXEC GO TO THE DEF *+6 RTE EXECUTIVE DEF SCHTM TO TIME-SCHEDULE DEF UPLI.+2 DEF B2 TO BE RUN DEF B5 EVERY FIVE SECONDS; DEF DM2 TO BEGIN IN TWO SECONDS. RSS IF A SYSTEM ERROR IS DETECTED, SKIP; JMP SUPLN,I ELSE, RETURN TO THE CALLER. * LDA SRT,I ADA D2 --> "UPLIN" LDB @QMSG ADB D7 --> WARNING MESSAGE JSB .MVW DEF D3 NOP JSB SYSER INFORM THE USER OF A CATASTROPHIC ERROR: DEF QWMSG 'UPLIN' WAS NOT SCHEDULED. [NO RETURN] * SCHTM OCT 100014 SKP * SUBROUTINE TO PRINT MESSAGES ON INTERACTIVE TERMINALS--ONLY. * * CALLING SEQUENCES: * * JSB PRINT....PRINT:" /DINIT:" JSB PRNTX....PRINT:"" * DEF MESSAGE DEF MESSAGE * * NOTE: MESSAGE LENGTH LIMITED TO 72 CHARACTERS * * PRNTX NOP ENTRY/EXIT: PRINT W/O HEADER LDA PRNTX GET THE RETURN ADDRESS. STA PRINT SAVE FOR THE RETURN. LDA A,I GET THE MESSAGE ADDRESS, STA OLDAD AND SAVE FOR ERROR-TRANSFER ROUTINE. DLD A,I GET THE MESSAGE SPECIFICATIONS, DST PRNT1 AND CONFIGURE THE CALLING SEQUENCE. JMP PRNT0 GO TO PRINT THE MESSAGE W/O HEADER. * PRINT NOP NORMAL ENTRY/EXIT DLD NORMA RE-ESTABLISH THE DST PRNT1 NORMAL MESSAGE SPECIFICATIONS. LDA MSGAD INITIALIZE THE STA BUFPT MESSAGE BUFFER POINTER. LDB PRINT GET ADDRESS OF MESSAGE INFORMATION. LDB B,I  TRACK DOWN RBL,CLE,SLB,ERB A DIRECT JMP *-2 ADDRESS. LDA $ERR IF THE ERROR-TRANSFER ROUTINE IS SZA,RSS IN CONTROL, BYPASS 'OLDAD' UPDATING. STB OLDAD SAVE IT FOR THE ERROR-TRANSFER ROUTINE. DLD B,I GET BUFFER ADDRESS AND LENGTH. STA MSPNT SAVE FOR SOURCE POINTER. LDB B,I GET THE MESSAGE LENGTH. STB PRNTL INCLUSION OF THE HEADER. CMB,INB IF THE MESSAGE LENGTH ADB D36 EXCEEDS THE MAXIMUM SSB BUFFER SIZE, THEN JMP PRNTA IGNORE THE REQUEST; ELSE, DLD MSPNT TRANSFER THE MESSAGE JSB .MVW TO THE PRINT BUFFER. DEF PRNTL NOP LDA PRNTL GET THE MESSAGE LENGTH. ADA B5 ADD IN THE HEADER SIZE. STA PRNTL SAVE TOTAL MESSAGE LENGTH. * PRNT0 LDA TYPEQ GET TTY FLAG LDB $ERR GET ERROR FLAG SZB,RSS ERROR OR SZA,RSS OR INTERACTIVE RSS YES...PRINT MESSAGE JMP PRNTA NO ERROR AND NOT INTERACTIVE LDA RLU GET INTERACTIVE LU SZB ERROR? LDA ERLU YES...ERROR LU IOR ECHO (SET ECHO BIT) STA PRTLU SAVE AS PRINT LU * JSB EXEC PRINT MESSAGE DEF *+5 DEF B2 DEF PRTLU PRINT LU PRNT1 DEF HEDMS MESSAGE ADDRESS. DEF PRNTL MESSAGE LENGTH. PRNTA ISZ PRINT POINT TO RETURN ADDRESS JMP PRINT,I RETURN SPC 1 ERLU NOP ERROR LOGICAL UNIT NO. PRTLU NOP PRNTL NOP OLDAD NOP PREVIOUS MESSAGE ADDRESS. BUFPT NOP NORMA DEF HEDMS DEF PRNTL MSPNT NOP MSGAD DEF MSGBF HEDMS OCT 6412 CARRIAGE-RETURN/LINEFEED. ASC 4,/DINIT: MSGBF BSS 36 * * ROUTINE TO DECIDE WHICH TYPE OF INPUT DEVICE * EITHER FILE OR LU * IF LU, A-REG WILL CONTAIN LU TYPE, B-REG = READ LU, E=0 * CALLING SEQUENCE * JSB CHCKN * PW * * CHCKN NOP LDB RLU GET READ-DEVICE LU. LDA TYPEQ GET EQUIPMENT TYPE CODE. CLE,SZB,RSS LU OR FILE ISZ CHCKN FILE JMP CHCKN,I AND RETURN * * SUBROUTINE TO PRINT SYSTEM ERROR MESSAGES AND * ABORT * CALLING SEQUENCE * JSB SYSER * DEF ERR MESSAGE * SYSER NOP LDA SYSER,I GET MESSAGE SPECIFICATION ADDRESS. STA *+3 CONFIGURE CALL TO PRINT ROUTINE. ISZ $ERR SET ERROR FLAG. JSB PRINT DEF *-* JMP ABORT AFTER MESSAGE...ABORT SPC 3 * SUBROUTINE TO READ FROM A SELECTED INPUT DEVICE. * IT PARSES THE INPUT AND PLACES THE RESULT IN A BUFFER * CALLED PARSB. IF FIRST PARAMETER = '/A' WILL GO TO 'ABORT'. * * CALLING SEQUENCE: * JSB READ * UPON RETURN A REG=PARSB, B REG=PARSB+1 * READ NOP LDA DM4 ALLOW THREE STA RETRY ERROR-RETRIES. READA LDA RLU GET READ LU LDB $ERR IS THIS AN ERROR READ? SZB LDA ERLU YES...READ FROM ERROR DEVICE. SZA,RSS IF THE SOURCE IS FROM A FILE, JMP READB THEN GO TO FILE READ ROUTINE. IOR ECHO SET ECHO BIT STA PRTLU SAVE READ LU JSB EXEC DEF *+5 DEF B1 DEF PRTLU DINBF DEF INBUF DEF INBFS SZB EOF HIT? JMP READC NO REDER JSB QUERY INDICATE ERROR, AND ALLOW RE-TRY. DEF READM JMP READA TRY AGAIN SPC 1 READB EQU * ISZ LINE# BUMP LINE NUMBER COUNTER JSB READF READ FROM A FILE DEF *+6 DEF INDCB DEF TEMP1 DEF INBUF DEF INBFS DEF PRNTL LDB PRNTL GET LENGTH SSA,RSS FILE ERROR? SZB,RSS OR ZERO-LENGTH RECORD? JMP REDER YES--PROCESS THE ERROR. * READC EQU * CLE,ELB CONVERT TO BYTE LENGTH STB PRNTL SAVE LENGTH s LDA INBUF GET AND =B77400 FIRST CPA ASTSK CHARACTER: ASTERISK(*) ? JMP READA YES, READ ANOTHER ONE JSB PARSE GO PARSE INPUT DEF *+4 DEF INBUF DEF PRNTL DEF PARSB CLA,CLE CLEAR OUT ERROR FLAG STA $ERR DLD PARSB LOAD A AND B REG CPB /A IF RECORD'S FIRST 2 CHARS. =/A JMP *+2 SKIP TO CHECK NEXT TWO. JMP READ,I ELSE, RETURN. LDB PARSB+2 GET NEXT TWO CHARACTERS. CPB BLNKS IF THEY ARE BLANKS, JMP ABORT THEN PROCESS THE ABORT REQUEST! LDB PARSB+1 ELSE, RESTORE , JMP READ,I AND RETURN. * DM4 DEC -4 * RDER NOP ASTSK OCT 25000 ASCII "*" IN HIGH BYTE LINE# NOP LINE NUMBER COUNTER (FILE INPUT ONLY) SPC 2 * ROUTINE TO PRINT ERROR MESSAGE. * * CALLING SEQUENCE: * * JSB ERROR * DEF * * WILL SET ERROR FLAG FOR RETRY * ERROR NOP LDA ERROR,I GET MESSAGE SPECIFICATION ADDRESS. STA *+3 CONFIGURE CALL TO PRINT ROUTINE. ISZ $ERR FORCE MESSAGE TO ERROR DEVICE. JSB PRINT PRINT THE ERROR MESSAGE. DEF *-* CLA CLEAR THE STA $ERR ERROR FLAG. ISZ ERROR BYPASS THE MESSAGE-SPECIFICATION. JMP ERROR,I AND RETURN SPC 1 $ERR NOP ERROR OCCURED FLAG SPC 2 * PRINT THE ERROR MESSAGE AND REPEAT THE QUESTION ON THE (ERROR LU) DEVICE. * * CALLING SEQUENCE: * * JSB QUERY * DEF * QUERY NOP ENTRY/EXIT: ERROR TRANSFER ROUTINE ISZ $ERR SET ERROR FLAG. ISZ RETRY ALL RETRIES BEEN EXHAUSTED? JMP *+2 NO. TRY AGAIN. JMP ABORT YES--ABORT THE PROCESS! * LDA QUERY,I GET MESSAGE ADDRESS. STA *+2 JSB PRINT GO TO PRINT DEF *-* * JSB PRINT GO TO REPEAT THE QUESTION DEF OLDAD,I ON THE (E4uRROR LU) DEVICE. ISZ QUERY SET RETURN ADDRESS JMP QUERY,I AND RETURN. SKP * SUBROUTINE TO CHECK DRIVER TYPE * CALLING SEQUENCE: JSB TTY? * DEF * UPON RETURN, A-REG=LU NUMBER, B-REG=0 IF INTERACTIVE * TTY? NOP LDA TTY?,I STORE ADDRESS OF STA CHKLU LU IN EXEC CALL. ISZ TTY? SET RETURN ADDRESS. JSB IFTTY CALL IFTTY TO DETERMINE STATUS. DEF *+2 CHKLU DEF *-* INA CHANGE IFTTY'S -1 TO 0. LDB A MOVE TO B-REG. LDA CHKLU,I A-REG := LU NUMBER. JMP TTY?,I RETURN. SPC 1 * CALCULATE SLAVE LIST HEADER ADDRESS, --> SRT * CALC NOP ADB D5 --> STREAM WORD LDB B,I GET STREAM WORD ADB D2 COMPUTE ADB #LDEF LIST HEADER LDB B,I ADDRESS JMP CALC,I SKP *---------------------------------------------------------------+ * DS/1000 SHUTDOWN CODE | *---------------------------------------------------------------+ IFZ * OPTION 2 IS ENTERED WHEN SYSTEM IS ALREADY INITIALIZED. * OPTN2 EQU * JSB PRINT DEF SHMES "SHUTDOWN?" JSB READ CPB YE JMP SHUTD JMP TERM SHUTDOWN NOT WANTED, TERMINATE * SPC 3 $1 EQU 1 $7 EQU 7 * SYSTEM SHUTDOWN ROUTINE (RELEASE ALL NETWORK-RELATED RESOURCES) * SHUTD EQU * JSB PRINT DEF SDHED "SYSTEM SHUTDOWN" LDA #BUSY CONVERT # ACTIVE TCBS TO ASCII JSB DECML DEF SHT.1 JSB PRINT DEF SHTM1 * * COUNT NUMBER OF ACTIVE REMOTE SESSIONS, SCANNING THE * PROCESS NUMBER LIST (CONTAINS REMOTE RTE & REMOTE MPE SESSIONS) * CLA INITIALIZE # OF STA TEMP ENTRIES COUNTER LDB #PNLH GET ADDRESS OF PROCESS # LIST SHUT. EQU * START OF PNL-COUNTING LOOP SZB,RSS EN"HD OF LIST? JMP SHUT0 YES DSNR7 LDA B,I (XLA B,I IF IN DMS) NOP (RESERVED FOR XLA INSTR. IF DMS) ISZ TEMP BUMP COUNTER STA B JMP SHUT. CONTINUE IN LOOP * SHUT0 EQU * LDA TEMP CONVERT # SESSIONS TO ASCII JSB DECML DEF SHT.2 JSB PRINT DEF SHTM2 * * NOW WE'VE PRINTED THE NUMBER OF ACTIVE TCBS AND * SESSIONS, SO GIVE THE GUY A CHANCE TO BACK OUT * IF SHUTDOWN WOULD CAUSE ANY OF THE LOCAL SYSTEM * USERS ANY INTERFERENCE. THIS SAME TEST VERIFIES * THAT THIS PERSON HAS AUTHORITY TO SHUT THE SYSTEM * DOWN. * JSB NMSCX OBTAIN & VERIFY NM SECURITY CODE * (RETURN ONLY IF CODES MATCH) JSB PRINT "BEGINNING SHUTDOWN" DEF SBEGN * JSB PGMAD IF GRPM IS NOT ACTIVE DEF *+2 IGNORE SENDING MESSAGES DEF GRPM.+2 CPB D3 WAITING? RSS . YES OK JMP SHUT4 . NO, IGNORE COMMUNICATIONS * * CHECK FOR SLAVE PROGRAM-TO-PROGRAM COMMUNICATION ACTIVITY LDA #ST04+1 GET "PTOPM" CLASS NUMBER SZA,RSS ACTIVE? JMP SHUT2 NO. * * ISSUE "SO" TO PTOPM, SO AS TO ABORT ALL SLAVES CURRENTLY * ACTIVE. * CLA PLACE A ZERO IN PROGRAM NAME STA #RQB+#PCB PORTION OF REQUEST, MEANING STA #RQB+#PCB+1 "ABORT ALL SLAVES " STA #RQB+#PCB+2 LDA D6 STA #RQB+#FCD SAVE PTOP FUNCTION CODE LDA B4 STA #RQB+#STR SET STREAM TYPE (4) LDA #NODE LOCAL NODE # STA #RQB+#DST SET REQST DESTINATION NODE JSB #MAST SEND REQUEST (NO DATA) DEF *+7 DEF BIT15 NO ABORT DEF L#PCB SIZE OF REQUEST DEF ZERO DEF ZERO NO DATA ASSOCIATED WITH REQST DEF ZERO NO REPLY DATA DEF L#PCB MAX REPLY LENGTH NOP #MAST DETECTED ERROR (IGNORE) SPC 2 SHUT2 EQU * * F CHECK FOR SLAVE REMOTE DATA BASE ACCESS COMMUNICATION ACTIVITY. LDA #ST10+1 GET "RDBAM" CLASS NUMBER SZA,RSS ACTIVE? JMP SHUT3 NO. * * ISSUE A CLEAN-UP REQUEST TO RDBAM, SO AS TO ABORT ALL REMOTE * DATA BASE ACCESS PROGRAMS CURRENTLY ACTIVE. * CCA PLACE A -1 IN RDBA INDEX STA #RQB+#EHD+1 AND MODE WORDS OF REQUEST, STA #RQB+#EHD+2 MEANING "ABORT ALL ACTIVE RDBA SLAVES". LDA D10 SET STREAM TYPE (10). STA #RQB+#STR LDA #NODE LOCAL NODE NUMBER, STA #RQB+#DST SET REQUEST DESTINATION NODE. * JSB #MAST SEND REQUEST (NO DATA) DEF *+7 DEF BIT15 NO ABORT DEF C#FCD SIZE OF REQUEST DEF ZERO NO DATA ASSOCIATED WITH REQUEST DEF ZERO DEF ZERO NO REPLY DATA DEF D7 MAX REPLY LENGTH NOP #MAST DETECTED ERROR (IGNORE). SPC 2 SHUT3 EQU * JSB RNRQ LOCK THE QUIESCENCE RN TO DEF *+4 PREVENT NEW REQUESTS FROM DEF GLOCK BEING RECEIVED FROM REMOTE NODES, OR DEF #QRN DEF TEMP1 ISSUED BY LOCAL MASTERS. * SHUT4 EQU * CCA LOG OFF ANY REMOTELY CREATED LOCAL JSB #DISM SESSIONS CLA STA ONTWO CLEAR THE "OPTION 1/2" FLAG STA #NULL SET # AVAILABLE TCBS TO ZERO * CLA,INA STA UPLI. INDICATE PROGRAM SCHEDULED LDB SRT,I --> UPLIN' SRT ENTRY JSB SNUFF KILL UPLIN * * SEND TIME-OUT INDICATION TO ALL MASTERS CURRENTLY WAITING * FOR REPLIES. * LDB #MRTH ADDR OF LIST HEADER CKMST EQU * SZB,RSS END OF LIST? JMP SHUT5 YES. DSNR4 LDA B,I (CROSS) LOAD ADDR OF NEXT TCB NOP [RESERVED FOR XLA] STA LSTAD SAVE NEXT TCB ADDRESS ADB =LSEQ# ADVANCE POINTER TO SEQUENCE NUMBER DSNR9 LDA B,I LOAD(CROSS-LOAD) SEQUENCE NUMBER ,NOP (NECESSARY FOR XLA, IF IN DMS) STA TEMP SAVE SEQUENCE NUMBER, BRIEFLY. ADB =LMSCLS-SEQ# ADVANCE POINTER TO SEQUENCE NUMBER DSNR5 LDA B,I (CROSS) LOAD CLASS NUMBER NOP [RESERVED FOR XLA] STA CLASN STORE JSB EXEC WRITE ZERO-LENGTH RECORD INTO CLASS DEF *+8 (FORCES DS05 ERROR TO BE RETURNED TO DEF CLS18 USER) DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF CLASN MASTER CLASS # NOP IGNORE ERRORS LDB LSTAD RECOVER NEXT TCB ADDRESS JMP CKMST GO CHECK FOR ANOTHER MASTER SPC 2 * SET UP TO CALL "ABRT" SUBROUTINE, WHICH WILL RELEASE REMAINING * RESOURCES SHUT5 EQU * SETUP DATA FOR ABORT ROUTINE LDA #SCLR DATA AREA LDB LSBFA DATA AREA JSB .MVW MOVE VARIABLES TO LOCAL AREA DEF MVSIZ NOP CLA STA #GRPM INDICATE GRPM NO LONGER AVAILABLE *-- SCAN THRU SLAVE LIST AND CHECK SLAVES JSB .LDX --> 1ST MONITOR'S SRT DEF @MON,I LDA #LDEF ADA D3 LDA A,I JSB .CAY --> 1ST SLAVE HEADER LDB MNMON -( # OF MONITORS ) SHUT6 JSB .LAY GET CLASS WORD FROM SLAVE LIST DEF $1 SZA,RSS IGNORE IF NOT PRESENT JMP SHUT7 JSB .SAX SAVE CLASS # IN SRT DEF $7 LDA D3 JSB .SAX INDICATE PROGRAM AND CLASS DEF 0 SHUT7 JSB .ADX --> NEXT SRT ENTRY DEF D8 JSB .ADY --> NEXT SLAVE HEADER DEF D5 ISZ B JMP SHUT6 *-- SETUP FLAGS FOR ABORT ROUTINE LDA D2 CLASS ONLY STA MA2. STA EX1. STA EX2. LDA D3 PROGRAM & CLASS STA QXCL. STA RQCV. STA RPCV. STA GRPM. STA RTRY. STA QCLM. STA INCV. STA OTCV. STA RSM. INA RN ONLY STA TBRN. STA QRN. STA CLRN. INA PROGRAM & RN STA QZRN. STA MA1. * JSB ABRT ABORT ALL PGM/RN/CLASS RESOURCES * JSB PRINT "SHUTDOWN COMPLETE" DEF SHTMS JMP TERM SPC 2 SHTMS DEF *+2 DEF D9 ASC 9,SHUTDOWN COMPLETED * DEFINE REQUEST/REPLY BUFFER FORMAT SPC 4 *---------------------------------------------------------------+ * SHUTDOWN CONSTANTS | *---------------------------------------------------------------+ SPC 1 YE ASC 1,YE CLASN NOP LSTAD NOP SHTM1 DEF *+2 DEF D11 ASC 8,# ACTIVE TCBS = SHT.1 BSS 3 STORAGE FOR # ACTIVE TCBS COUNT(IN ASCII) SHTM2 DEF *+2 DEF D14 ASC 11,# OF REMOTE SESSIONS: SHT.2 BSS 3 STORAGE FOR # REMOTE SESSIONS SDHED DEF *+2 DEF D8 ASC 8,SYSTEM SHUTDOWN SBEGN DEF *+2 DEF D9 ASC 9,BEGINNING SHUTDOWN XIF SKP *---------------------------------------------------------------+ * ABORT ROUTINE. "KILLS" ALL PROGRAMS THAT WERE SCHEDULED, | * DEALLOCATE CLASS NUMBER AND RESOURCE NUMBERS, AND CLEARS | * ALL LU'S. | *---------------------------------------------------------------+ * ABORT EQU * JSB ABRT CALL SUBROUTINE LDA LINE# WAS INPUT FROM SZA,RSS A FILE? JMP *+5 NO. * CONVERT LINE NUMBER TO ASCII & PRINT, AS * A TROUBLESHOOTING AID TO USER. JSB DECML DEF .LIN. JSB PRINT DEF .LINX * JSB PRINT PRINT "DINIT ABORTED" @ABPR DEF ABRTM LDA @ABPR RETURN ERROR TO 'FATHER' PRGM STA $RTRN JMP TERM SPC 2 ABRT NOP SUBROUTINE TO ABORT EVERYTHING LDA ONTWO OPTION 1 OR 2 SZA JMP ABRT4 OPTION 2 * CPA #FWAM  IF SAM HAS NOT BEEN ALLOCATED, JMP ABRT4 THEN GOTO COMPLETION. * LDB SRT,I --> UPLIN ENTRY JSB SNUFF "KILL" UPLIN * * * TURN OFF "LISTEN MODE" FOR EACH COMMUNICATION DRIVER * DLD #NCNT SET UP NRV SCAN LOOP SZA,RSS NRV? JMP ABRT2 NO. DST NRV1 ADB XMTL. ADVANCE POINTER TO TRANSMISSON LU WRD * GET TRANSMISSION LU DSNR8 LDA B,I (XLA B,I IN DMS) NOP (PART OF XLA INSTR. ABOVE IF IN DMS) AND XMASK MASK LU IOR BIT15 STA LU1 SAVE FIRST HALF OF DOUBLE-WORD LU LDA CLSTN CLEAR "DINIT MODE" SUB-FUNCTION STA LU2 SAVE 2ND HALF OF DOUBLE-WORD LU STB PRINT SAVE (B) JSB XLUEX ISSUE "CLEAR LISTEN MODE" CALL TO DRIVER DEF *+3 DEF NBRT3 NO-ABORT, CODE 3 DEF LU1 NOP LDB PRINT RECOVER (B) ADB NRVS. ADVANCE TO NEXT NRV ENTRY ISZ NRV1 BUMP COUNTER. DONE? JMP DSNR8 NOT YET DONE * JSB #RR5 DISABLE LUS IN LV TABLE * LDA D2 DE-ALLOCATE JSB #DISM RSM RESOURCES * ABRT2 EQU * LDA SRTLN KILL ALL RESOURCES CMA,INA STA MCTR LDA SRT STA MPTR ABRT3 LDB MPTR,I ISZ MPTR JSB SNUFF KILL ALL RESOURCES FOR THIS ENTRY ISZ MCTR JMP ABRT3 REPEAT TILL DONE JSB #RSAX GO TO THE SYSTEM-RESOURCE DEF *+4 CONTROL-ROUTINE, IN ORDER TO DEF B1 RETURN SYSTEM AVAILABLE MEMORY, DEF #FWAM WHICH WAS PREVIOUSLY ALLOCATED. DEF LSECD CLA CLEAR #FWAM FLAG STA #FWAM JSB CLEAR GO TO CLEAR SYSTEM DATA AREA IN . * ABRT4 EQU * JMP ABRT,I RETURN TO CALLER * CLSTN OCT 3100 SUBFUNCTION BITS FOR "CLEAR LISTEN MODE" CALL TO DRIVER XMASK EQU B377 TRANSMISSION LU FIELD MASK SPC 3 XMTL. EQU B2 NBRT3 OCT 100003 NO-ABORT CONTROL CONTROL * * ROUTINE TO CLEAR 'DINIT'-INITIALIZED ENTRIES IN . SPC 1 CLEAR NOP ENTRY/EXIT LDA #NCLR INITIALIZE A COUNTER FOR THE STA TEMP SIZE OF THE AREA TO BE CLEARED. LDB #SCLR GET A POINTER TO THE START OF THE AREA. CLA * CLEAR THE "ALIEN MESSAGE FORMAT NODES" FLAG, INDICATING * THERE ARE NONE. STA MSCFL CLOOP STA B,I CLEAR THE INB 'DINIT'-INITIALIZED ISZ TEMP STORAGE LOCATIONS JMP CLOOP IN 'RES'. JMP CLEAR,I RETURN SKP *---------------------------------------------------------------+ * ROUTINE TO "KILL" A PROGRAM OR CLASS OR RN | * | * ON ENTRY --> SRT ENTRY | * NOTE: HAVING A CLASS# AND AN RN ARE MUTUALLY EXCLUSIVE | *---------------------------------------------------------------+ * SNUFF NOP RBL,CLE,SLB,ERB RESOLVE INDIRECT ADDRESS LDB B,I INTO DIRECT ADDRESS STB SNUF5 --> SRT ENTRY LDA B,I CHECK FLAGS SLA,RSS WAS PROGRAM SCHEDULED? JMP SNUF1 . NO LDA B ADA D2 --> PROGRAM NAME LDB @OFF --> WHERE TO PUT IT ADB D2 JSB .MVW DEF D3 NOP LDA @OFF LDB @BUF JSB .MVW MOVE MESSAGE TO BUFFER DEF D7 NOP JSB MESSS "OFF,PGMNM ,FL" DEF *+4 @BUF DEF BUF DEF D13 DEF ZERO NO PRINTED MESSAGE * SNUF1 LDA SNUF5 INA LDA A,I --> CLASS OR RN STA SNUF3 STA SNUF4 LDA SNUF5,I CHECK FLAGS RAR SLA,RSS CLASS # ASSIGNED? JMP SNUF2 . NO * JSB CLRQ DEALLOCATE CLASS # DEF *+4 DEF CLCLS SNUF3 DEF *-* DEF  ZERO NOP CLA STA SNUF3,I CLEAR OUT CLASS # JMP SNUF6 * CLCLS OCT 140002 DEALLOCATE CLASS, NO WAIT, NO ABORT * SNUF2 RAR SLA,RSS RN ASSIGNED? JMP SNUF6 . NO JSB RNRQ DEALLOCATE RN DEF *+4 DEF DALC SNUF4 DEF *-* DEF PRINT (DUMMY) NOP * SNUF6 EQU * LDA SNUF5,I LDB A AND =B140000 CLEAR RESOURCE FLAGS STA SNUF5,I RBL SSB,RSS SLAVE MONITOR? JMP SNUFF,I . NO RETURN LDB SNUF5 --> SRT JSB CALC CALCULATE LIST HEADER ADDRESS LDA @ZERO JSB .MVW MOVE ZEROS INTO SLAVE HEADER DEF D5 NOP JMP SNUFF,I AND RETURN * DALC OCT 140040 GLOBAL DEALLOCATE SNUF5 BSS 1 @ZERO DEF *+1 OCT 0,0,0,0,0 @OFF DEF *+1 ASC 7,OFF,XXXXX ,FL BUF BSS 6 SKP *---------------------------------------------------------------+ * DINIT MESSAGES | *---------------------------------------------------------------+ QWMSG DEF *+2 DEF D26 ASC 26, WARNING! XXXXX IS A REQUIRED PROCESSOR FOR DS/1000! MUCHO DEF *+2 DEF D15 ASC 15,SIZE OF SAM AREA EXCEEDS 32K! D3MS1 DEF *+2 DEF D7 ASC 7,LU OF HP3000?_ D3MS4 DEF *+2 DEF D10 ASC 10,LOCAL ID SEQUENCE? _ D3MS5 DEF *+2 DEF D10 ASC 10,REMOTE ID SEQUENCE?_ MSG0 DEF *+2 DEF D12 ASC 12,# ACTIVE TRANSACTIONS? _ IVRES DEF *+2 DEF D9 ASC 9,INVALID RESPONSE! NOMEM DEF *+2 DEF D9 ASC 9,NO SYSTEM MEMORY! MSG4 DEF *+2 DEF D16 ASC 16,MAX # CONCURRENT HP3000 USERS? _ * MONMS DEF *+2 DEF D7 ASC 7,MONITOR NAME?_ INVNM DEF *+2 DEF D7 ASC 7,INVALID NAME! LOC? DEF *+2 DEF D6 ASC 6,LOCAL CPU#?_ * NUMB? DEF *+2 DEF D6 ASC 6,# OF NODES?_ * NODEF DEF *+3  DEF *+1 DEC 32 ASC 26, CPU#,LU,TIMEOUT,UPGRADE LEVEL,"N","MA",MA TIMEOUT? OCT 6412 ASC 5, _ * MSG1 DEF *+2 DEF D16 ASC 16,SYSTEMS CONNECTED TO THIS NODE: _ .... * MSG2 DEF *+2 DEF D5 ASC 5, HP 1000?_ .... ERR1 DEF *+2 DEF D9 ASC 9,ANSWER YES OR NO! FERMG DEF *+2 DEF D5 ASC 5,FILE ERROR * RNERM DEF *+2 DEF B5 ASC 1, R "N ASC 1,N ASC 3,ERROR " RN ERROR" * * TRFM DEF *+2 DEF D7 ASC 7,TR FILE ERROR * FILMG DEF *+2 DEF D5 ASC 5,# FILES? _ ... * READM DEF *+2 DEF D5 ASC 5,READ ERROR * ABRTM DEF *+2 DEF D7 ASC 7,DINIT ABORTED! * CLSER DEF *+2 DEF D8 ASC 8,CLASS I/O ERROR * NOCL. DEF *+2 DEF D6 ASC 6,NO CLASS #S * ENDMG DEF *+2 DEF B5 ASC 5,END DINIT * UPLUM DEF *+2 DEF D10 ASC 10,ENABLE LU#[,COST]? _ ... * SHMES DEF *+2 DEF D6 ASC 6, SHUTDOWN? _ * NOSZR DEF *+2 DEF D9 ASC 9,NODE SPEC. ERROR! MNAY DEF *+2 DEF D16 ASC 16,THIS LU ALREADY HAS A NEIGHBOR! LUERM DEF *+2 DEF B4 ASC 4,LU ERROR TOBAD DEF *+2 DEF D8 ASC 8,INVALID TIMEOUT! INLVL DEF *+2 DEF D11 ASC 11,INVALID UPGRADE LEVEL! * IFN .NINZ DEF *+2 DEF D12 ASC 12,NODE ALREADY INITIALIZED XIF * .LINX DEF *+2 DEF D11 ASC 8,ERROR IN LINE # .LIN. ASC 3, * CNERR DEF *+2 DEF D12 ASC 9,INIT FAILED ON LU CNER. BSS 3 * * BSS 0 << SIZE OF 'DINIT' >> SPC 1 * * DEFINE INTERNAL SYMBOLS FOR USE BY "OPTIONAL" EXTERNAL ROUTINES * #PRNT EQU PRINT #READ EQU READ #PRSB EQU PARSB #INBF EQU INBUF #PRNL EQU PRNTL #EXFR EQU QUERY #CLSB EQU CLSUB #ABRT EQU ABORT #SYSR EQU SYSER #MSKD EQU SCHED #RNSB EQU RNSUB END DINIT qDB>>D :M 91750-18070 2013 S C0122 &DLIS3              H0101 gASMB,C,Q HED DLIST 91750-16070 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM DLIST,19,30 91750-16070 REV 2013 800425 M CTU SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ******************************************************* * * DIRECTORY LIST MONITOR FOR RTE-M CTU-BASED SYSTEMS * * NAME: DLIST * SOURCE: 91750-18070 * RELOC: 91750-16070 * PGMR: DAN GIBBONS * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,#SLAV,#GET,#NODE EXT .MVW EXT .DRCT,$CDIR EXT #RPB RQB EQU #RPB * * SUP A EQU 0 B EQU 1 SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU Y0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SPC 3 * * OFFSETS INTO DLIST REQUEST/REPLY BUFFER * STYP EQU #STR STREAM TYPE STAT EQU #REP STATUS LNGH EQU #REQ+1 LENGTH WORD BROUT EQU #REQ+2 ADR OF NEXT PROCESS ROUTINE. 0=START CTULU EQU #REQ+7 CARTRIDGE TAPE UNIT LU # ENDCD EQU #REP+9 END-OF-CARTRIDGE-DIRECTORY ADR ENDFD EQU #REP+10 END-OF-FILE-DIRECTORY ADR VAL EQU #REP+11 DIRECTORY-VALID FLAG. 0=VALID DISP EQU #REP+12 DISPLACEMENT IN BUFFER LUDSP EQU #REP+14 DISPLACEMENT IN DIRECTORY LU * * L#REQ ABS #REQ+16 REQUEST LENGTH L#REP EQU L#REQ REPLY LENGTH HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1980 * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I SEE IF THEY WANT DEBUG STA CLSSN SAVE CLASS NUMBER SPC 1 DLST0 JSB #GET DO A GET CALL DEF *+6 DEF CLSSN DEF RQB DEF L#REQ DEF D0 NO DATA DEF D0 JMP DLST0 IGNORE ERROR CALL * LDA RQB+BROUT GET ADDRESS OF CURRENT COROUTINE @ SZA,RSS JMP SUB1 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 JSB .DRCT GET ADR OF CTU DIRECTORY DEF $CDIR STA RQB+LUDSP SAVE FOR LU LOOPING ADA M1 GET TO LAST TRACK LDA A,I GET LAST-ENTRY ADR STA RQB+ENDCD SAVE IT SUB2 LDA RQB+LUDSP GET DIRECTORY POINTER CPA RQB+ENDCD DONE? JMP DONE YES LDA A,I GET CARTRIDGE LU SZA,RSS DONE? JMP DONE YES SUB22 LDA RQB+CTULU DO THEY WANT A SPECIFIED LU? CPA DBLNK LU SUPPLIED? JMP MCR NO, DO ALL LU'S LDB RQB+LUDSP GET DISPLACEMENT SSA IF NEG, MAKE POS CMA,INA CPA B,I DOES LU MATCH? JMP MCR MATCH...PROCESS LU ADB D4 NO MATCH. GO TO NEXT ENTRY STB RQB+LUDSP JMP SUB2 SPC 5 * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA RQB+BROUT * LDA LUDSP,I CONVERT LU TO TWO JSB BNDEC ASCII DIGITS & SET DEF LUXX INTO HEAD1 MSG. * ISZ RQB+LUDSP GET TO VALIDITY WORD ADR LDA LUDSP,I GET THE ADR LDA A,I GET THE VALIDITY WORD STA RQB+VAL SAVE IT LDB LHED1 GET HEAD1 MESSAGE LENGTH SZA IS DIRECTORY VALID? LDB LHED2 NO, ADJUST LENGTH OF MESSAGE STB HEAD1 SET MESSAGE LENGTH ISZ RQB+LUDSP GET TO FILE DIRECTORY ADR LDA LUDSP,I GET THE ADR STA RQB+DISP SAVE THE ADR ADA M1 GET TO LAST-ENTRY ADR LDA A,I GET THE ADR STA RQB+ENDFD SAVE IT ISZ RQB+LUDSP GET TO NEXT CTU ISZ RQB+LUDSP DIRECTORY ENTRY. JSB WTLIN SEND LINE BACK TO REMOTE DEF HEAD1 HEADING LINE ADR SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE IF DIRECTORY VALID. * SUB5 LDA RQB+VAL SZA DIRECTORY VALID? JMP SUB6 NO, GET NEXT ONE LDA SUB4A SET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL SPC 5 * * HERE TO START OUTPUTTING DIRECTORY * SUB4 LDA RQB+DISP GET FILE ENTRY ADR CPA RQB+ENDFD END OF DIRECTORY? JMP SUB6 YES LDA A,I GET ENTRY SSA IS THE FILE PURGED? JMP NXT YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU LDA RQB+DISP MOVE THE LDB ADNAM DETAIL LINE JSB .MVW TO PRINT LINE. DEF D4 NOP LDA RQB+DISP GET TO NEXT ENTRY ADA D4 STA RQB+DISP JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE NXT LDA RQB+DISP GET TO NEXT ENTRY ADA D4 STA RQB+DISP JMP SUB4+1 SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * HERE WHEN WE ARE ALL DONE * DONE LDA RQB+BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA RQB+BROUT JSB WTLIN SEND "CTU NOT MOUNTED" DEF NOCRM * DONE1 CLA STA RQB+LNGH SET FOR NO DATA LDA BIT14 TELL OTHER SIDE, ALL DONE JMP TERM SPC 5 * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * BUFFERA FORMAT * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDB WTLIN,I GET LENGTH OF MESSAGE LDB B,I LDA RQB+LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE IF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH? STB RQB+LNGH YES...SET IN CORRECT LENGTH * CLA SET FOR MORE TO COME TERM STA RQB+STAT SAVE STATUS LDA RQB+STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA RQB+STYP LDA #NODE STA RQB+#ENO SET STATUS LOCATION * JSB #SLAV SEND REPLY DEF *+4 DEF L#REQ REPLY LENGTH WTLNB NOP DATA ADDRESS DEF RQB+LNGH DATA LENGTH * NOP IGNORE ERROR RETURN JMP DLST0 GO DO A GET CALL * SPC 5 * * SUBROUTINE TO CONVERT BINARY # TO 2 ASCII DECIMAL DIGITS * * CALLING SEQUENCE: * * JSB BNDEC * DEF BUFFER WHERE TO STORE ASCII DIGITS * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M2 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS JSB SBYTE SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM M2 DEC -2 C60 OCT 60 DNM DEC 10,1 SPC 3 * * o$"SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS THE BYTE * B REG CONTAINS THE BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA STEMP SAVE IN TEMP LOCATION CLE,ERB CONVERT TO WORD ADDRESS LDA B,I GET WORD SEZ,RSS RIGHT OR LEFT HALF? ALF,ALF LEFT AND UB377 ISOLATE UPPER 8 BITS IOR STEMP OR IN NEW HALF SEZ,RSS LEFT OR RIGHT? ALF,ALF LEFT STA B,I SAVE WORD ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN SPC 1 STEMP NOP B377 OCT 377 UB377 OCT 177400 SPC 5 D4 DEC 4 D1 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 BIT14 OCT 40000 * CLSSN NOP ADNAM DEF DNAMA LHED1 ABS ENDM1-SPACA LHED2 ABS ENDM2-SPACA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 BSS 1 HOLDS MESSAGE LENGTH SPACA ASC 2, ASC 9,REMOTE DLIST LU LUXX BSS 1 ASC 5, DIRECTORY ENDM1 EQU * ASC 4, INVALID ENDM2 EQU * NOCRM DEC 8 ASC 8, CTU NOT MOUNTED DLINA DEC 7 ASC 3, DNAMA ASC 4, SPC 2 BLNKL DEC 1 DBLNK OCT 20040 SPC 3 END EQU * END DLIST )v$   91750-18072 2013 S C0122 &DLIST              H0101 ASMB,C,Q,N IFN * START RTE CODE HED DLIST 91750-16072 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 XIF * END RTE CODE * IFZ * START RTE-M/L CODE HED DLIST 91750-16073 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 XIF * END RTE-M/L CODE * IFN * START RTE CODE NAM DLIST,19,30 91750-16072 REV 2013 800205 MEF XIF * END RTE CODE * IFZ * START RTE-M/L CODE NAM DLIST,19,30 91750-16073 REV 2013 800205 L/M2/M3 XIF * END RTE-M/L CODE SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ******************************************************* * * DIRECTORY LIST MONITOR FOR DS-1000 * IFN = RTE SYSTEMS * IFZ = RTE-M/L FLOPPY-BASED SYSTEMS * * NAME: DLIST * SOURCE: 91750-18072 ('IFN' VERSION) * SOURCE: 91750-18072 ('IFZ' VERSION) * RELOC: 91750-16072 ('IFN' VERSION) * RELOC: 91750-16073 ('IFZ' VERSION) * PGMR: DAN GIBBONS * * * MODIFIED BY: GAB [790206] EIG REPLACEMENT WITH JSB'S * JDH [790220] DS REQUEST EQUATED OFFSETS * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,#SLAV,#GET,#NODE EXT .MVW,.MBT,.LBT,.SBT EXT .DRCT EXT #RPB RQB EQU #RPB * IFN * START RTE CODE EXT $CL1,$CL2,FSTAT,$BMON EXTT #ATCH,DTACH XIF * END RTE CODE IFZ * START RTE-M/L CODE EXT $CDIR,$XECM,#IDAD,$OPSY XIF * END RTE-M/L CODE * * A EQU 0 B EQU 1 SUP SPC 2 * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END $ SPC 3 * * OFFSETS INTO DLIST REQUEST/REPLY BUFFER * STYP EQU #STR STREAM TYPE STAT EQU #REP STATUS LNGH EQU #REQ+1 LENGTH WORD FLTR EQU #REQ+3 NAME FILTER...0..NO FILTER MCODF EQU #REQ+6 MASTER SECURITY CODE CRLU EQU #REQ+7 LU OF CART. TO DO FTYP EQU #REQ+8 FILE TYPE FILTER BROUT EQU #REQ+2 ADR OF NEXT PROCESS ROUTINE. 0=START WCLU EQU #REP+9 CURRENT LU FOR DISK READ WTRCK EQU #REP+10 CURRENT TRACK TO READ WSEC EQU #REP+11 CURRENT SECTOR TO READ DISP EQU #REP+12 DISPLACEMENT IN BUFFER SCTRK EQU #REP+13 # OF SECTORS/TRACK LUDSP EQU #REP+14 DISPLACEMENT IN DIRECTORY LU NTRKS EQU #REP+15 # OF DIRECTORY TRACKS * * L#REQ ABS #REQ+16 REQUEST LENGTH L#REP EQU L#REQ REPLY LENGTH HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1980 * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I STA CLSSN SAVE CLASS NUMBER * IFN * START RTE CODE INIT LDA $BMON CHECK TYPE OF SYSTEM SZA PRE-RTE4B SYSTEM? JMP NEWSY NO, SETUP FOR NEW DRCTRY FRMT LDA TATSD YES, GET # TRKS IN SYS DISC ADA M1 GET TO LAST TRACK CLB SET FOR SECTOR ZERO JMP SETCD GO SET CARTRIDGE DRCTRY DISC ADR * CDTRK NOP CARTRIDGE DRCTRY TRACK # CDSEC NOP CARTRIDGE DRCTRY SECTR # * NEWSY JSB DTACH (IN CASE 'DINIT' SCHEDULED FROM SESSION) DEF *+1 * LDA MSCA ADJUST MSTR SEC CODE ADR ADA D128 FOR NEW CARTRIDGE DRCTRY STA MSCA FORMAT. LDA DBFA1 ADJUST BUFR PTR TO ADA D128 2ND BLOCK OF CARTRIDGE STA DBFAD DIRECTORY BUFR. LDA $CL1 GET CARTRIDGE DRCTRY TRK ADR LDB $CL2 GET SECTR ADR OF 2ND BLOCK ADB D2 OF CARTRIDGE DRCTRY. * SETCD STA CDTRK SET DRCTRY TRK # STB CDSEC AND SECTOR #. XIF * END gRTE CODE SPC 1 DLST0 JSB #GET DO A GET CALL DEF *+6 DEF CLSSN DEF RQB DEF L#REQ DEF D0 NO DATA DEF D0 JMP DLST0 IGNORE ERROR CALL * LDA RQB+BROUT GET ADDRESS OF CURRENT COROUTINE SZA,RSS JMP SUB1 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB3A DEF SUB3 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 SUB9A DEF SUB9 SB10A DEF SUB10 SB11A DEF SUB11 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 EQU * IFN * START RTE CODE LDA DBFA1 GET DIRECTORY DATA BUFR ADR STA RQB+LUDSP SAVE FOR LU LOOPING SUB2 LDA D2 GET LU OF SYSTEM DISC STA RQB+WCLU SAVE AS WANTED LU LDA CDTRK GET CARTRIDGE DRCTRY TRACK # STA RQB+WTRCK SAVE IN WANTED TRACK LDB CDSEC GET CARTRIDGE DRCTRY SECTOR # STB RQB+WSEC SAVE IN WANTED SECTOR LDA DBFAD READ 128 WORDS CONTAINING MSTR JSB GETSC SECURITY CODE. * LDA $BMON CHECK SYSTEM TYPE SZA,RSS PRE-RTE4B SYSTEM? JMP SUB2B YES, DRCTRY & MSC ARE IN DBUF LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND RTBYT ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB FSTAT READ IN 253 WORD DEF *+3 CARTRIDGE DIRECTORY DEF DBUF (IN OLD FORMAT). DEF D253 * JSB DTACH DETACH FROM SCB DEF *+1 * SUB2B LDA RQB+LUDSP,I GET LU OF CARTRIDGE SZA,RSS DONE? XIF * END RTE CODE * IFZ * START RTE-M/L CODE * LDA M1 INITIALIZE VARIABLES TO ENSURE STA CTRCK FRESH FILE DIRECTORY COPY STA CSEC ?IS READ AT LEAST ONCE. STA CCLU * JSB .DRCT GET FLOPPY CARTRIDGE DIRECTORY ADR DEF $CDIR STA RQB+LUDSP SAVE FOR LU LOOPING SUB2B EQU * SUB2 JSB .DRCT GET ADR OF DIRECTORY DEF $CDIR ADA M1 GET TO END-OF-DIRECTORY ADR LDA A,I GET THE ADDRESS CPA RQB+LUDSP DONE? JMP DONE YES LDA RQB+LUDSP,I GET LU OF CARTRIDGE SZA DONE OR $CDIR CPA M2 NOT INITIALIZED? XIF * END RTE-M/L CODE * JMP DONE YES LDA RQB+FLTR IF FILTER-WORD #1 CPA M1 IS EQUAL TO A -1, THEN JMP *+2 THIS IS A CARTRIDGE LIST REQUEST; JMP SUB20 ELSE, PROCESS THE DIRECTORY LIST. LDA RQB+FLTR+1 IF FILTER-WORD #2 SZA,RSS IS EQUAL TO A 0, THEN JMP SUB8 BEGIN THE CARTRIDGE LIST JMP SUB10 ELSE, CONTINUE LISTING. SUB20 LDB RQB+BROUT SEE IF FIRST TIME SZB JMP SUB22 NOT FIRST TIME IFZ * START RTE-M/L CODE LDA $XECM GET RTE-M/L SECURITY CODE STA MSCA,I SAVE IT XIF * END RTE-M/L CODE CPB RQB+MCODF MSTR SECU SUPPLIED? (NOTE: =0) JMP SUB22 NONE--NO SPECIAL ACCESS. LDA MSCA,I GET MASTER SECURITY CODE. SZA,RSS IF NONE, ALLOW ACCESS. JMP SUB22 NO SYS SECU CODE, SO ALLOW ACCESS * IFN * START RTE CODE LDB $BMON CHECK TYPE OF SYSTEM SZB,RSS PRE-RTE4B SYSTEM? JMP NOMSK YES, NO MASK ON MSTR SECU CODE XOR MASK NO, SECU CODE IS ENCRYPTED INA CONTINUE THE DECRYPTION NOMSK EQU * XIF * END RTE CODE * CPA RQB+MCODF USER'S AND MASTER MATCH? JMP SUB22 MATCH! ALLOW ACCESS. CLB NO SPECIAL ACCESS ALLOWED, SO STB RQB+MCODF CLEAR MCODF. SUB22 LDA RQB+CRLU DO THEY WANT A SPECIFIED LU? SZA,RSS LU SUPPLIED?  JMP MCR NO LDB RQB+LUDSP GET DISPLACEMENT CMA,INA ASSUME LU SSA,RSS IS IT LABEL? JMP SUB23 NO...LU CMA,INA YES...LABEL...MAKE POS AGAIN ADB D2 AND GET TO LABEL WORD SUB23 CPA B,I IS LABEL OR LU MATCH? JMP MCR MATCH...PROCESS LU LDA RQB+LUDSP NO MATCH GO TO NEXT ONE ADA D4 STA RQB+LUDSP JMP SUB2B UNL IFN * START RTE CODE MASK DEC 31178 XIF * END RTE CODE LST SPC 5 * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA RQB+BROUT LDA SECT2 GET # OF SECTORS IN TRACK STA RQB+SCTRK SAVE IN SECTORS/TRACK LDA RQB+LUDSP,I GET LU OF DISK STA RQB+WCLU SAVE AS WANTED CURRENT LU ISZ RQB+LUDSP GET TO FIRST DIRECTORY TRACK LDB RQB+LUDSP,I GET DIRECTORY TRACK ADDRESS STB RQB+WTRCK SAVE TRACK ADDRESS ISZ RQB+LUDSP GET TO LOCK WORD ISZ RQB+LUDSP LDB RQB+LUDSP,I GET LOCK WORD ISZ RQB+LUDSP GET TO NEXT ENTRY SZB IS LU LOCKED JMP SUB2 YES * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB PRE-RTE4B SYSTEM? JMP MCR01 NO CPA D2 YES, IS IT SYSTEM DISC? LDB D14 YES RSS MCR01 CLB XIF * END RTE CODE * STB RQB+WSEC SAVE STARTING SECTOR ADDRESS LDA DBFA1 SET FOR ZERO DISPLACEMENT WITHIN BUFFER JSB SCFX GO GET SECTOR JMP SUB2 NO FILE DIRECTORY LDA RQB+DISP GET NAME OF CART. LDB CRNAA GET DESTINATION ADDRESS JSB .MVW MOVE 3 WORDS DEF D3 NOP LDA CRNA GET FIRST WORD OF CR NAME RAL,CLE,ERA GET RID OF SIGN BIT STA CRNA RESTORE LDA RQB+DISP GET TO LABEL WORD ADA D3 eLDA A,I CONVERT LABEL WORD TO ASC JSB BNDEC DEF LWA LABEL WORD ADDRESS LDB RQB+DISP GET TO # SEC/TRACK ADB D6 LDA B,I GET # OF SECTORS/TRACK STA RQB+SCTRK SAVE AS # OF SECTORS/TRACK ADB D2 GET TO # OF DIRECTORY TRACKS LDA B,I ADA RQB+WTRCK GET ENDING DIRECTORY TRACK STA RQB+NTRKS LDA B,I GET # OF DIRECTORY TRACKS CMA,INA MAKE # POS. JSB BNDEC CONVERT TO ASC DEF DTRKA LDA DTRKA+2 MOVE UP THE LEAST SIGNIFICANT DIGITS STA DTRKA THEY ARE THE ONLY ONES TO BE PRINTED LDA #NODE IDENTIFY THE JSB BNDEC NODE WHICH IS DEF NODE BEING LISTED. JSB WTLIN SEND LINE TO TERMINAL DEF HEAD1 FIRST HEADING LINE SPC 5 * * HERE AFTER FIRST HEADING LINE WRITTEN * SUB3 LDA SUB4A GET ADDRESS WHERE TO GO NEXT TIME STA RQB+BROUT LDB D17 NON-SECURITY HEADER LENGTH. LDA RQB+MCODF SZA SECURITY CODES BEING LISTED? LDB D20 YES, ADD "SCODE" TO HEADER STB HEAD2 JSB WTLIN SEND OUT SEND HEADING LINE DEF HEAD2 SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE * SUB5 LDA SUB3A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL SPC 5 * * HERE TO START OUTPUTTING DIRECTORY * SUB4 LDA RQB+DISP GET FILE ENTRY ADA D16 JSB SCFX SEE IF WE NEED NEW SECTOR JMP SUB2 DONE...NO MORE DIRECTORY LDA RQB+DISP,I IS THIS FILE PURGED? SSA JMP SUB4 YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU JSB MDLIN MOVE LINE IF IT PASSES THRU FILTER JMP SUB4 LINE FILTERED OUT. GET NEXT ENTRY JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL * * HERE TO DO A CARTRIDGE LIST * SUB8 LDA SUB9A GET ADDRESS FOR NEXT TIME. STA RQB+BROUT LDA #NODE IDENTIFY THE NODE JSB BNDEC WHOSE CARTRIDGE LIST DEF CLNOD IS BEING PROCESSED. JSB WTLIN OUTPUT THE DEF CLHED CARTRIDGE-LIST HEADER. SPC 2 * * HERE TO OUTPUT A SEPARATING BLANK LINE. * SUB9 LDA SB10A GET ADDRESS FOR FIRST LINE STA RQB+BROUT SET COROUTINE POINTER. JSB WTLIN OUTPUT A DEF BLNKL BLANK LINE. SPC 2 * * PROCESS THE CARTRIDGE-LIST ENTRY. * SUB10 LDA RQB+LUDSP,I GET THE CARTRIDGE LOGICAL UNIT. ISZ RQB+LUDSP ADVANCE THE ENTRY-POINTER. JSB BNDEC CONVERT THE LU DEF DTYPA TO IT'S ASCII EQUIVALENT. LDA DTYPA+2 GET THE TWO USEFUL ASCII DIGITS. STA LU CONFIGURE THE LINE. LDA RQB+LUDSP,I GET LAST TRACK FOR THE CARTRIDGE. ISZ RQB+LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT LAST TRACK TO ASCII, DEF LTRK AND CONFIGURE THE LINE. LDA RQB+LUDSP,I GET THE CARTRIDGE NUMBER. ISZ RQB+LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT CARTRIDGE NO. TO ASCII, DEF CART AND CONFIGURE INTO MESSAGE. LDB CLEN1 PREPARE FOR UNLOCKED LINE LENGTH. LDA RQB+LUDSP,I GET LOCK FLAG (I.D. SEG. ADDR.) ISZ RQB+LUDSP BUMP POINTER. SZA,RSS IF IT'S NOT LOCKED, JMP SNDLN THEN COMPLETE THE LINE; ADA D12 ELSE, POINT TO PROGRAM NAME, CLE,ELA AND FORM ITS BYTE ADDRESS. LDB CLKBA GET CONFIGURED MES(SAGE BYTE ADDRESS. JSB .MBT MOVE THE LOCKER'S NAME TO THE LINE. DEF D5 NOP LDB CLEN2 GET LOCKED-CARTRIDGE LINE LENGTH. SNDLN STB CLINE CONFIGURE THE LINE LENGTH. LDB SUB2A SET FOR RETURN VIA RELOAD SECTION. LDA RQB+LUDSP,I IF THE NEXT ENTRY SZA,RSS IS NULL, THE LIST IS COMPLETE, SO LDB SB11A SET RETURN TO WRAP-UP SECTION; STB RQB+BROUT ESTABLISH THE COROUTINE POINTER. STB RQB+FLTR+1 SET FLAG FOR CLIST CONTINUATION. JSB WTLIN SEND THE CONFIGURED LINE DEF CLINE TO THE REMOTE NODE. * SUB11 LDA DON1A SEND A STA RQB+BROUT BLANK LINE, JSB WTLIN AND RETURN DEF BLNKL TO THE END PROCESSOR. * CLEN1 DEC 11 CLEN2 DEC 15 CLKBA DBL LOCK * CLHED DEC 24 ASC 14, LU LAST TRACK CR LOCK ASC 7, REMOTE NODE= CLNOD ASC 3, * CLINE NOP ASC 1, LU ASC 1, ASC 2, LTRK ASC 3, ASC 1, CART ASC 3, ASC 1, LOCK ASC 3, * HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * SUBROUTINE TO MOVE DETAIL LINE TO PRINT LINE * CALLING SEQUENCE * JSB MDLIN * NO MATCH RETURN...IE..FILTER MIS-MATCH,TYPE NO MATCH * NORMAL RETURN * SPC 1 MDLIN NOP LDA RQB+FLTR IS FILTER SPECIFIED SZA NO CPA SPACA OR IS IT ALL SPACE? JMP NDLN2 NOT SUPPLIED OR SPACE JSB .DRCT GET ADDRESS WHERE FILTER LOCATED DEF RQB+FLTR CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP SAVE FILTER BYTE ADDRESS LDA RQB+DISP GET ADDRESS OF NAME CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE IN BYTE ADD COUNTER LDA M6 # OF CHAR IN FILTER STA TEMP2 SAVE IN DOWN COUNTER MDN11 LDB TEMP GET BYTE ADD OF FILTER JSB .LBT GET BYTE SZA,RSS IF ZERO, CHANGE TO SPACE LDA C40 C40=SPACE CPA FLTRC IS IT A "-"?  JMP MDN12 YES...DON'T CHECK STA TEMP3 SAVE IN TEMP LOCATION LDB TEMP1 GET BYTE ADDRESS OF NAME JSB .LBT GET BYTE CPA TEMP3 IS THERE A MATCH? RSS YES JMP MDLIN,I NO...IGNORE ENTRY MDN12 ISZ TEMP GET TO NEXT ENTRY ISZ TEMP1 ISZ TEMP2 DONE? JMP MDN11 NO SPC 1 * * AFTER CHECKING NAME, CHECK TYPE * NDLN2 LDB RQB+DISP GET TO FILE TYPE ADB D3 LDB B,I LDA RQB+FTYP CHECK WITH FILE TYPE PASSED RAL,CLE,ERA IS THERE A FILE TYPE? SEZ FILE TYPE SPECIFIED CPA B YES...DOES IT MATCH RSS MATCH...OR NO FILE TYPE SPECIFIED JMP MDLIN,I FILE TYPE NOT MATCHED ISZ MDLIN SET FOR NORMAL (P+2) RETURN. LDA DLLS ESTABLISH LINE LENGTH STA DLINA FOR LINE SANS SECURITY CODE. STB FTYPT SAVE FILE TYPE, TEMPORARILY. LDA B GET FILE TYPE FOR CONVERSION. JSB BNDEC CONVERT FILE TYPE TO ASC DEF DTYPA LDA RQB+DISP MOVE NAME TO OUTPUT LINE LDB ADNAM GET DESTINATION ADDRESS JSB .MVW MOVE NAME DEF D3 NOP LDA RQB+DISP GET # OF SECTORS OR LU ADA D4 ASSUME LU LDB FTYPT SEE IF TYPE=0 SZB YES? ADA D2 NO...GET # OF SECTORS LDA A,I GET VALUE SZB,RSS LU? JMP CNVRT YES, DON'T DIVIDE BY 2 SSA NEG BLOCK COUNT? CMA,INA,RSS YES, MAKE POS & SKIP DIV BY 2 CLE,ERA CONVERT TO # OF BLOCKS CNVRT JSB BNDEC CONVERT TO ASC DEF DBSLU LDA BLNK4 BLANK OUT THE LDB OPNAD 'OPEN TO' / EXTENT NO. JSB .MVW INFORMATION FIELD. DEF D4 NOP LDA FTYPT GET THE FILE TYPE. SZA,RSS IF THE TYPE IS ZERO, JMP OPNFL DON'T WORRY ABOUT EXTENTS. LDB RQB+DISP GET THE ADB D5 EXTENT WORD CLE,ELB FROM THE UPPER BYTE JSB .LBT OF THE DIRECTORY ENTRY. SZA,RSS IF NOT AN EXTENT, THEN JMP OPNFL CHECK THE OPEN FLAGS; JSB BNDEC ELSE, CONVERT EXTENT NO., OPNAD DEF DXOPN AND ADD IT TO THE LINE. LDA EXTBA GET BYTE ADDR. OF EXTENT DELIMITER. LDB EXNBA GET BYTE ADDR. OF DELIMITER BUFFER. JSB .MBT MOVE ' +' TO CONFIGURED LINE. DEF D3 NOP JMP SCODP IGNORE OPEN FLAGS FOR EXTENTS. OPNFL LDA RQB+DISP GET THE ADA D9 OPEN FLAG LDA A,I FROM THE ENTRY. * IFZ * START RTE-M/L CODE LDB $OPSY CHECK OPSYS TYPE CPB M31 RTE-L? JSB #IDAD YES, CONVERT OPEN-FLAG FORMAT XIF * END RTE-M/L CODE * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB,RSS PRE-RTE4B SYSTEM? JMP OPNF1 NO LDB A YES, SAVE OPEN FLAG AND BT15 ISOLATE OPEN FLAG STA DTEMP SAVE EXCLUSIVE BIT LDA B RETRIEVE FLAG AND RTBYT ISOLATE ID SEG # SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. LDB KEYWD CALCULATE POINTER ADB M1 TO ID SEGMENT ADB A ADDRESS. LDA B,I GET ID SEG ADR IOR DTEMP INCLUDE EXCLUSIVE BIT XIF * END RTE CODE * OPNF1 SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. CLE,ELA SAVE EXCLUSIVE FLAG, ADA D24 AND FORM I.D. SEG WD#13 BYTE ADDRESS. LDB OPNBA GET BYTE ADDR. FOR CONFIGURED LINE. JSB .MBT MOVE PROGRAM NAME INTO LINE. DEF D5 NOP LDA C55 IF IT IS EXCLUSIVE, THEN SEZ USE ' -' AS A DELIMITER, AND JSB .SBT ADD THE DELIMITER TO THE LINE. SCODP LDB RQB+MCODF SUPPLY SECURITY CODE? ,SZB,RSS JMP MDLIN,I NO...RETURN. LDA DLLWS ESTABLISH LINE LENGTH STA DLINA FOR LINE WITH SECURITY CODE. LDA RQB+DISP GET THE ADA D8 SECURITY CODE LDA A,I FROM THE ENTRY. JSB BNDEC CONVERT TO ASCII, DEF DSECA AND CONFIGURE INTO LINE. JMP MDLIN,I RETURN. SPC 1 FTYPT NOP D5 DEC 5 D9 DEC 9 D12 DEC 12 D16 DEC 16 D20 DEC 20 DLLS EQU D16 DLLWS EQU D20 D24 DEC 24 BLNK4 DEF BLNKL+1 BLPLS ASC 2, + EXTBA DBL BLPLS EXNBA DBL DXOPN OPNBA DBL DXOPN+1 KEYWD EQU 1657B KEYWORD BLOCK ADR RTBYT OCT 377 BT15 OCT 100000 SPC 5 * * HERE FOR REMOTE SESSION '#ATCH' ERROR * * IFN * START RTE CODE RSERR DLD RS01 SET "RS01" INTO STA RQB+#EC1 #EC1 & #EC2 OF STB RQB+#EC2 REPLY. LDA #NODE GET LOCAL NODE # IOR BT15 SET ASCII-ERROR BIT STA RQB+#ENO SET INTO REPLY JMP DONE1 GO RETURN TO USER * * RS01 ASC 2,RS01 XIF * END RTE CODE * SPC 5 * * HERE WHEN WE ARE ALL DONE * DONE LDA RQB+BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA RQB+BROUT JSB WTLIN SEND "DISK NOT MOUNTED" DEF NOCRM * DONE1 CLA STA RQB+LNGH SET FOR NO DATA LDA BIT14 TELL OTHER SIDE, ALL DONE JMP TERM SPC 5 * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * * BUFFER FORMAT: * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDB WTLIN,I GET LENGTH OF MESSAGE LDB B,I LDA RQB+LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE IF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH?U& STB RQB+LNGH YES...SET IN CORRECT LENGTH * CLA SET FOR MORE TO COME TERM STA RQB+STAT SAVE STATUS LDA RQB+STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA RQB+STYP LDA #NODE STA RQB+#ENO SET STATUS LOCATION * JSB #SLAV SEND REPLY DEF *+4 DEF L#REP REPLY LENGTH WTLNB NOP DATA ADDRESS DEF RQB+LNGH DATA LENGTH * NOP IGNORE ERROR RETURN JMP DLST0 GO DO A GET CALL * SPC 5 * * SUBROUTINE TO KEEP DISPLACEMENT ON DISK OK * CALLING SEQUENCE * JSB SCFX * NO MORE DIRECTORY TRACK RETURN * NORMAL RETURN * A REG=DISPLACEMENT * UPON RETURN * WILL UPDATE WTRCK,WSEC,AND DISP AS REQUIRED * ASSUMES DISP STARTS WITH ADDRESS OF BUFFER * SCTRK MUST BE SET TO # OF SECTORS/TRACK * IF TRACK CHANGES, NTRCK=LAST DIRECTORY TRACK-1 * ALL SECTORS ARE ASSUMED TO BE 128 WORDS LONG * SPC 1 SCFX NOP CMA,INA NEGATE ADDRESS ADA DBFA1 GET DISPLACEMENT CMA,INA MAKE IT POSITIVE CLB CHECK IF OVERFLOW DIV D128 CROSS A SECTOR BOUNDRY ADB DBFA1 GET DISPLACEMENT AS AN ADDRESS STB RQB+DISP SAVE DISPLACEMENT ADDRESS SZA,RSS SECTOR CHANGE JMP SCFXA NO LDA D14 YES...GET TO NEXT SECTOR ADA RQB+WSEC GET TO NEXT SECTOR ADDRESS CLB DIV RQB+SCTRK SEE IF WE HAVE LOOPED AROUND STB RQB+WSEC SAVE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB NO NEW TRACK NEEDED JMP SCFXA DON'T UPDATE TRACK ADDRESS CCB UPDATE TRACK ADDRESS ADB RQB+WTRCK GET TO NEXT TRACK CPB RQB+NTRKS DONE? JMP SCFX,I YES STB RQB+WTRCK NO...SET IN NEW TRACK ADDRESS SCFXA LDA DBFA1 DO A 128 WORD READ JSB GETSC ISZ SCFX GET TO RETURN JMP SCFX,I RETURN SPC 5 O * * SUBROUTINE TO READ A PHYSICAL SECTOR (128 WORDS) * * CALLING SEQUENCE: * * LDA * JSB GETSC * * THE FOLLOWING MUST BE SET UP: * * WTRCK,WSEC,WCLU * GETSC NOP STA BUFAD SAVE BUFFER ADR LDA RQB+FLTR IF A CARTRIDGE LISTING CPA M1 IS CURRENTLY IN PROGRESS, JMP GTSC1 FORCE A RELOAD OF THE SECTOR. LDA RQB+WTRCK GET CURRENT TRACK ADDRESS CPA CTRCK SAME AS ONE WE GOT NOW? RSS YES JMP GTSC1 NO...GO READ IT LDA RQB+WSEC IS IT THE SAME SECTOR CPA CSEC ? RSS YES JMP GTSC1 NO...GO READ IT LDA RQB+WCLU SAME LU? CPA CCLU JMP GETSC,I YES...DON'T READ SECTOR GTSC1 LDA RQB+WCLU SET UP AS CURRENT STA CCLU * IFZ * START RTE-M/L CODE LDB $OPSY CHECK SYSTEM TYPE CPB M31 RTE-L? IOR C7700 YES, SET CONWD FOR DISC ACCESS XIF * END RTE-M/L CODE * STA TEMP SAVE CONWD FOR EXEC CALL LDA RQB+WTRCK STA CTRCK LDA RQB+WSEC STA CSEC * JSB EXEC GO READ A SECTOR DEF *+7 DEF D1 DEF TEMP CONWD BUFAD NOP DEF D128 DEF RQB+WTRCK DEF RQB+WSEC JMP GETSC,I GOT SECTOR, RETURN SPC 2 CTRCK OCT -1 CSEC OCT -1 CCLU OCT -1 BUFL NOP SPC 5 * * SUBROUTINE CONVERT BINARY TO ASCII DECIMAL * CALLING SEQUENCE * JSB BNDEC * DEF BUFFER WHERE TO ASC * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M5 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER LDA C40 GET stA SPACE CHARACTERR LDB DTEMP GET BINARY VALUE SSB,RSS IF NEGATIVE...CONVERT JMP BNDCB NOT NEGATIVE CMB,INB NEGATIVE, MAKE POSITIVE STB DTEMP LDA C55 SET IN NEG SIGN BNDCB LDB DTMP1 GET BYTE ADDRESS JSB .SBT SAVE SIGN ISZ DTMP1 GET NEXT BYTE ADDRESS BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS JSB .SBT SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 C55 OCT 55 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM DNM DEC 10000,1000,100,10,1 C40 OCT 40 C60 OCT 60 C7700 OCT 7700 D3 DEC 3 D8 DEC 8 D14 DEC 14 D17 DEC 17 D128 DEC 128 D4 DEC 4 D1 EQU DNM+4 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 M2 DEC -2 M5 DEC -5 M6 DEC -6 BIT14 OCT 40000 FLTRC EQU C55 "DON'T-CARE" FILTER CHAR (MINUS SIGN) TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP * TATSD EQU 1756B SECT2 EQU 1757B DBFA1 DEF DBUF IFN * START RTE CODE DBFAD DEF DBUF MAY BE MODIFIED AT INIT D253 DEC 253 XIF * END RTE CODE MSCA DEF DBUF+126 @MSC. MAY BE MODIFIED AT INIT CLSSN NOP CRNAA DEF CRNA ADNAM DEF DNAMA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 DEC 34 SPACA ASC 1, ASC 3,ILAB= CRNA ASC 3, ASC 1, ASC 10,REMOTE DLIST: NODE= NODE ASC 3, ASC 1, ASC 2,CR#= LWA ASC 3, ASC 1, ASC 5,DIR TRKS= DTRKA ASC 3, SPC 1 HEAD2 NOP ASC 20, NAME TYPE #BLKS/LU OPEN TO SCODE SPC 1 NOCRM DEC 9 ASC 9, DISK NOT MOUNTED DLINA NOP ASC 1, DNAMA ASC 3, ASC 1, DTYPA ASC 3, Z`^ZASC 1 DBSLU ASC 3, DXOPN ASC 4, ASC 1, DSECA ASC 3, SPC 2 BLNKL DEC 1 OCT 20040,20040,20040,20040 * DBUF EQU * IFN * START RTE CODE BSS 256 XIF * END RTE CODE IFZ * START RTE-M/L CODE BSS 128 M31 DEC -31 XIF * END RTE-M/L CODE SPC 3 END EQU * END DLIST ` ) 91750-18074 2013 S C0122 &DMESG              H0101 wASMB,R,Q,C HED DMESG 91750-1X074 REV 2013 * (C) HEWLETT PACKARD CO. 1980 NAM DMESG,7 91750-1X074 REV.2013 800414 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT DMESG EXT DEXEC,#RQB,.ENTR,#NODE,CNUMD,.MVW * RQB EQU #RQB * * NAME: DMESG * SOURCE: 91750-18074 * RELOC: PART OF 91750-12002 * PGMR: JIM HARTSELL, ET AL * * * TELLOP MESSAGE SUBROUTINE * * LIBRARY SUBROUTINE APPENDED TO RTE USER PROGRAM THAT SENDS * MESSAGES TO THE SYSTEM CONSOLE AT THE GIVEN DESTINATION NODE. * * CALLING SEQUENCE: * JSB DMESG * DEF *+4 * DEF DESTINATION * DEF BUFFER * DEF BUFFER LENGTH (MAX = +36 WORDS OR -72 BYTES) * RETURN--A&B CONTAIN ASCII ERROR CODE IF ANY; * OTHERWISE A & B ARE BOTH ZERO. * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP SUP A EQU 0 * * GET MESSAGE ADDRESS AND LENGTH. * DEST NOP BUFAD NOP BUFL NOP DMESG NOP JSB .ENTR GET PRAM ADDRESS DEF DEST LDB BUFL,I GET LENGTH SSB POSITIVE WORD COUNT? JMP DMES1 NO, TREAT AS BYTE COUNT BLS CONVERT LNGT IN WORDS TO CMB,INB,SZB,RSS LNGT IN (-) BYTES JMP LENER ERROR IF ZERO OR NOT PASSED DMES1 CLA STA BUFL INITIALIZE FOR NEXT TIME STB A ADA N18 ADJUST ACTUAL BUFFER LENGTH STA LNGT SAVE FOR THE "DEXEC" CALL ADA K9O 0 NOW MAKE SURE ORIGINAL LNGT SSA WASN'T > 80 CHARACTERS JMP LENER IT WAS! ERROR CMB,INB INB CONVERT TO WORD COUNT BRS FOR THE "MVW" STB MVLEN * * MOVE MESSAGE TO INTERNAL BUFFER. * LDA BUFAD GET ORIGIN ADDRESS LDB DFOUT GET DESTINATION ADDRESS JSB .MVW MOVE THE BUFFER DEF MVLEN NOP * JSB CNUMD CONVERT NODE NUMBER TO ASCII DEF *+3 DEF #NODE DEF OUTBF+5 * LDA OUTBF+6 IOR "00" STA OUTBF+6 LDA OUTBF+7 IOR "00" STA OUTBF+7 * * SEND THE MESSAGE WITH ID PREFIX. * JSB DEXEC DEF *+6 DEF DEST,I DEF D2I WRITE-NO ABORT DEF B1 DEF OUTBF DEF LNGT * JMP DMESG,I RETURN TO CALLER WITH ERROR IN A & B. CLA NO ERROR--CLEAR CLB REGISTERS. JMP DMESG,I RETURN SPC 2 LENER DLD DS03 STORE ASCII ERROR DST RQB+#EC1 IN MESSAGE BUFFER LDA #NODE FOR POSSIBLE "DSERR" CALL. IOR BIT15 STA RQB+#ENO DLD DS03 RETURN WITH ASCII ERROR JMP DMESG,I CODE IN A & B REG. * * * CONSTANTS AND WORKING STORAGE. * MVLEN NOP LNGT NOP B1 OCT 1 D2I OCT 100002 B3 OCT 3 BIT15 OCT 100000 K90 DEC 90 N18 DEC -18 DS03 ASC 2,DS03 "00" ASC 1,00 DFOUT DEF OUTBF+9 OUTBF ASC 9,(FROM NODE XXXXX): BSS 36 * SIZE EQU * END   91750-18075 2013 S C0122 &DMESS              H0101 ASMB,R,Q,C HED DMESS 91750-1X075 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM DMESS,7 91750-1X075 REV.2013 800414 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT DMESS * EXT #MAST,#RQB,.ENTR,.MVW,#NODE * RQB EQU #RQB * * NAME: DMESS * SOURCE: 91750-18075 * RELOC: PART OF 91750-12002 * PGMR: JIM HARTSELL, ET AL * * * DMESS IS A UTILITY SUBROUTINE WHICH IS USED TO SEND OPERATOR * COMMANDS TO A REMOTE CPU. * * CALLING SEQUENCE: * * JSB DMESS * DEF *+4 * DEF * DEF * DEF (IN + BYTES) * * * ON RETURN, THE REGISTERS HAVE THE FOLLOWING MEANING: * * = 0 NO RESPONSE FROM REMOTE * < 0 NEGATIVE OF NUMBER OF BYTES IN RESPONSE * = -1 INDICATES AN ERROR * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ******************************************************************* * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP SUP * NODE NOP DESTINATION BUFAA NOP MESSAGE BUFFER BUFLA NOP MESSAGE LENGTH DMESS NOP START OF ROUTINE JSB .ENTR DEF NODE GET PRAMS * LDB RQB+#CML BLOCK "XX" COMMANDS CPB D2 (USED FOR REMOTE RSS SESSION LOG-ON/OFF). JMP DMES1 LDB RQB+#CMS CLA CPB "XX" JMP EXIT * DMES1 CLA INITIALIZE MESSAGE BUFFER STA RQB+#EC1 ERROR VALUES. STA RQB+#EC2 STA RQB+#ENO * LDA D7 REMOTE - GET STREAM TYPE STA RQB+#STR AND PUT IT INTO REQUEST LDA BUFLA,I GET REQUEST LENGTH STA RQB+#CML SAVE IN REQUEST ADA DM41 SSA,RSS CHECK FOR ILLEGAL MESSAGE LENGTH JMP SZERR TOO LONG LDA RQB+#CML SSA NEGATIVE ? JMP SZERR YES, ILLEGAL CLB NO ERROR INDICATION FOR IMMEDIATE RETURN SZA,RSS NOTHING ? JMP DMESS,I IMMEDIATE RETURN CLE,ERA TRANSFORM INTO NUMBER SEZ OF WORDS INA TO COMPUTE REQUEST LENGTH STA LNG1 SAVE FOR REQUEST MOVE ADA L#CML ADD STANDARD REQ LENGTH STA LEN LDA BUFAA GET BUFFER ADDRESS LDB MESSA GET DESTINATION ADDRESS JSB .MVW MOVE STRING INTO REQUEST DEF LNG1 NOP * LDA NODE,I GET DESTINATION STA RQB+#DST SET IN REQUEST * JSB #MAST WRITE REQUEST [TO REMOTE DEF *+7 DEF BIT15 CONTROL WORD DEF LEN DEF D0 DEF D0 NO DATA ASSOCIATED DEF D0 NO DATA ASSOCIATED DEF C#OLW MAX REPLY LENGTH * JMP MSERR ERROR RETURN POINT CLB NO ERROR INDICATION LDA RQB+#RLN ANY RETURN MESSAGE? SZA,RSS JMP DMESS,I NO RETURN MESSAGE LDA MESSB GET ADDRESS OF MESSAGE TO BE RETURNED LDB BUFAA GET ADDRESS OF USER'S BUFFER. JSB .MVW MOVE THE REPLY TO THE USER'S BUFFER DEF RQB+#RLN NOP LDA RQB+#RLN GET LENGTH OF MESSAGE CLE,ELA MAKE THAT # OF BYTES CMA,INA NEGATE EXIT CLB JMP DMESS,I AND RETURN SPC 2 SZERR DLD "DS03 ILLEGAL COMMAND LENGTH. DST RQB+#EC1 STORE ASCII ERROR CODE LDA #NODE IN MESSAGE BUFFER IOR BIT15 FOR "DSERR". STA RQB+#ENO LDA "DS03 RESTORE (A). * MSERR DST BUFAA,I SAVE ERROR CODES FOR USER'S ANALYSIS. LDA D4 RETURN WITH = -4, AND = -1, CMA,INA TO INDICATE 4-BYTE ERROR-CODE MESSAGE. * CCB SET B TO -1 JMP DMESS,I AND RETURN SPC 2 * MESSA DEF RQB+#CMS MESSB DEF RQB+#MSG C#OLW ABS #OLW L#CML ABS #CML+1 DM41 DEC -41 D0 DEC 0 D2 DEC 2 D7 DEC 7 D4 DEC 4 "XX" ASC 1,XX "DS03 ASC 2,DS03 LNG1 NOP LEN NOP BIT15 OCT 100000 * END VP  91750-18076 2013 S C0122 &DSERR              H0101 ASMB,R,L,C HED DS/1000 ERROR ROUTINE * (C) HEWLETT-PACKARD 1980 NAM DSERR,7 91750-1X076 REV 2013 791201 ALL ENT DSERR EXT #RQB RQB EQU #RQB EXT .ENTR,.MBT,.SBT SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * SUBROUTINE TO RETURN DS ERROR PARAMETERS (DS/1000 REQUESTS ONLY) * * CALLING SEQUENCE: * * CALL DSERR(IERBUF[,NODER[,LQLFR]]) * * RETURNED VALUES: * * IERBUF MUST BE AN INTEGER ARRAY OF AT LEAST 24 WORDS. * UPON RETURN, IT WILL CONTAIN A MESSAGE OF THE FORM: * DS ERROR: XXXXXXXX(QQ), REPORTED BY NODE NNNNN * WHERE THE XXXXXXXX FIELD MAY CONTAIN EITHER THE ASCII OR NUMERIC * (CONVERTED TO ASCII) ERROR CODE. * * QQ = ERROR CODE QUALIFIER * NNNNN = NODE NUMBER REPORTING THE ERROR. * * NODER = (RETURNED) REPORTING NODE NUMBER (POSITIVE INTEGER) * (OPTIONAL) * * LQLFR = (RETURNED) QUALIFIER CODE (POSITIVE INTEGER) * (OPTIONAL) * * SAMPLE ERROR MESSAGES * ----------- * DS ERROR: DS08(0), REPORTING NODE 7 * DS ERROR: IO04(1), REPORTING NODE 23 * DS ERROR: RS-33(12), REPORTING NODE 9 * DS ERROR: RF-32(0), REPORTING NODE 1 SPC 2 * * OPERATION: * * 1) FOLLOWING ANY DS OPERATION IN WHICH AN ERROR HAS OCCURRED * (REGARDLESS OF THE LEVEL AT WHICH THE ERROR WAS DETECTED), * INFORMATION DESCRIBING THE CAUSE OF THAT ERROR IS PLACED IN * A PORTION OF THE REQUEST BUFFER LABELLED #RQB, AT AN OFFSET * GIVEN BY #EC1, #EC2, #ENO AND #ECQ, BY #MAST AND/OR THE Ϭ* MASTER ROUTINE. * * 2) UPON BEING CALLED, DSERR FETCHES THIS INFORMATION * CONVERTS IT INTO VARIOUS FIELDS OF A LOCAL MESSAGE BUFFER, * THEN MOVES THIS BUFFER INTO THE USER'S MESSAGE BUFFER. * * THE REPORTING NODE NUMBER AND QUALIFIER ARE RETURNED TO * THE CALLER, IF PARAMETERS FOR THEM ARE SPECIFIED. * * THE NODE NUMBER IS ALWAYS RETURNED AS A POSITIVE INTEGER. * * NOTES: 1) RESULTS MEANINGLESS UNLESS AN ERROR HAS BEEN DETECTED * FOLLOWING A DS/1000 SUBROUTINE CALL. * 2) RECOMMENDED PROCEDURE FOR PROGRAMMERS, FOR ALL DS/1000 * REQUESTS, REGARDLESS OF TYPE, IS TO MAKE THE REQUEST, CHECK * FOR AN ERROR, AND IF NONE THEN CONTINUE. OTHERWISE, * CALL DSERR TO OBTAIN COMPLETE INFORMATION ABOUT THE * ERROR. SKP * GLBLK-START ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP ERBUF NOP NODER NOP QLFR NOP DSER. EQU * DSERR NOP JSB .ENTR DEF ERBUF LDB ERBUF CLE,ELB BYTE ADDRESS STB ERBUF * * GET #EC1 AND #EC2 * LDA RQB+#EC1 STA MSG+5 LDA RQB+#EC2 (ASSUME ASCII) STA MSG+6 LDA RQB+#ECQ MOVE QUALIFIER AND NODE NUMBER STA QUAL TO ALLOW REQUEST BUFFER LDA RQB+#ENO TO BE OVERWRITTEN STA NODE LDA B SETUP DEFAULT FIELD 1 ADA D14 TERMINATING STA @FLD1+1 ADDRESS * * MOVE PARTIALLY COMPLETE MSG TO USERS AREA * LDA @MSG JSB .MBT DEF MSGLN NOP * * SEE IF EC2 NUMERIC, IF SO CONVERT IT * LDA NODE TEST SIGN OF NODE SSA NUMERIC? JMP GETQ . NO LDA MSG+6 (#EC2) LDB .EC2 = OFFSET OF EC2 JSB DECML STB @FLD1+1 SAVE ACTUAL TERMINATING ADDRESS * * GET QUALIFIER IF ANY * GETQ LDB QUAL LSL 8 ISOLATE QUALIFIER BITS (4-7) LSR 12 LDA B STA QLFR,I RETURN QUALIFIER LDB .QUAL = OFFSET FOR QUALFIER OUTPUT JSB DECML STB @FLD2+1 SAVE TERMINATING ADDRESS * * GET REPORTING NODE NUMBER * LDA NODE ELA,CLE,ERA CLEAR SIGN BIT STA NODER,I RETURN NODE NUMBER LDB .NODE = OFFSET FOR NODE OUTPUT JSB DECML * * COMPRESS MESSAGE * DLD @FLD2 ADA ERBUF CHANGE OFFSET TO ADDRESS JSB .MBT DEF @FLD2+2 NOP DLD @FLD1 ADA ERBUF CHANGE OFFSET TO ADDRESS JSB .MBT DEF @FLD1+2 NOP JMP DSERR,I AND RETURN SKP * * DECML- CONVERTS BINARY TO DECIMAL (LEFT JUST) * = BINARY = OFFSET INTO MSG * DECML NOP ADB ERBUF CONVERT OFFSET TO (BYTE) ADDRESS STA NBR SSA,RSS NEGATIVE NUMBER? JMP DEC1 . NO CMA,INA STA NBR SSA SPECIAL LOW NUMBER (-32768)? JMP DEC4 . YES LDA DASH JSB .SBT DEC1 STB ADR SAVE OUTPUT POINTER LDA DTBL STA D D --> DIVISOR TABLE LDA DM4 STA CTR STA FLAG CLEAR OUTPUT FLAG (SET TO 1) * DEC2 LDB NBR LSR 16 DIV D,I ISZ D STB NBR REMAINDER SZA OUTPUT OTHER THAN ZERO? JMP *+4 . YES OUTPUT IT LDB FLAG SSB OK TO OUTPUT? JMP DEC3 . NO FINISH LOOP IOR "0" STA FLAG SET OUTPUT FLAG (BIT15=0) LDB ADR --> OUTPUT FIELD JSB .SBT STB ADR SAVE OUTPUT FIELD DEC3 ISZ CTR JMP DEC2 * LDA NBR := ONES DIGIT LDB ADR --> OUTPUT IOR "0" JSB .SBT JMP DECML,I AND RETURN * DEC4 LDA @32K MOVE IN -32768 JSB .MBT DEF D6 NOP JMP DECML,I SPC 2 @32K DBL *+1 ASC 3,-32768 DTBL DEF *+1 DEC 10000  DEC 1000 DEC 100 DEC 10 * DM4 DEC -4 D6 DEC 6 "0" OCT 60 DASH ASC 1,-- * CTR BSS 1 FLAG BSS 1 BIT15=1 NO OUTPUT; BIT15=0 OUTPUT D BSS 1 ADR BSS 1 NBR BSS 1 SKP A EQU 0 B EQU 1 * * CHAR OFFSET OF DATA FIELDS .EC2 DEC 12 .QUAL DEC 19 .NODE DEC 39 * FIELD DATA FOR COMPRESSION OF MSG @FLD1 DEC 18 OFFSET OF MAX FIELD POSITION+1 BSS 1 ACTUAL ADDRESS OF MAX POSITION+1 DEC 30 CHARACTERS TO MOVE @FLD2 DEC 21 BSS 1 DEC 27 @MSG DBL *+1 MSG ASC 12,DS ERROR: DDXXXXXX(QQ), ASC 12,REPORTING NODE N MSGLN DEC 48 D14 DEC 14 QUAL BSS 1 NODE BSS 1 SIZE EQU * END 7  ! 91750-18077 2013 S C0122 &DS1NF +              H0101 mASMB,Q,C,N HED DSINF: DS/1000 INFORMATION * (C) HEWLETT-PACKARD CO. IFN NAM DSINF,19,65 91750-16077 REV.2013 800612 MEF EXT DEXEC,D#OPS XIF IFZ NAM DSINF,19,65 91750-16078 REV.2013 800612 MEF XIF SPC 1 SUP A EQU 0 B EQU 1 EXT $LIBR,$LIBX,$OPSY,PARSE,KCVT,CNUMO,CNUMD EXT XLUEX,EXEC,RMPAR,$CLAS,$RNTB,.DFER,PGMAD EXT .MVW,.MBT,.CBT,.LAX,.LDX,.ISX,.CAX,.DSX SPC 1 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: DSINF *SOURCE: 91750-18077 * RELOC: 91750-16077 (N OPTION) 91750-16078 (Z OPTION) * PGMR: DMT LST ******************************************** * * * NAME: DSINF (DS INFORMATION) * * * * SOURCE: 91750-18077 * * * * RELOCATABLE: 91750-16077 (N-OPTION) * * 91750-16078 (Z-OPTION) * * * * PROGRAMMER: DAVID TRIBBY * * * * DATE: APRIL 1977 * * * ******************************************** SPC 3 * THE ORIGINAL CODE FOR THIS PROGRAM WAS WRITTEN IN HP ALGOL. * MODIFICATIONS HAVE BEEN INTRODUCED SINCE TRANSLATION TO * ASSEMBLY LANGUAGE! SPC 3 * ASSEMBLY OPTIONS: * N 1000-1000 AND 1000-3000 VERSION * Z 9 1000-3000 ONLY (NO DEXEC, NRV, MA, OR REROUTING) SKP *RUN FROM RTE WITH * RU,DSINF,,,,, *THE RUN-TIME PARAMETERS HAVE THESE MEANINGS: * * THE LOGICAL UNIT NUMBER OF THE INPUT DEVICE. THE DEFAULT * IS THE NUMBER OF THE SCHEDULING TERMINAL PASSED BY M-T-M * OR 1. IF THE INPUT DEVICE IS INTERACTIVE A PROMPT IS * PRINTED ON THE DEVICE BEFORE EACH READ. * * THE LOGICAL UNIT NUMBER OF THE DEVICE WHERE INFORMATION IS * PRINTED. THE DEFAULT IS THE INPUT LU (IF INTERACTIVE) OR 6. * * A CONTROL WORD WHICH SPECIFIES DSINF WILL BE RUN NON- * INTERACTIVELY. THE FUNCTIONS WHICH TAKE PLACE ARE * DETERMINED BY THE BITS SET: * * DECIMAL * VALUE PRINT THIS INFORMATION * ------- ------------------------------ * 1 AVAILABLE MEMORY SUSPEND LIST * 2 I/O CLASSES * 4 DS/1000 VALUES * 8 DUMP OF SAM BLOCK * 16 DS/1000 LISTS * 32 NODAL ROUTING VECTOR (N OPTION ONLY) * 64 DS/1000 EQT ENTRIES * 128 MESSAGE ACCOUNTING (N OPTION ONLY) * 256 REROUTING (N OPTION ONLY) * 512 REMOTE SESSIONS * * FOR EXAMPLE, TO PRINT THE I/O CLASS AND DS/1000 VALUES * ON YOUR TERMINAL, TYPE RU,DSINF,,,6. * * THE NODE NUMBER WHERE I/O IS TO OCCUR. DEFAULT IS LOCAL * NODE (-1). * * SET TO A NON-ZERO VALUE WHEN THE NODE NUMBER IS 0 (TO * DISTINGUISH IT FROM THE DEFAULT). * *DSINF RECOGNIZES THE FOLLOWING COMMANDS: * AV AVAILABLE MEMORY SUSPEND LIST * CL I/O CLASSES * VA DS/1000 VALUES * DU DUMP OF SAM BLOCK * LI DS/1000 LISTS * NR OR /N NODAL ROUTING VECTOR (N OPTION ONLY) * EQ DS/1000 EQT ENTRIES * EQ,N PRINT INFORMATIO=N ON EQT N * LU,N PRINT INFORMATION ABOUT LU N * MA MESSAGE ACCOUNTING (N OPTION ONLY) * RR REROUTING (N OPTION ONLY) * RS REMOTE SESSIONS * EX OR /E TERMINATE DSINF * *ALL OTHER CHARACTERS CAUSE THE FUNCTIONS TO BE LISTED ON THE *OUTPUT DEVICE.; SPC 3 * * THE LU AND EQ COMMANDS USE A THIRD PARAMETER WHICH CAN HAVE THESE VALUES: * CODE PRINT THIS INFORMATION * ---- ---------------------- * (NONE) LU, EQT, AND DRIVER TYPE \ ALWAYS * FLAG BITS IF DRIVER IS TYPE 66 > PRINTED * LONG TERM STATISTICS IF TYPE IS 67 / * IO EQT WORDS * PA FOR DVA66: INTERFACE PARAMETERS * ST FOR DVA66: INTERFACE PARAMETERS AND STATISTICS * AL ALL OF THE ABOVE * * IF THE PARAMETERS OR STATISTICS ARE READ FROM A DVA66 CARD, THE * DRIVER IS CALLED. IF THE BOARD IS DOWN OR THE DRIVER HAS A LONG * QUEUE, DSINF MUST WAIT. * * HERE IS A SAMPLE PRINTOUT OF A DVA66 ENTRY: * EQT # 4, LU # 12, TYPE 66 * WORD VALUE MEANING WORD VALUE MEANING * 1 0 I/O LIST ADDRESS 2 20461 INITIATION ADDRESS * 3 20464 CONTINUATION ADDR 4 30016 FLAGS/SUBCHNL/SC * 5 33004 AV/TYPE/STATUS 6 1102 CONWD * 7 36203 DATA BUFFER ADDRESS 8 15 DATA BUFFER LENGTH * 9 0 REQUEST BUFFER ADDR 10 0 REQUEST BUFFER LEN * 11 0 SERVICING PROCESS 12 25113 ASSOCIATED EQT * 13 25150 EQT EXTENSION ADDR 14 0 NOMINAL TIMEOUT * 15 0 TIMEOUT CLOCK 16 177766 RETRY CNTR/READ PNTR * 17 50 1ST READ LEN/SKIP CT 18 410 2ND READ LEN/SKIP CT * 19 0 FRAME LENGTH ON CARD 20 36220 WRITE POINTER * 21 0 WRITE BUFFERS LENGTH 22 1140 MAX PSI FRAME SIZE * 23 0 NUM OUTPUT BUFFERS 24 21346 REA)D CONT ADDRESS * 25 22071 WRITE CONT ADDRESS 26 13004 FLAG BITS * 27 110014 MISCELLANEOUS BITS * * FLAG BITS (EQT WORD 26) * 0 READ ABORTED 0 WRITE ABORTED 1 RD RQ PENDING 0 WT RQ PENDING * 0 BKPL LOCKED RP 0 BKPL LOCKED WP 0 SHORT TO ACTIVE 0 MED. T.O ACTIVE * 0 LONG T.O ACTIVE 1 CONNECTED 1 START OF MSG. 0 NON-DS MODE * 1 ASKED TO CONNCT 0 SEVERE ERROR 0 P-F RECONNECT 0 RFP WAIT * * BSC BOARD, FIRMWARE REV.2013, SPEED: 300 BPS , EXTERNAL CLOCK * FCL DISABLED, DIAGNOSTIC HOOD NOT SENSED * * PARAMETERS/STATISTICS * 2147 GOOD BLOCKS SENT 2147 GOOD BLOCKS RCVD * 0 BAD BLOCKS RECEIVED 8 NAKS RECEIVED * 0 WACKS SENT 0 WACKS RECEIVED * 0 TTDS SENT 0 TTDS RECEIVED * 17 RESPONSE ERRORS 1 3 SECOND TIMEOUTS * 0 LINE ERRORS 608 BLOCK SIZE (BYTES) * 8 RETRY LIMIT 255 CONNECT TIMER * 2880 TRACE SIZE (BYTES) 2 MODE * * * DIFFERENT STATISTICS AND PARAMETERS ARE PRINTED FOR THE HDLC BOARD * (THE BOARD PARAMETERS INDICATE WHICH TYPE OF FIRMWARE IS LOADED). * * THE FORM OF THE SPEED AND CLOCK MESSAGES DEPENDS ON THE * SETTING OF THE SWITCHES ON THE I/F BOARD: * * SPEED: 300 BPS, INTERNAL CLOCK * ^ ^ * ! ! * ! +----- OR EXTERNAL * ! * +---- THIS FIELD MAY HAVE ANY OF THE FOLLOWING: * 300 BPS * 1200 BPS * 2400 BPS * 4800 BPS * 9600 BPS * 19.2KBPS * 57.6KBPS * MAXIMUM^ * * WHEN USING EXTERNAL CLOCK, THE ACTUAL SPEED IS DETERMINED BY MODEM, * BUT SETTING SHOULD MATCH, OR BE SLOWER THAN, THAT OF THE MODEM USED. * HED DSINF: DATA DECLARATION * (C) HEWLETT-PACKARD CO. * RUN-TIME PARAMETERS INLU BSS 01 OUTLU BSS 01 CONWD BSS 01 NODE BSS 01 FLAG BSS 01 SPC 2 *INTEGER I,J, & COUNTERS I BSS 01 J BSS 01 * KYWRD, & BASE OF KEYWORD TABLE KYWRD BSS 01 * MAXID, & # OF ENTRIES IN KEYWORD TABLE MAXID BSS 01 * SSIZE; & SIZE OF SAM BLOCK SSIZE BSS 01 SPC 2 * DS/1000 VALUES EXT #CNOD,#FWAM,#TBRN,#MSTO,#SVTO,#WAIT,#QRN EXT #BREJ,#LU3K,#QZRN,#GRPM,#NRV,#TST EXT #RFSZ,#LDEF,#NCNT,#NODE,#LNOD,D$LID,D$RID EXT #QCLM,#RTRY,#PLOG,#TRCL,#INCV,#OTCV,#QXCL EXT #RQCV,#RPCV,#CLRN,#RDLY,#PRLU,#MHCT,#LEVL EXT #TRCN,#MCTR,#LCNT,#MAHC,#MARN,#RSM,#LV EXT #MDCT,D$BSZ,#POOL SPC 2 *INTEGER ARRAY BUFR[1:1]; & OUTPUT BUFFER BUFR EQU * * OUTPUT FIELDS (WORDS 1 THROUGH 39) W1 BSS 1 W2 BSS 1 W3 BSS 1 W4 BSS 1 W5 BSS 1 W6 BSS 1 W7 BSS 1 W8 BSS 1 W9 BSS 1 W10 BSS 1 W11 BSS 1 W12 BSS 1 W13 BSS 1 W14 BSS 1 W15 BSS 1 W16 BSS 1 W17 BSS 1 W18 BSS 1 W19 BSS 1 W20 BSS 1 W21 BSS 1 W22 BSS 18 * * HOLDING AREA FOR NUMBER CONVERSION *INTEGER HOLD1,HOLD2,HOLD3; HOLD1 BSS 1 HOLD2 BSS 1 HOLD3 BSS 1 * SAMIN BSS 1 SAM ARRAY INITIALIZED? * BASE PAGE LOCATIONS EQTA EQU 1650B FIRST WORD OF EQUIPMENT TABLE EQT# EQU 1651B DRT EQU 1652B 1ST WORD OF DEVICE REFERENCE TABLE LUMAX EQU 1653B NUMBER OF LOGICAL UNITS IN DRT KEYWD EQU 1657B FWA OF KEYWORD BLOCK SUSP2 EQU 1713B "WAIT SUSPEND" LIST SUSP3 EQU 1714B "U1lNAVAILABLE MEMORY" LIST * *EQUATE LSTRM := 10; & LAST STREAM NUMBER LSTRM EQU 10 NOSTR ABS LSTRM * NAME BSS 3 NAMEF BSS 3 IDAD NOP ISTAT NOP IDTYP NOP IFTHR NOP @NAMF DBL NAMEF @NAME DBL NAME HED DSINF: MAIN PROGRAM * (C) HEWLETT-PACKARD CO. *+-----------------------------+ *! BEGINNING OF MAIN PROGRAM ! *+-----------------------------+; SPC 1 * PICK UP RUN-TIME PARAMETERS *RMPAR(INLU); DSINF JSB RMPAR DEF *+2 DEF INLU * * * FOR MAPPED SYSTEMS, CONFIGURE DMS INSTRUCTIONS. LDA $OPSY RAR,SLA RSS RSS JMP STFLS LDA MWF CLB DST DMS1 LDA RSS STA DMS2 * *& SET FLAGS *PRMPT := SAMIN := FALSE; STFLS CLA STA SAMIN STA PRMPT * STA NAME STA IDAD JSB PGMAD GET OWN NAME DEF *+6 AND FATHER'S DEF NAME ID SEGMENT. DEF IDAD DEF ISTAT DEF IDTYP DEF IFTHR * UNL IFN LST * DETERMINE THE NODE NUMBER: LDA NODE IF NODE SZA NOT 0, JMP OK USE IT. LDB FLAG CHECK SZB NODE 0 JMP OK FLAG. * WE HAVE BEEN SCHEDULED WITH BOTH FLAG AND NODE SET TO 0. * IF OUR FATHER IS "EXECW", USE #CNOD AS THE NODE NUMBER. LDA IFTHR GET FATHER'S CMA,INA ID SEGMENT ADDR. SSA,RSS IF <= 0, JMP LOCAL WE ARE LOCAL. STA IFTHR JSB PGMAD GET FATHER'S DEF *+3 NAME. DEF NAMEF DEF IFTHR LDA @NAMF IS HIS NAME LDB @EXCW EXECW? JSB .CBT DEF D5 NOP JMP NTLOC YES--NOT LOCAL ɯ NOP LOCAL CCA NODE:=-1 RSS NTLOC LDA #CNOD NODE:=#CNOD STA NODE OK EQU * UNL XIF LST SPC 1 * GET TRUE PROGRAM NAME (USUALLY WILL BE DSINF). LDA @NAME MOVE FOR LDB @RUNL "INITIALIZE" MESSAGE. JSB .MBT DEF D5 NOP LDA @NAME MOVE FOR LDB @FINS FINAL MESSAGE. JSB .MBT DEF D5 NOP LDA @NAME MOVE FOR LDB @PRMP PROMPT. JSB .MBT DEF D5 NOP * *IF INLU<1 THEN CCA ADA INLU SSA,RSS JMP L968 * BEGIN * INLU := @401; & DEFAULT INPUT LU IS SYS CONSOLE LDA B401 STA INLU * PRMPT := TRUE; & INTERACTIVE DEVICE CCA STA PRMPT * END * ELSE JMP L977 * BEGIN & GET LU INFORMATION UNL IFN LST * DEXEC(NODE,13,INLU,DVR,T1,SUB); L968 JSB DEXEC DEF *+7 DEF NODE UNL XIF LST UNL IFZ LST * EXEC(13,INLU,DVR,T1,SUB); L968 JSB EXEC DEF *+6 UNL XIF LST DEF D13 DEF INLU DEF DVR DEF T1 DEF SUB * SUB := SUB AND @17; LDA SUB AND B17 STA SUB * DVR := ROTATE DVR AND @77; LDA DVR ALF,ALF AND B77 STA DVR * PRMPT := (DVR=00) OR (DVR=07 OR DVR=05 AND SUB=0); CCB SZA,RSS JMP TRU CPA D7 JMP SUBCK CPA D5 JMP SUBCK JMP FLS SUBCK EQU * UNL IFN LST LDA D#OPS IF REMOTE SYSTEM IS CPA $RTEL RTE-L, THERE ARE JMP TRU NO SUBCHA1NNELS. UNL XIF LST LDA SUB SZA FLS CMB TRU STB PRMPT * IF PRMPT THEN SSB,RSS JMP L977 * INLU:=INLU OR @400; & SET "K" BIT FOR INTERACTIVE INPUT LDA INLU IOR B400 STA INLU * END; * CHECK OUTPUT LU DEVICE *IF OUTLU<1 THEN L977 CCA ADA OUTLU SSA,RSS JMP L984 * OUTLU := IF PRMPT THEN INLU ELSE 6; LDB INLU LDA PRMPT SSA,RSS LDB D6 STB OUTLU * L984 LDA $OPSY CPA $RTEL RTE-L? JMP WRSYS YES--PRINT ERROR. * * FIND # OF PROGRAM ID SEGMENTS IN SYSTEM *KYWRD := IGET(KEYWD) - 1; CCA ADA KEYWD STA KYWRD *I := 1; CLA,INA STA I *WHILE IGET(KYWRD+I)#0 DO L986 LDA KYWRD ADA I LDA A,I SZA,RSS * I := I + 1; JMP L988 LDA I INA STA I JMP L986 *MAXID := I - 1; L988 CCA ADA I STA MAXID * *SSIZE := #NRV - #FWAM; & UNLESS THERE IS NO NRV! LDA #NRV SZA JMP GTSTR LDA #TST+1 MPY D14 ADA #TST GTSTR LDB #FWAM CMB,INB ADA B STA SSIZE *IF SSIZE>740 THEN ADA DM740 SZA SSA JMP L1001 * & DON'T OVERRUN SAM ARRAY * SSIZE := 740; LDA D740 STA SSIZE * * CHECK TO SEE IF NODE HAS BEEN INITIALIZED *IF FWAM=0 THEN L1001 LDA #FWAM SZA JMP L1007 * JSB PRINT DEF RUNL DEC 13 * ELSE JMP L1037 * * * CHECK FOR NON-INTERACTIVE RUN *IF CONWD # 0 THEN L1007 LDA CONWD SZA,RSS JMP L1033 * BEGIN * INTEGER TMSC,SEC,MIN,HOUR; JM{ P L1014 TMSC BSS 01 SEC BSS 01 MIN BSS 01 HOUR BSS 01 BSS 1 TIME ASC 8, TIME---XX:XX:XX COLON ASC 1,:: "00" ASC 1,00 * PRMPT := FALSE; L1014 CLA STA PRMPT * EXEC(11,TMSC); JSB EXEC DEF *+3 DEF D11 DEF TMSC * TIME[8] := KCVT(SEC); LDA SEC JSB KCVT1 IOR "00" STA TIME+7 * TIME[6] := KCVT(MIN); LDA MIN JSB KCVT1 IOR "00" LDB COLON RRR 8 DST TIME+5 * TIME[4] := KCVT(HOUR); LDA HOUR JSB KCVT1 STA TIME+4 JSB BLINE * JSB PRINT DEF TIME D8 DEC 8 UNL IFN LST * PRINT LOCAL NODE NUMBER LDA #NODE JSB CNVTD DEF LOCLN JSB PRINT DEF NODM2 DEC 10 UNL XIF LST * BLINE; JSB BLINE * IF (CONWD AND 1)#0 THEN AVMEM; LDA CONWD AND D1 SZA JSB AVMEM * IF (CONWD AND 2)#0 THEN CLASS; LDA CONWD AND D2 SZA JSB CLASS * IF (CONWD AND 4)#0 THEN VALUS; LDA CONWD AND D4 SZA JSB VALUS * IF (CONWD AND 8)#0 THEN DUMP; LDA CONWD AND D8 SZA JSB DUMP * IF (CONWD AND 16)#0 THEN LISTS; LDA CONWD AND D16 SZA JSB LISTS UNL IFN LST * IF (CONWD AND 32)#0 THEN DSNRV; LDA CONWD AND D32 SZA JSB DSNRV UNL XIF LST * IF (CONWD AND 64)#0 THEN EQTS; LDA CONWD AND D64 SZA JSB EQTS UNL IFN LST * IF (CONWD AND 128)#0 THEN MSACT;  LDA CONWD AND D128 SZA JSB MSACT * IF (CONWD AND 256)#0 THEN RRTNG; LDA CONWD AND D256 SZA JSB RRTNG UNL XIF LST * IF (CONWD AND 512)#0 THEN RMSES; LDA CONWD AND D512 SZA JSB RMSES * END * * *ELSE JMP L1037 * SET PROGRAM NAME IN FUN1 AND FUN10 L1033 LDA @NAME LDB @FUN1 JSB .MBT DEF D5 NOP * MOREC := TRUE; CCA STA MOREC LDA @NAME LDB @FN10 JSB .MBT DEF D5 NOP * WHILE MOREC DO L1034 LDA MOREC SSA,RSS * XEQFN; JMP L1037 JSB XEQFN JMP L1034 * L1037 JSB PRINT DEF FINIS D11 DEC 11 * * DSINF REUSES PARAMETERS IF IN TIME LIST * EXEC(6,0,0,INLU,OUTLU,CONWD); JSB EXEC DEF *+9 DEF D6 DEF D0 DEF D0 DEF INLU DEF OUTLU DEF CONWD DEF NODE DEF FLAG D0 DEC 0 D128 DEC 128 SPC 2 * * $OPSY SAYS THIS IS AN RTE-L SYSTEM * WRSYS JSB PRINT PRINT DEF BDRTE "WRONG DSINF LOADED". DEC 10 JSB EXEC TERMINATE DEF *+4 (WITH PREJUDICE). DEF D6 DEF D0 DEF D3 * $RTEL DEC -31 $OPSY FOR RTE-L BDRTE ASC 10, WRONG DSINF LOADED HED DSINF: EXECUTE A FUNCTION * (C) HEWLETT-PACKARD CO. *PROCEDURE XEQFN; * "AV" ASC 1,AV "CL" ASC 1,CL "VA" ASC 1,VA "DU" ASC 1,DU "LI" ASC 1,LI "NR" ASC 1,NR "/N" ASC 1,/N "EQ" ASC 1,EQ "LU" ASC 1,LU "MA" ASC 1,MA "RR" ASC 1,RR "RS" ASC 1,RS "/E" ASC 1,/E "EX" ASC 1,EX FNCTN ASC 5, FUNCTION TO BE PERFORMED RDLEN BSS 1 DM10 DEC -10 * XEQFN BSS 01 * BEGIN * * COMMENT * +----------------------+ * ! EXECUTE A FUNCTION ! * +----------------------+; * * IF PRMPT THEN LDA PRMPT SSA,RSS JMP L928 * BEGIN & PROMPT FOR COMMAND UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF BLANK DEF D1 * & PRINT THE PROMPT UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF PROMP DEF D9 * END; * * CLEAR WORDS 2 & 3 OF FNCTN LDA BLANK STA FNCTN+1 STA FNCTN+2 * READ COMMAND FROM INPUT LU UNL IFN LST L928 JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST L928 JSB EXEC DEF *+5 UNL XIF LST DEF SD1 SET NO-ABORT BIT. DEF INLU DEF FNCTN DEF DM10 JMP EX ERROR: TREAT AS "/E". STB RDLEN SAVE NUMBER OF BYTES READ. * * EXECUTE COMMAND * IF FNCTN="AV" THEN AVMEM LDA FNCTN CPA "AV" RSS JMP *+3 JSB AVMEM JMP L939 * ELSE IF FNCTN="CL" THEN CLASS CPA "CL" RSS JMP *+3 JSB CLASS JMP L939 * ELSE IF FNCTN="VA" THEN VALUS CPA "VA" RSS JMP *+3 JSnB VALUS JMP L939 * ELSE IF FNCTN="DU" THEN DUMP CPA "DU" RSS JMP *+3 JSB DUMP JMP L939 * ELSE IF FNCTN="LI" THEN LISTS CPA "LI" RSS JMP *+3 JSB LISTS JMP L939 UNL IFN LST * ELSE IF FNCTN="NR" OR FNCTN="/N" THEN DSNRV CPA "NR" RSS JMP *+3 TONRV JSB DSNRV JMP L939 CPA "/N" JMP TONRV UNL XIF LST * ELSE IF FNCTN="EQ" THEN EQTS CPA "EQ" RSS JMP *+3 JSB EQTS JMP L939 * ELSE IF FNCTN="LU" THEN LUS CPA "LU" RSS JMP *+3 JSB LUS JMP L939 UNL IFN LST * ELSE IF FNCTN="MA" THEN MSACT CPA "MA" RSS JMP *+3 JSB MSACT JMP L939 * ELSE IF FNCTN="RR" THEN RRTNG CPA "RR" RSS JMP *+3 JSB RRTNG JMP L939 UNL XIF LST * ELSE IF FNCTN="RS" THEN RMSES CPA "RS" RSS JMP *+3 JSB RMSES JMP L939 * ELSE IF FNCTN="/E" OR FNCTN="EX" THEN MOREC:=FALSE CPA "/E" JMP EX CPA "EX" RSS JMP BADF EX CLA STA MOREC JMP L939 * ELSE LFUNS; BADF JSB LFUNS * END OF XEQFN; L939 JMP XEQFN,I SPC 6 B400 OCT 400 B401 OCT 401 DM740 DEC -740 DM11 DEC -11 D16 DEC 16 D64 DEC 64 D256 EQU B400 D512 DEC 512 D740 DEC 740 SD1 DEF 1,I @EXCW DBL EXECW EXECW ASC 3,EXECW PROMP ASC 9,/DSINF: FUNCTION?_ RUNL ASC 13, /DSINF: INITIALIZE NODE! FINIS ASC 11, *** END OF DSINF *** STARS EQU FIN=@IS+1 @RUNL DBL RUNL+1 @PRMP DBR PROMP @FINS DBL FINIS+6 SUB BSS 1 INPUT LU'S SUBCHANNEL DVR BSS 1 INPUT LU'S DRIVER TYPE MOREC BSS 1 MORE COMMANDS TO READ? PRMPT BSS 1 PROMPT FOR COMMANDS? HED DSINF: UTILITY SUBROUTINES * (C) HEWLETT-PACKARD CO. * +--------------+ * ! PROCEDURES ! * +--------------+ SPC 1 * * CONVERT NUMBER TO ASCII DECIMAL * CNVTD NOP STA RAW SAVE THE RAW DATA, TEMPORARILY. LDA CNVTD,I GET THE DESTINATION ADDRESS. STA STUFM CONFIGURE THE CALL TO 'CNUMD'. JSB CNUMD GO TO DEF *+3 CONVERT DEF RAW THE VALUE STUFM NOP TO ASCII. ISZ CNVTD ADJUST THE RETURN POINTER, JMP CNVTD,I AND RETURN TO THE CALLER. * RAW BSS 1 SPC 2 * * CONVERT NUMBER TO ASCII OCTAL * CNVTO NOP ENTRY. STA RAW SAVE THE NUMBER. LDA CNVTO,I GET DESTINATION ADDRESS. STA STUF1 SET ADDRESS IN CNUMO CALL. JSB CNUMO CALL SYSTEM DEF *+3 ROUTINE TO DEF RAW CONVERT. STUF1 NOP ISZ CNVTO ADJUST RETURN ADDRESS JMP CNVTO,I AND RETURN TO CALLER. SPC 2 * * CONVERT DECIMAL NUMBER TO ASCII, TWO DIGITS * (VALUE GOES IN A-REGISTER) * KCVT1 NOP STA T1 SAVE DATA TEMPORARILY. JSB KCVT CALL SYSTEM ROUTINE DEF *+2 FOR CONVERSION. DEF T1 JMP KCVT1,I RETURN. SKP * * CHASE DOWN INDIRECTS * INDR NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP INDR,I SPC 3 * * FILL BUFR ARRAY WITH A-REGISTER CONTENTS * FILL NOP ENTRY POINT STA BUFR STORE IN FIRST WORD. LDA AW1 PROPAGATE THROUGH LDB A ENTIRE FIELD INB WITH A JSB .MVW MOVE. DEF D38 NOP  * JMP FILL,I RETURN SPC 2 * SUBROUTINE TO FILL PRINT BUFFER WITH BLANKS BFILL NOP LDA BLANK JSB FILL JMP BFILL,I RETURN SKP * * PRINT A STRING * MSG BSS 1 STRING ADDRESS LEN BSS 1 LENGTH * PRINT NOP ENTRY POINT LDA PRINT,I GET PARAMETERS STA MSG ISZ PRINT LDA PRINT,I STA LEN ISZ PRINT * UNL IFN LST JSB DEXEC CALL DEXEC FOR WRITE DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC CALL EXEC FOR WRITE DEF *+5 UNL XIF LST DEF D2 DEF OUTLU DEF MSG,I DEF LEN * JMP PRINT,I RETURN SPC 2 * PROCEDURE TO PRINT A BLANK LINE BLINE NOP JSB PRINT DEF BLANK D1 DEC 1 JMP BLINE,I SKP * * MOVE THE DS/1000 BLOCK OF SAM * DEST DEF SAM DESTINATION ADDRESS PONTR NOP ADDRESS WHERE POINTER IS STORED DEF PNTR-3 POINTERS' ARRAY * GTSAM NOP ENTRY POINT JSB $LIBR INSURE NOBODY CHANGES SAM NOP BY GOING PRIVILEGED * LDA #FWAM A-REG := SOURCE ADDR IN SAM LDB DEST B-REG := DESTINATION JSB .LDX X-REG := # OF WORDS TO MOVE DEF SSIZE DMS1 JSB .MVW MOVE WORDS [IN DMS: MWF] DEF SSIZE NOP * LDA PONTR+1 STA PONTR CCA \ GET ADDRESS ADA #LDEF / OF FIRST POINTER JSB .LDX INITIALIZE COUNTER DEF D14 LOOP2 LDB A,I PICK UP POINTER LDB B,I STB PONTR,I STORE POINTER INA INCREMENT SOURCE ADDR ISZ PONTR INCREMENT DEST ADDR JSB .DSX DONE? JMP LOOP2 NO--MOVE NEXT POINTER * JSB $LIBX RESTORE SYSTEM DEF GTSAM AND RETURN * MWF MWF INSTRUCTION FOR DMS OPERATING SYS SPC 3 * * PLACE THE CONTENTS OF A LOCATION IN ALTERNATE MAP (IF MAPPED SYS) * INTO THE A-REGISTER * IXGET NOP ENTRY POINT DMS2 LDA B,I [RSS IF DMS SYSTEM] JMP IXGET,I RETURN IF NON-MAPPED. * XLA B,I JMP IXGET,I RETURN. HED DSINF: LIST FUNCTIONS * (C) HEWLETT-PACKARD CO. *PROCEDURE LFUNS; * BEGIN * * COMMENT * +------------------------------------+ * ! LIST FUNCTIONS PROVIDED BY DSINF ! * +------------------------------------+; * @FUN1 DBL FUN1+1 FUN1 ASC 13, /DSINF: VALID FUNCTIONS-- FUN2 ASC 21, AV AVAILABLE MEMORY SUSPEND LIST FUN3 ASC 12, CL I/O CLASSES FUN5 ASC 14, VA DS/1000 VALUES FUN6 ASC 17, DU DUMP OF DS SAM BLOCK FUN7 ASC 13, LI DS/1000 LISTS UNL IFN LST FUN9 ASC 17, NR OR /N NODAL ROUTING VECTOR UNL XIF LST FUN8 ASC 16, EQ DS/1000 EQT ENTRIES FUN8A ASC 17, EQ,N DS/1000 EQT ENTRY # N FUN8B ASC 17, LU,N EQT ENTRY FOR LU # N UNL IFN LST FUN11 ASC 16, MA MESSAGE ACCOUNTING FUN12 ASC 11, RR REROUTING UNL XIF LST FUN13 ASC 14, RS REMOTE SESSIONS FUN10 ASC 14, EX OR /E TERMINATE DSINF @FN10 DBR FUN10+11 * LFUNS NOP * JSB BLINE * JSB PRINT DEF FUN1 DEC 13 * JSB PRINT DEF FUN2 DEC 21 * JSB PRINT DEF FUN3 DEC 12 * JSB PRINT DEF FUN5 ea DEC 14 * JSB PRINT DEF FUN6 DEC 17 * JSB PRINT DEF FUN7 DEC 13 * UNL IFN LST JSB PRINT DEF FUN9 DEC 17 * UNL XIF LST JSB PRINT DEF FUN8 DEC 16 * JSB PRINT DEF FUN8A DEC 17 * JSB PRINT DEF FUN8B DEC 17 * UNL IFN LST JSB PRINT DEF FUN11 DEC 16 * JSB PRINT DEF FUN12 DEC 11 * UNL XIF LST JSB PRINT DEF FUN13 DEC 14 * JSB PRINT DEF FUN10 DEC 14 * JSB BLINE * END OF LFUNS; JMP LFUNS,I HED DSINF: PRINT AVAILABLE MEM LIST * (C) HEWLETT-PACKARD CO. *PROCEDURE AVMEM; * BEGIN * COMMENT * +---------------------------------------+ * ! PRINT AVAILABLE MEMORY SUSPEND LIST ! * +---------------------------------------+; * MHED1 ASC 20, AVAILABLE MEMORY SUSPEND LIST IS EMPTY MHED2 ASC 23, PT SZ PRGRM T PRIOR AMT.MEM FATHER * B40K OCT 40000 BIT14 EQU B40K B76K OCT 76000 B77 OCT 77 D3 DEC 3 D6 DEC 6 HYPHN ASC 1,-- "B" ASC 1,B WRD21 BSS 1 ID SEGMENT WORD 21 WRD22 BSS 1 ID SEGMENT WORD 22 FATHR BSS 1 FATHER'S ID SEGMENT WORD 1 BAW7 DBL W7 * AVMEM NOP JSB BLINE * IF (LINK := IGET(SUSP3))#0 THEN LDA SUSP3 STA LINK SZA,RSS JMP L383 * BEGIN * & PRINT HEADING JSB PRINT DEF MHED1 D15 DEC 15 * JSB BLINE * JSB PRINT DEF MHED2 DEC 23 * & PRINT A LINE OF HYPHENS * FILL(BUFR,"--"); ט LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * & PRINT ID INFORMATION FOR EACH PROGRAM IN LIST * DO * BEGIN * & POINT TO NEXT LINK IN "AVAILABLE MEMORY" LIST * FILL(BUFR,BLANK); & CLEAR OUTPUT BUFR L338 JSB BFILL * & MOVE PROGRAM NAME LDA LINK ADA D12 CLE,ELA LDB BAW7 JSB .MBT DEF D5 NOP * W10 := KCVT(IGET(LINK+14) AND @17); & TYPE LDA LINK ADA D14 LDA A,I AND B17 JSB KCVT1 STA W10 * W3 := KCVT(((WRD22:=IGET(LINK+21)) AND @77)+1); & PARTN LDA LINK ADA D21 LDA A,I STA WRD22 AND B77 INA JSB KCVT1 STA W3 * W5 := KCVT((WRD22 AND @76000)\@2000 + 1); & SIZE LDA WRD22 AND B76K CLB LSR 10 INA JSB KCVT1 STA W5 * CNUMD(IGET(LINK+6),W11); & PRIORITY LDA LINK ADA D6 LDA A,I JSB CNVTD DEF W11 * IF (WRD21 := IGET(LINK+20))<0 THEN W14:="B "; & BATCH? LDB "B" LDA LINK ADA D20 LDA A,I STA WRD21 SSA STB W14 * CNUMD(IGET(LINK+1),W15); & AMOUNT OF MEMORY REQUESTED LDA LINK INA LDA A,I JSB CNVTD DEF W15 * & PUT LINE LENGTH IN "I" * I := 20; LDA D20 STA I * & CHECK "FATHER WAITING" BIT * IF (MORE := ((WRD21 AND @40000)#0)) THEN LDA WRD21 AND B40K SZA,RSS JMP L373 * BEGIN * & MOVE FATHER NAME(S) * FATHR := IGET(KYWRD + (WRD21 AND @377)); LDA W RD21 AND B377 ADA KYWRD LDA A,I STA FATHR * WHILE MORE DO * BEGIN * & MOVE THE NAME L354 LDA FATHR ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB JSB .MBT DEF D5 NOP * & CHECK FOR GRANDFATHER WAITING * IF (MORE := (IGET(FATHR+20) AND @40000)#0) THEN LDA FATHR ADA D20 LDA A,I AND B40K SZA,RSS JMP L373 * BEGIN * I := I + 3; LDA I ADA D3 STA I * FATHR:=IGET(KYWRD+(IGET(FATHR+20) AND @377)); LDA FATHR ADA D20 LDA A,I AND B377 ADA KYWRD LDA A,I STA FATHR * & CHECK FOR FULL OUTPUT BUFFER * IF I > 35 THEN LDA I ADA DM34 SSA JMP L354 * BEGIN & WRITE LINE, THEN CLEAR BUFFER * JSB PRINT DEF BUFR D38 DEC 38 * FILL(BUFR,BLANK); JSB BFILL * I := 20; LDA D20 STA I * END; * END; * END; JMP L354 * END; * & PRINT OUTPUT BUFFER * PRINT1(I+3); L373 LDA I ADA D3 STA T1 JSB PRINT DEF BUFR T1 DEC 0 * LINK := IGET(LINK); & NEXT ID SEGMENT IN LIST OR 0 LDA LINK,I STA LINK * END * UNTIL LINK=0; SZA JMP L338 * & PRINT LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * END * ELSE $JMP L384 * & NO PROGRAMS IN "AVAILABLE MEMORY" LIST * L383 JSB PRINT DEF MHED1 D20 DEC 20 * BLINE; L384 JSB BLINE * END OF AVMEM; JMP AVMEM,I HED DSINF: PRINT I/O CLASS INFORMATION * (C) HEWLETT-PACKARD CO. *PROCEDURE CLASS; * BEGIN * * COMMENT * +-------------------------------+ * ! PRINT I/O CLASS INFORMATION ! * +-------------------------------+; * *INTEGER NBLCK, & NUMBER OF BLOCKS WAITING IN SAM NBLCK BSS 01 * TBLCK; & TOTAL SIZE OF SAM BLOCKS FOR A CLASS TBLCK BSS 01 * CHED1 ASC 11, I/O CLASS INFORMATION CHED2 ASC 12, CLASSES IN SYSTEM CHED3 ASC 10, CLASSES IN USE: CHED4 ASC 22, CLASS STATE GET POSSIBLE OWNER CHED5 ASC 12, CLASSES AVAILABLE CHED6 ASC 11, BLOCK(S) WORDS] "[" BYT 133,0 * ACHD6 DEF CHED6 "BU" ASC 1,BU "AL" ASC 1,AL "GT" ASC 1,GT B174C OCT 17400 D4 DEC 4 B17 EQU D15 D32 DEC 32 B40 EQU D32 DM34 DEC -34 DCLAS DEF $CLAS AVLBL BSS 1 NUMBER OF CLASSES AVAILABLE TADDR BSS 1 I/O CLASS OR RN TABLE ADDRESS TSIZE BSS 1 TABLE SIZE ENTRY BSS 1 TABLE ENTRY NUMBER TWORD BSS 1 CONTENTS OF TABLE ENTRY LINK BSS 1 ID SEGMENT WORD 1 LASTI BSS 1 * * & GET CLASS I/O TABLE START ADDRESS & NUMBER OF ENTRIES * GETCL(TADDR,TSIZE); CLASS NOP LDA DCLAS GET CLASS TABLE ADDRESS JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF CHED1 DEC 11 * & PRINT NUMBER OF CLASSES * CNUMD(TSIZE,CHED2); LDA TSIZE JSB CNVTD DEF CHED2 * JSB PRINT DEF CHED2 D12 DEC 12 ŀ* BLINE; JSB BLINE * & PRINT HEAD FOR CLASSES IN USE * JSB PRINT DEF CHED3 D10 DEC 10 * JSB PRINT DEF CHED4 DEC 22 * & LOOK AT EACH CLASS TO DETERMINE STATE AND POSSIBLE OWNER * AVLBL := 0; CLA STA AVLBL * FOR ENTRY := TADDR+1 TO TADDR+TSIZE DO LDA TADDR INA STA ENTRY LDB TADDR ADB TSIZE STB LASTI L424 CMA,INA ADA LASTI SSA JMP L498 * BEGIN * INTOF; JSB $LIBR NOP * IF (TWORD := IGET(ENTRY))=0 THEN LDA ENTRY,I STA TWORD SZA JMP L434 * BEGIN * INTON; JSB $LIBX DEF *+1 DEF *+1 * AVLBL := AVLBL + 1; & CLASS IS AVAILABLE ISZ AVLBL * END * ELSE JMP L497 * BEGIN * FILL(BUFR,BLANK); L434 JSB BFILL * CNUMD(ENTRY-TADDR,W3); LDA TADDR CMA,INA ADA ENTRY JSB CNVTD DEF W3 * IF TWORD>0 THEN LDA TWORD SZA SSA JMP L456 * BEGIN & STATE 2--BUFFERED REQUESTS * & FOLLOW LINKS TO BLOCKS OF SAM * NBLCK := TBLCK := 0; CLA STA TBLCK STA NBLCK * WHILE TWORD>0 DO L441 LDA TWORD SZA SSA * BEGIN JMP L447 * NBLCK := NBLCK + 1; ISZ NBLCK * TBLCK := TBLCK + IXGET(TWORD+3); LDB TWORD ADB D3 JSB IXGET ADA TBLCK STA TBLCK * TWORD := IXGET(TWORD); LDB TWORD JSB IXGET STA TWORD * END; JMP L441 * INTON; L447 JSB $LIBX DEF *+1 DEF *+1 * & PRINT INFORMATION * & MOVE # OF BLOCKS AND WORDS HEAD TO OUTPUT BUFFER LDA ACHD6 LDB AW11 JSB .MVW DEF D11 NOP * & MOVE THE TOTAL (3 DIGITS) LDA NBLCK JSB CNVTD DEF W8 LDA "BU" STA W8 LDA W9 AND B377 IOR "[" STA W9 * CNUMD(TBLCK,HOLD1); LDA TBLCK JSB CNVTD DEF HOLD1 * MOVE(HOLD2,W16,4); DLD HOLD2 DST W16 * JSB PRINT DEF BUFR DEC 22 * FILL(BUFR,BLANK); JSB BFILL * END * ELSE INTON; JMP L457 L456 JSB $LIBX DEF *+1 DEF *+1 * IF (TWORD AND @40000)=0 THEN L457 LDA TWORD AND B40K SZA JMP L461 * W8 := "AL" & ALLOCATED * ELSE LDA "AL" STA W8 JMP L476 * BEGIN * W8 := "GT"; & GET L461 LDA "GT" STA W8 * & SOMEONE MUST BE WAITING ON THIS CLASS'S GET * INTOF; JSB $LIBR NOP * LINK := IGET(SUSP2); & HEAD OF GENERAL WAIT QUEUE LDA SUSP2 STA LINK * WHILE LINK#0 AND IGET(LINK+1)#ENTRY DO L465 LDA LINK SZA,RSS JMP L467 LDA LINK INA LDA A,I CMA,INA ADA ENTRY SZA,RSS * LINK := IGET(LINK); JMP L467 LDA LINK,I STA LINK JMP L465 * INTON; L467 JSB $LIBX DEF *+1 DEF *+1 * IF LINK#0 THEN LDA LINK SZA,RSS JMP L473 * BEGIN & FOUND 5 "GET" PROGRAM * & MOVE NAME TO OUTPUT BUFFER LDA LINK ADA D12 CLE,ELA LDB AW11 CLE,ELB JSB .MBT DEF D5 NOP * END * ELSE JMP L476 * & MOVE "" TO BUFFER L473 JSB .DFER AW11 DEF W11 DEF NONE+4 * END; * & PICK UP INDEX INTO KEYWORD TABLE, MODULO 32 * IDNUM := ROTATE(TWORD AND @17400); L476 LDA TWORD AND B174C ALF,ALF * IF IDNUM=0 THEN IDNUM:=32; SZA,RSS LDA D32 STA IDNUM * & FIND POSSIBLE OWNERS * I := 15; & OUTPUT BUFFER POINTER LDA D15 STA I * DONE := FALSE; CLA STA DONE * DO * BEGIN * LINK := IGET(KYWRD+IDNUM); L483 LDA KYWRD ADA IDNUM LDA A,I STA LINK * IF (IGET(LINK+14) AND @20)=0 AND IGET(LINK+12)#0 THEN ADA D14 LDA A,I AND B20 SZA JMP L490 LDA LINK ADA D12 LDA A,I SZA,RSS JMP L490 * BEGIN & GOOD ID SEGMENT * MOVII(LINK+12,AW1+I,5); LDA LINK ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB JSB .MBT DEF D5 NOP * IF (I := I + 4)>34 THEN LDA I ADA D4 STA I ADA DM34 SZA SSA JMP L490 * DONE := TRUE; & OUTPUT BUFFER IS FULL CCA STA DONE * END; * IF (IDNUM:=IDNUM+32)>MAXID THEN L490 LDA IDNUM ADA D32 STA IDNUM CMA,INA ADA MAXID SSA,RSS JMP ] L493 * DONE := TRUE; & ALL ID SEGMENTS CHECKED CCA STA DONE * END * UNTIL DONE; L493 LDA DONE SSA,RSS JMP L483 * & PRINT LINE OF INFORMATION FOR THIS CLASS LDA I STA T4 JSB PRINT DEF BUFR T4 DEC 0 * END; * END; L497 LDA ENTRY INA STA ENTRY JMP L424 * IF AVLBL=TSIZE THEN L498 LDA TSIZE CMA,INA ADA AVLBL SZA JMP L502 * JSB PRINT DEF NONE DEC 7 * ELSE JMP L507 * BEGIN & PRINT NUMBER OF AVAILABLE CLASSES * BLINE; L502 JSB BLINE * CNUMD(AVLBL,CHED5); LDA AVLBL JSB CNVTD DEF CHED5 * JSB PRINT DEF CHED5 DEC 12 * END; * BLINE; L507 JSB BLINE * END OF CLASS; JMP CLASS,I SPC 3 DONE BSS 1 ALL POSSIBLE CLASS OWNERS FOUND? IDNUM BSS 1 INDEX INTO KEYWORD TABLE NONE ASC 7, HED DSINF: PRINT DS/1000 VALUES * (C) HEWLETT-PACKARD CO. *PROCEDURE VALUS; * BEGIN * * COMMENT * +------------------------+ * ! PRINT DS/1000 VALUES ! * +------------------------+; * * HEADINGS: VHED1 ASC 8, DS/1000 VALUES: VHED2 ASC 20, RESOURCE NUMBERS: OWNER LOCKER VHED3 ASC 13, MAXIMUM HOP COUNT VHD19 ASC 14, MAX LINK DOWN COUNT VHED4 ASC 11, PROGL MESSAGE LU VHED5 ASC 9, UPGRADE LEVEL APMSG ASC 11, LAST APLDR LOAD-NODE APNOD ASC 3, NONE VHD17 ASC 16, CLASSES ASSIGNED TO PROGRAMS: VHD12 ASC 12, TIMEOUT VALUES (SEC): VHD13 ASC 13, MASTER T/O VHD14 ASC 13, SLAVE T/O VHD15 ASC 13, REMOTE BUSY RETRIES VHD16 ASC 13, REMOTE QUIET WAIT VHD18 ASC 13, MAX RETRY DELAY VHED7 ASC 15, RFA FILES MAY BE OPEN VHED9 ASC 15, HP 3000 IS ON LU *DOWN* VHD20 ASC 12, BUFFER SIZE XXXXXX VHD10 ASC 21, LOCAL ID SEQUENCE: VHD11 ASC 21, REMOTE ID SEQUENCE: * * TABLES FOR RESOURCE NUMBER INFORMATION: * RNTAB DEF *+1,I DEF #MARN DEF #PLOG+1 DEF #TRCN DEF #CLRN DEF #QZRN DEF #QRN DEF #TBRN NUMRN ABS RNTAB+1-* * RNDES DEF *+1 ASC 8,MA TABLE ACCESS ASC 8,PLOG SYNCH. ASC 8,TRC65 TRACE ASC 8,QUEX CLEANUP ASC 8,QUEZ "LISTEN" ASC 8,QUIESCENT ASC 8,TCB ACCESS * * TABLES FOR I/O CLASS INFORMATION: * CLTAB DEF *+1,I I/O CLASSES DEF #MAHC DEF #TRCL DEF #PLOG DEF #RSM DEF #OTCV DEF #INCV DEF #QCLM DEF #RTRY DEF #GRPM DEF #RPCV DEF #RQCV DEF #QXCL NUMCL ABS CLTAB+1-* * CLPRG DEF *+1 PROGRAM NAMES ASC 3, M. A. ASC 3,TRC65 ASC 3,PLOG ASC 3,RSM ASC 3,OTCNV ASC 3,INCNV ASC 3,QCLM ASC 3,RTRY ASC 3,GRPM ASC 3,RPCNV ASC 3,RQCNV ASC 3,QUEX * B377 OCT 377 UPMSK OCT 177400 PERID BYT 56,0 PERIOD, LEFT BYTE MASK2 OCT 177760 D5 DEC 5 D26 DEC 26 AVH10 DBL VHD10+13 AVH11 DBL VHD11+13 DRNTB DEF $RNTB RN BSS 1 FMTAD BSS 1 POINT BSS 1 CNTR BSS 1 GLBAL ASC 5, AGLBL DEF GLBAL AW3 DEF W3 * * PROCEDURE RNOUT(RN,FMTAD); RNOUT BSS 01 * VALUE RN,FMTAD; INTEGER RN,FMTAD; * BEGIN & PRINT RN INFORMATION AND B377 ISOLATE RESOURCE STA RN NUMBER. LDB RNOUT,I ISZ Q RNOUT STB FMTAD SZA,RSS IF RN NOT ASSIGNED, JMP RNOUT,I RETURN. * FILL(BUFR,BLANK); JSB BFILL * & MOVE TITLE LDA FMTAD LDB AW3 JSB .MVW DEF D8 NOP * & CONVERT RN NUMBER * W11 := KCVT(RN); LDA RN JSB KCVT1 STA W11 * & FIND LOCKER * TWORD := IGET(TADDR+RN); LDA TADDR ADA RN LDA A,I STA TWORD * IF (IDNUM := TWORD AND @377)=@377 THEN AND B377 STA IDNUM CPA B377 RSS JMP L548 * & MOVE "" LDA AGLBL LDB AW17 JSB .MVW DEF D5 NOP * ELSE IF IDNUM=0 THEN JMP L553 L548 LDA IDNUM SZA JMP L551 * & MOVE "" JSB .DFER AW18 DEF W18 DEF NONE+4 * ELSE JMP L553 * & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 L551 LDA KYWRD ADA IDNUM LDA A,I ADA D12 CLE,ELA LDB AW18 CLE,ELB JSB .MBT DEF D5 NOP * & FIND OWNER * IF (IDNUM := ROTATE(TWORD) AND @377)=@377 THEN L553 LDA TWORD ALF,ALF AND B377 STA IDNUM CPA B377 RSS JMP L555 * & MOVE "" LDA AGLBL LDB AW11 INB JSB .MVW DEF D5 NOP * ELSE IF IDNUM=0 THEN JMP L560 L555 LDA IDNUM SZA JMP L558 * & MOVE "" JSB .DFER AW13 DEF W13 DEF NONE+4 * ELSE JMP L560 * & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 L558 LDA KYWRD ADA e+ IDNUM LDA A,I ADA D12 CLE,ELA LDB AW13 CLE,ELB JSB .MBT DEF D5 NOP * & PRINT INFORMATION L560 JSB PRINT DEF BUFR D21 DEC 21 * END OF RNOUT; JMP RNOUT,I AW17 DEF W17 * * SUBROUTINE TO PRINT CLASS NUMBER AND ASSIGNED PROGRAM NAME. * CALLING SEQUENCE: * LDA * JSB PRCLS * PRCLS NOP ENTRY. AND B377 ISOLATE NUMBER. SZA,RSS IF NOT ALLOCATED, JMP PRCLS,I RETURN. JSB CNVTD CONVERT TO AW1 DEF W1 ASCII DECIMAL. JSB .DFER MOVE DEF W5 PROGRAM PRGM NOP NAME. JSB PRINT PRINT DEF BUFR INFORMATION. DEC 7 JMP PRCLS,I RETURN. * * & PRINT HEADINGS VALUS NOP * BLINE; JSB BLINE * JSB PRINT DEF VHED1 DEC 8 * BLINE; JSB BLINE * & RESOURCE NUMBERS JSB PRINT DEF VHED2 DEC 20 * GETRN(TADDR,TSIZE); LDA DRNTB GET RN TABLE ADDRESS JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * PRINT ASSIGNED RESOURCE NUMBER INFORMATION LDA RNDES SET UP STA DESCR DESCRIPTION POINTER. LDA RNTAB SET UP RESOURCE STA POINT NUMBER POINTER. LDA NUMRN SET UP LOOP STA CNTR COUNTER. * RLOOP LDA POINT,I PRINT RN JSB RNOUT INFORMATION. DESCR DEF *-* ISZ POINT BUMP LDA DESCR POINTERS. ADA D8 STA DESCR ISZ CNTR IF MORE RNS, JMP RLOOP STAY IN LOOP. * * BLINE; JSB BLINE * ASSIGNED I/O CLASSES JSB PRINT PRINT DEF VHD17 HEADING. B20 DEC 16 LDA CLPRG SET UP PROGRAM STA PRGM NAME POINTER. LDA CLTAB SET UP CLASS STA POINT NUMBER POINTER. LDA NUMCL SET UP LOOP STA CNTR COUNTER. JSB BFILL * CLOOP LDA POINT,I PRINT CLASS JSB PRCLS INFORMATION. ISZ POINT BUMP LDA PRGM POINTERS. ADA D3 STA PRGM ISZ CNTR IF MORE CLASSES, JMP CLOOP STAY IN LOOP. JSB BLINE * & TIMEOUT VALUES JSB PRINT DEF VHD12 DEC 12 * CNUMD(-(MSTO OR @177400)*5,VHD13[10]); LDA #MSTO IOR UPMSK CMA,INA MPY D5 JSB CNVTD DEF VHD13+10 * JSB PRINT DEF VHD13 D13 DEC 13 * CNUMD(-(SVTO OR @177400)*5,VHD14[10]); LDA #SVTO IOR UPMSK MPY D5 CMA,INA JSB CNVTD DEF VHD14+10 * JSB PRINT DEF VHD14 DEC 13 * HOLD1 := KCVT(NOT(ROTATE(BREJ) OR @177760)); LDA #BREJ ALF,ALF IOR MASK2 CMA JSB KCVT1 STA VHD15+12 * JSB PRINT DEF VHD15 DEC 13 * CNUMD(-WAIT,HOLD1); LDA #WAIT CMA,INA JSB CNVTD DEF HOLD1 * MOVII(AHLD2,FADDRESS(VHD16)+12,4); LDA HOLD2 STA VHD16+11 LDA HOLD3 STA VHD16+12 * JSB PRINT DEF VHD16 DEC 13 * LDA #RDLY GET MAX RETRY DELAY. CMA,INA JSB CNVTD DEF VHD18+10 DLD VHD18+10 INCLUDE AND B377 DECIMAL PT. IOR PERID X RRL 8 ROTATE INTO POSITION. DST VHD18+10 STORE. JSB PRINT DEF VHD18 DEC 13 * * BLINE; JSB BLINE * * MAXIMUM HOP COUNT LDA #MHCT CMA,INA JSB CNVTD DEF VHED3+10 JSB PRINT DEF VHED3 DEC 13 * MAXIMUM LINK DOWN COUNT LDA #MDCT CMA,INA JSB CNVTD DEF VHD19+11 JSB PRINT DEF VHD19 DEC 14 * PROGL MESSAGE LU LDA #PRLU JSB CNVTD DEF HOLD1 DLD HOLD2 DST VHED4+9 JSB PRINT DEF VHED4 DEC 11 * * APLDR DOWN-LOAD NODE LDA $OPSY GET THE SYSTEM SPECIFICATION. RAR,RAR SLA FOR NON-RTE-M SYSTEMS, JMP DOLVL THE PROCESS IS COMPLETE. LDA #LNOD GET THE DOWN-LOAD NODE NUMBER. CPA DM1 IF IT HAS NOT BEEN USED, JMP PRAPM THEN IGNORE THE CONVERSION. JSB CNVTD CONVERT TO ASCII, DEF APNOD AND CONFIGURE THE MESSAGE. PRAPM JSB PRINT PRINT NODE NUMBER (OR "NONE"). DEF APMSG DEC 14 * * UPGRADE LEVEL DOLVL LDA #LEVL JSB KCVT1 STA VHED5+8 JSB PRINT DEF VHED5 DEC 9 * * & NUMBER OF FILES WHICH MAY BE OPEN AT ONCE * CNUMD(RFSZ,VHED7[2]); LDA #RFSZ JSB CNVTD DEF VHED7+1 * JSB PRINT DEF VHED7 DEC 15 * & CHECK FOR HP3000 AGAIN * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L611 * BEGIN * BLINE; JSB BLINE * & HP3000 LU * VHED9[10] := KCVT(LU3K); LDA #LU3K JSB CNVTD DEF HOLD1 DLD HOLD2 DST VHED9+9 LDB D11 IF SIGN BIT LDA #QXCL SET IN QUEX Zq SSA CLASS WORD, LDB D15 INCLUDE "DOWN". STB QLULN * JSB PRINT DEF VHED9 QLULN DEF *-* * & BUFFER SIZE LDA D$BSZ JSB CNVTD DEF VHD20+9 JSB PRINT DEF VHD20 DEC 12 * & LOCAL ID SEQUENCE LDA D$LID LOCAL ID POINTER IN "RES" LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0 JMP L603 INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH10 B := DEST ADDRESS JSB .MBT DEF I MOVE CHARACTERS NOP L603 LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L607 * PRINT(VHD10,26+I); ADA D26 CMA,INA STA T3 JSB PRINT DEF VHD10 T3 DEC 0 * & REMOTE ID SEQUENCE L607 LDA D$RID GET REMOTE POINTER IN "RES" INA LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0, JMP L603A INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH11 B := DESTINATION ADDR JSB .MBT DEF I MOVE CHARACTERS NOP L603A LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L611 * PRINT(VHD11,26+I); ADA D26 CMA,INA STA T7 JSB PRINT DEF VHD11 T7 DEC 0 * END; * BLINE; L611 JSB BLINE *END OF VALUS; JMP VALUS,I HED DSINF: DUMP CONTENTS OF DS SAM BLOCK * (C) HEWLETT-PACKARD CO. *PROCEDURE DUMP; * BEGIN * * COMMENT * +--------------------------------------+ * ! DUMP CONTENTS OF DS/1000 SAM BLOCK ! * +--------------------------------------+; * * INTEGER BADDR, & DUMP BEGINNING ADDRESS BADDR BSS 01 * EADDR, & DUMP ENDING ADDRESS EADDR BSS 01 * INCR; & ADDRESS INCREMENT INCR BSS 01 * DHED1 ASC 9, DUMP OF TCB BLOCK DHED2 ASC 25, LOC OCTAL CONTENTS OF LOC THROUGH LOC+6 DHED3 ASC 20, DUMP OF HP3000 TRANSACTION STATUS TABLE PLUS5 ASC 1,+5 PLUS6 ASC 1,+6 * D33 DEC 33 DM1 DEC -1 * PROCEDURE DODMP; DODMP BSS 01 * BEGIN * FILL(BUFR,BLANK); JSB BFILL * FOR I := BADDR STEP INCR UNTIL EADDR DO LDA BADDR STA I L637 CMA,INA ADA EADDR LDB INCR SSB CMA,INA SSA JMP L647 * BEGIN * & CONVERT ADDRESS * CNUMO(I,W2); LDA I JSB CNVTO DEF W2 * FOR J := 0 TO INCR-1 DO CLA STA J CCB ADB INCR STB T1 L641 CMA,INA ADA T1 SSA JMP L645 * & CONVERT CONTENTS * CNUMO(SAM[I+J-FWAM],BUFR[7+4*J]); LDA I ADA J CMA ADA #FWAM CMA JSB .CAX JSB .LAX DEF SAM LDB J RBL,RBL ADB D6 ADB AW1 STB T8 JSB CNVTO T8 DEF *-* LDA J INA STA J JMP L641 * & PRINT L645 JSB PRINT DEF BUFR LEN1 NOP * END; LDA I ADA INCR STA I JMP L637 * BLINE; L647 JSB BLINE * END OF DODMP; JMP DODMP,I * * & GET DS/1000 SAM BLOCK DUMP NOP * GTSAM(SAM[0],SSIZE,PNTR[-3]); e JSB GTSAM * SAMIN := TRUE; CCA STA SAMIN * BLINE; JSB BLINE * & DUMP TCB AREA IN SAM JSB PRINT DEF DHED1 D9 DEC 9 * LDA PLUS5 STA DHED2+24 JSB PRINT DEF DHED2 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := FWAM; LDA #FWAM STA BADDR * EADDR := (IF TST#0 THEN TST ELSE NRV) - 1; LDA #TST SZA,RSS LDA #NRV ADA DM1 STA EADDR * INCR := 6; LDA D6 STA INCR LDA D29 SET LEN1 STA LEN1 TO 29. * DODMP; JSB DODMP * & HP3000 CONNECTED? * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L674 * BEGIN * & DUMP TST AREA IN SAM * JSB PRINT DEF DHED3 DEC 20 * LDA PLUS6 STA DHED2+24 JSB PRINT DEF DHED2 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := TST; LDA #TST STA BADDR * EADDR := FWAM + SSIZE - 1; CCA ADA #FWAM ADA SSIZE STA EADDR * INCR := 7; LDA D7 STA INCR LDA D33 SET LEN1 STA LEN1 TO 33. * DODMP; JSB DODMP * END; * END OF DUMP; L674 JMP DUMP,I HED DSINF: PRINT DS/1000 LISTS * (C) HEWLETT-PACKARD CO. *PROCEDURE LISTS; * BEGIN * * COMMENT * +----------------------------------+ * ! PRINT DS/1000 LIST INFORMATION ! * +----------------------------------+; * * INTEGER COUNT, & # OF ENTRIES IN A LIST COUNT BSS 01 * STCB, & # OF SLAVE TCB ENTRIES STCB BSS 01 * HEAD, & LIST HEAD HEAD BSS 01 * NEXT; & NEXT LIST ELEGMENT NEXT BSS 01 * LHED1 ASC 7, DS/1000 LISTS LHED2 ASC 20, ENTRIES IN MASTER REQUEST LIST, ASC 9, STARTING AT LHED3 ASC 24, ACTIVE SLAVE MONITORS: 1ST TCB LHED4 ASC 24, STREAM CLASS MONITOR ENTRIES LOCATION LHED5 ASC 24, ENTRIES IN NULL LIST, STARTING AT LHED7 ASC 20, ENTRIES IN PROCESS NUMBER LIST, ASC 9, STARTING AT LHED8 ASC 16, ENTRIES IN SLAVE LISTS LHED9 ASC 14, PROG CLASS T/O CTR LHD10 ASC 10, PROG LOGLU BAW5 DBL W5 NOT15 OCT 77777 D2 DEC 2 D19 DEC 19 D39 DEC 39 RSTAR ASC 1, * * * PROCEDURE CHASE; CHASE BSS 01 * BEGIN * COMMENT CHASE A LIST TO ITS END; * COUNT := 0; CLA STA COUNT * WHILE NEXT#0 DO L705 LDA NEXT SZA,RSS * BEGIN JMP L710 * NEXT := SAM[NEXT-FWAM]; LDA #FWAM CMA,INA ADA NEXT JSB .CAX JSB .LAX DEF SAM STA NEXT * COUNT := COUNT + 1; ISZ COUNT * LDA LFLAG LONG FORMAT? SZA,RSS NO-- JMP L705 GET NEXT. * JSB BFILL JSB .ISX GET TCB JSB .LAX WORD 1. DEF SAM AND B377 ISOLATE TIMEOUT. CMA,INA SUBTRACT FROM ADA B377 OCTAL 377. MPY D5 MULTIPLY BY 5. STA T1 SAVE. LDB RSTAR JSB .LAX DEF SAM GET WORD 1. RAL IF "HP 3000" SSA BIT IS SET, STB W4 STORE "*". JSB .ISX GET TCB JSB .ISX WORD 3. JSB .LAX DEF SAM ISOLATE AND B377 CLASS #/LOG LU. STA T2 SAVE. f JSB .ISX POINT TO WORD 4. JSB .LAX DEF SAM GET ID SEG ADDR. ADA D12 POINT TO CLE,ELA NAME (BYTE). LDB BAW5 GET DESTINATION. JSB .MBT DEF D5 MOVE 5 CHARACTERS. NOP LDA T1 CONVERT T/O JSB CNVTD CNTR OR DEST. NODE DEF W11 TO DECIMAL. LDA T2 CONVERT JSB CNVTD CLASS NUMBER OR LU DEF HOLD1 TO DECIMAL. DLD HOLD2 DST W8 JSB PRINT PRINT LINE OF DEF BUFR INFORMATION. LFLAG NOP * * END; JMP L705 * END; L710 LDA COUNT PUT COUNT IN A-REG. JMP CHASE,I RETURN. * * LISTS NOP * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF LHED1 D7 DEC 7 * BLINE; JSB BLINE * & DO WE NEED TO GET SAM AND POINTERS? * IF NOT SAMIN THEN LDA SAMIN SSA JMP L721 * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * & CHECK OUT MASTER REQUEST LIST * HEAD := NEXT := PNTR[-1]; L721 LDA PNTR-1 STA NEXT STA HEAD CLA CLEAR "LONG" STA LFLAG FLAG (FOR CHASE). * CHASE; JSB CHASE * CNUMD(COUNT,LHED2[1]); JSB CNVTD DEF LHED2+1 * CNUMO(HEAD,LHED2[26]); LDA HEAD JSB CNVTO DEF LHED2+26 * PRINT(LHED2,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T2 JSB PRINT DEF LHED2 T2 DEC 0 * LDA HEAD GET HEAD OF LIST. SZA,RSS IF NOTHING THERE, JMP PRBL1 SKIP THE 2ND CHASE. STA NEXT SET UP CHASE POINTER. JSB PRINT PRINT DEF LHED9 HEADING. D14 DEC 14 LDA D13 SET "LONG" STA LFLAG FLAG (FOR CHASE). JSB CHASE DO "LONG" CHASE. * * BLINE; PRBL1 JSB BLINE * & CHECK SLAVE STREAMS CLA CLEAR "LONG" STA LFLAG FLAG (FOR CHASE). JSB PRINT DEF LHED3 DEC 24 JSB PRINT DEF LHED4 DEC 24 * STCB := 0; CLA STA STCB * FOR I := 0 TO LSTRM DO CLA STA I L733 CMA,INA ADA NOSTR SSA JMP L753 * BEGIN * HEAD := IGET(LDEF+2+I); LDA #LDEF ADA D2 ADA I LDA A,I STA HEAD * NEXT := PNTR[I]; JSB .LDX DEF I JSB .LAX DEF PNTR STA NEXT * FILL(BUFR,BLANK); JSB BFILL * & GET MONITOR NAME FROM ID SEGMENT LDA HEAD ADA D2 LDB A,I * (CHECK FOR INACTIVE MONITOR:) SZB,RSS JMP L751A LDB AW11 JSB .MVW DEF D3 NOP * TURN OFF POSSIBLE "NO-ABORT" BIT LDA W11 AND NOT15 STA W11 * W5 := KCVT(I); & STREAM NUMBER LDA I JSB KCVT1 STA W5 * W9 := KCVT(IGET(HEAD+1) AND @377); & CLASS NUMBER LDA HEAD INA LDA A,I AND B377 JSB CNVTD DEF W7 * IF NEXT>0 THEN LDA NEXT SZA SSA JMP L751 * BEGIN * & WE HAVE AN ACTIVE STREAM * CNUMO(NEXT,W21); & STARTING LOCATION JSB CNVTO DEF W21 * CHASE; JSB CHASE * CNUMD(COUNT,W16); & NUMBER OF ENTRIES JSB CNVTD  DEF W16 * JSB PRINT DEF BUFR DEC 23 * STCB := STCB + COUNT; LDA STCB ADA COUNT STA STCB JMP L751A * END; * EMPTY SLAVE LIST-- W18:="0" L751 LDA "0" STA W18 JSB PRINT DEF BUFR DEC 18 *** * END; L751A LDA I INA STA I JMP L733 * & TOTAL NUMBER OF SLAVE TCBS * CNUMD(STCB,LHED8[1]); L753 LDA STCB JSB CNVTD DEF LHED8+1 * JSB PRINT DEF LHED8 DEC 16 * BLINE; JSB BLINE * & NULL LIST * HEAD := NEXT := PNTR[-2]; LDA PNTR-2 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED5[1]); JSB CNVTD DEF LHED5+1 * CNUMO(HEAD,LHED5[21]); LDA HEAD JSB CNVTO DEF LHED5+21 * PRINT(LHED5,29+19*SIGN(HEAD)); LDB D29 LDA HEAD SZA ADB D19 CMB,INB STB T5 JSB PRINT DEF LHED5 T5 DEC 0 * & PROCESS NUMBER LIST * HEAD := NEXT := PNTR[-3]; LDA PNTR-3 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED7[1]); JSB CNVTD DEF LHED7+1 * CNUMO(HEAD,LHED7[26]); LDA HEAD JSB CNVTO DEF LHED7+26 * PRINT(LHED7,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T6 JSB PRINT DEF LHED7 T6 DEC 0 * LDA HEAD GET HEAD OF LIST. SZA,RSS IF NOTHING THERE, JMP PRBL2 SKIP THE 2ND CHASE. STA NEXT SET UP CHASE POINTER. JSB PRINT PRINT DEF LHD10  HEADING DEC 10 LDA D10 SET "LONG" STA LFLAG CHASE FLAG. JSB CHASE DO THE CHASE. * * BLINE; PRBL2 JSB BLINE * SAMIN := FALSE; CLA STA SAMIN * END OF LISTS; JMP LISTS,I HED DSINF: PRINT EQT INFORMATION * (C) HEWLETT-PACKARD CO. *PROCEDURE EQTS; * * COMMENT * +----------------------------------+ * ! PRINT CONTENTS OF DS/1000 EQTS ! * +----------------------------------+; * * BEGIN * EHED3 ASC 15, EQT # , LU # , TYPE EHED4 ASC 18, WORD VALUE MEANING ASC 11, WORD VALUE MEANING BLANK EQU EHED4 EHED6 ASC 12, PARAMETERS/STATISTICS EHED7 ASC 13, FLAG BITS (EQT WORD 26) SPC 1 * BOARD PARAMETER MESSAGE: DO NOT REARRANGE NEXT LINES. ASTDX ASC 14, .... BOARD, FIRMWARE REV. ASTD. ASC 7,YYWW, SPEED: SPDX ASC 5,........, SPD1 ASC 7,..TERNAL CLOCK ASTDN EQU *-ASTDX BPLN2 ASC 3, FCL SPD2 ASC 13, ...ABLED, DIAGNOSTIC HOOD DGH ASC 6, ... SENSED PRLN2 EQU *-BPLN2 SPC 2 * "SPEED SETTING" TABLE FOR FIRMWARE SPTBL DEF *+1 ASC 4,300 BPS ASC 4,1200 BPS ASC 4,2400 BPS ASC 4,4800 BPS ASC 4,9600 BPS ASC 4,19.2KBPS ASC 4,57.6KBPS ASC 4, MAXIMUM * * INTEGER ARRAY EBUFR[1:22]; & HOLDS EQT WORDS EBUFR EQU *-1 BSS 27 * "IN" ASC 1,IN "IO" ASC 1,IO "ST" ASC 1,ST "PA" ASC 1,PA "EN" ASC 2, EN "DIS" ASC 2, DIS "HDLC ASC 3, HDLC "BSC" ASC 3, BSC @HDLC DEF "HDLC @BSC DEF "BSC" "NOT" ASC 2, NOT * @SPDX DEF SPDX @CNVD DEF CNVTD @CNVO DEF CNVTO "0" ASC 1, 0 "1" ASC 1, 1 * INTEGER EQNUM, & EQT NUMBER EQNUM BSS 01 * NOTE: DO NOT CHANGE ORDER OF LUNUM AND OCTAL CONSTANT! LUNUM BSS 01 OCT 3600 SUBFUNCTION FOR XLUEX TYPE BSS 01 * FPNTR, & FORMAT ADDRESS POINTER FPNTR BSS 01 * * AW20 DEF W 20 DM2 DEC -2 DM5 DEC -5 DM8 DEC -8 DM12 DEC -12 DM17 DEC -17 COL1 BSS 1 COL3 BSS 1 OLDSC BSS 1 SPC 1 * * (LYLE WEIMAN'S 11-2-76 VERSION MODIFIED BY DAVE TRIBBY) * * RETRIEVE DS/1000 EQT CONTENTS * * IBUF - BUFFER TO ACCOMODATE 15 WORDS OF EQT + 12 WORD EXTENT * EQTN - I'LL FIND THE FIRST EQT *AFTER* EQTN WHICH IS * DIRECTED TO DRIVER TYPE 65, 66, OR 67 AND RETURN THAT * EQT NUMBER IN EQTN. IF NO EQT IS FOUND, I'LL RETURN * ZERO IN EQTN. * VALUES RETURNED: * LU - AN LU POINTING TO THE EQT * TYPE - DRIVER TYPE (65, 66, OR 67) * GTEQT NOP LDA EQNUM CHECK OUT THE EQT NUMBER... SSA IF NEGATIVE, JMP DONE1 ALL DONE. LDA EQT# IF > NUMBER OF EQTS CMA,INA IN SYSTEM, ERROR! ADA EQNUM SSA,RSS JMP DONE1 * LOOP1 LDA EQNUM GET ADDRESS OF EQT. ISZ EQNUM POINT TO NEXT ONE. MPY D15 ADA EQTA STA EQADR SAVE. ADA D4 CHECK TYPE CODE. LDA A,I ALF,ALF POSITION TO RIGHT BYTE AND B77 AND ISOLATE. STA TYPE CPA B65 FOR DVA65? JMP MOVE YES, GO MOVE IT TO USER AREA CPA B66 SAME THING IF TYPE 66 JMP MOVE CPA B67 OR TYPE 67. JMP MOVE LDA EQNUM NO, WAS IT THE LAST ONE IN CPA EQT# THE SYSTEM? JMP DONE1 YES, ALL DONE! JMP LOOP1 NO, LOOK AGAIN! * * MOVE EQT TO USER BUFFER MOVE LDA EQADR A := SOURCE ADDRESS LDB EQTBF B := DESTINATION JSB $LIBR MAKE SURE EQT ISN'T CHANGED NOP BY HOLDING OFF INTERRUPTS JSB .MVW DEF D15 MOVE 15 WORDS FROM EQT. NOP * MOVE EQT EXTENSION LDA TYPE IF TYPE IS 67, CPA B67 JMP EQEXT SPECIAL CASE. LDA EQADR GET ADDRESS jOF EQT EXTENSION ADA D12 IN EQT WORD 13. LDA A,I SZA,RSS IF THERE ISN'T ANY, JMP ERTN SKIP THE MOVE. MVEQX JSB .MVW MOVE 12 WORD EXTENSION. DEF D12 NOP ERTN JSB $LIBX RESTORE INTERRUPTS. DEF *+1 DEF *+1 * CLA,INA PRESET TO LU 1. STA LUNUM LDA LUMAX GET DRT TABLE SIZE. CMA,INA NEGATE AS COUNTER. STA C0UNT LDB DRT GET DRT ADDRESS. LOOP4 LDA B,I GET DRT ENTRY. AND B77 GET EQT NUMBER. CPA EQNUM IS IT OURS? JMP GTEQT,I YES. ALL DONE: RETURN. ISZ LUNUM NO. INDEX TO NEXT. INB ISZ C0UNT JMP LOOP4 KEEP GOING TILL RUN OUT... * CLA CAN'T FIND AN LU, SET IT = 0. STA LUNUM JMP GTEQT,I RETURN TO CALLER. * * CODE TO SET UP FOR DVG67 EQT EXTENSION EQEXT LDA FSTVL RESOLVE POSSIBLE JSB INDR INDIRECT. JMP MVEQX GO MOVE IT. * * GET HERE IF RUN OUT OF EQTS... DONE1 CLA RETURN WITH EQTN=0. STA EQNUM JMP GTEQT,I RETURN. * CNVRT BSS 1 C0UNT BSS 1 EQADR BSS 1 B65 OCT 65 B66 OCT 66 B67 OCT 67 SPC 3 * SUBROUTINE TO MOVE EQT DESCRIPTION WORD TO PRINT BUFFER. * (A-REG CONTAINS DESTINATION ADDRESS, FPNTR CONTAINS SOURCE, * AND I CONTAINS WORD NUMBER.) CNVRT CONTAINS ADDRESS OF NUMBER * CONVERSION ROUTINE: CNVTO (OCTAL) OR CNVTD (DECIMAL). * EQMOV NOP STA COL1 ADA D2 STA COL2 ADA D4 STA COL3 * COL1 := KCVT(I); & EQT WORD NUMBER (OCTAL CONVERSION ONLY) LDA I JSB KCVT1 LDB CNVRT CPB @CNVD LDA BLANK STA COL1,I * CNVRT(EBUFR[I],COL2); & CONTENTS JSB .LDX DEF I JSB .LAX DEF EBUFR JSB CNVRT,I COL2 DEF *-* * & MOVE MEANING  LDA FPNTR LDB COL3 JSB .MVW DEF D10 NOP * I := I + 1; ISZ I * POINT TO NEXT MEANING LDA FPNTR ADA D10 STA FPNTR * END OF EQMOV; JMP EQMOV,I SPC 3 * SUBROUTINE TO PRINT WORDS IN EQT BUFFER. * BEFORE CALLING, SET UP: * FPNTR - POINTER TO NEXT EQT WORD DESCRIPTION * I - NEXT EQT WORD NUMBER * A-REG - NEGATIVE NUMBER OF WORDS (CNTR) * PRWDS NOP ENTRY. STA CNTR SAVE COUNTER. * ELOOP JSB BFILL CLEAR PRINT BUFFER. LDA AW3 MOVE LEFT JSB EQMOV DESCRIPTION. ISZ CNTR IF LAST WORD JMP MV#2 WAS DESCRIBED, CCA FAKE COUNTER STA CNTR TO -1. JMP PREQI GO PRINT. * MV#2 LDA AW20 MOVE RIGHT JSB EQMOV DESCRIPTION. * PREQI JSB PRINT PRINT DEF BUFR BOTH DEC 36 DESCRIPTIONS. * ISZ CNTR IF MORE TO DO, JMP ELOOP STAY IN LOOP. * JMP PRWDS,I RETURN. SPC 3 * * SUBROUTINE TO PRINT THE CONTENTS OF THE EQT BUFFER. * EQOUT NOP ENTRY. LDA EQNUM CONVERT EQT JSB CNVTD NUMBER AND DEF HOLD1 STORE IN DLD HOLD2 PRINT BUFFER. DST EHED3+3 * LDA LUNUM CONVERT LU JSB CNVTD NUMBER AND DEF HOLD1 STORE IN DLD HOLD2 PRINT BUFFER. DST EHED3+8 * LDA TYPE CONVERT DRIVER JSB CNVTO TYPE AND DEF HOLD1 STORE IN LDA HOLD3 PRINT BUFFER. STA EHED3+14 * JSB BLINE JSB PRINT PRINT DEF EHED3 EQT DEC 15 HEADING. * LDA PBUFR+9 IF THE THIRD PARAMETER CPA "AL" IS "AL" OR "IO", JMP PEQHD PRINT THE EQUIPMENT CPA "IO" TABLE INFORMATION. JMP PEQHD *  LDA TYPE GET DRIVER TYPE. CPA B65 IF 65, JMP EQORT ALL DONE. CPA B66 IF 66, JMP PFLBT PRINT FLAG BITS. JMP LSTAT FOR 67, DO STATS. * * PRINT EQUIPMENT TABLE INFORMATION * PEQHD JSB PRINT DEF EHED4 D29 DEC 29 * * PRINT FIRST 8 WORDS OF EQT. * LDA AEQ1 SET UP DESCRIPTION STA FPNTR POINTER TO EQ1. CLA,INA SET EQT WORD STA I NUMBER TO 1. LDB @CNVO USE OCTAL STB CNVRT CONVERSION. LDA DM8 SET COUNTER TO 8. JSB PRWDS PRINT FIRST 8 WORDS. * LDB TYPE IF TYPE CPB B67 IS 67, JMP LSTAT GO DO LONG-TERM STATS. * LDA DM2 PRINT WORDS JSB PRWDS 9 AND 10. * LDA DM12 ASSUME NEXT COUNT IS 12. LDB TYPE CPB B65 IF TYPE IS 65, JMP DOPR2 DO 2ND PRINT. * * MUST BE TYPE 66. LDA DM17 ASSUME COUNT IS 17. LDB EBUFR+13 IF NO EQT SZB,RSS EXTENSION, LDA DM5 ONLY 5 WORDS LEFT. LDB AEQ66 SET UP DESCRIPTION STB FPNTR POINTER. * DOPR2 JSB PRWDS PRINT REST OF EQT WORDS. * LDB TYPE IF DRIVER TYPE CPB B65 IS 65, JMP EQORT ALL DONE. * * DRIVER TYPE MUST BE 66. LDA EBUFR+13 IF NO SZA,RSS EQT EXTENSION, JMP EQORT RETURN. * * PRINT ANNOTATION OF FLAG BITS (EQT WORD 26) FOR DVA66. * * IF THIS IS THE 2ND EQT OF A PAIR, THEY WILL SHARE THE SAME * INTERFACE, SO DON'T PRINT FLAG BITS OR READ STATISTICS AGAIN. * PFLBT LDA EBUFR+4 GET EQT WORD 4. AND B77 ISOLATE SELECT CODE. CPA OLDSC SAME AS LAST ONE? JMP EQORT YES...RETURN. STA OLDSC SAVE SELECT CODE. SPC 1 JSB BLINE JSB PRINT PRINT HEADING. DEF EHED7 DEC 13 LDA DM4 SET LINE COUNT |6STA CNTR FOR OUTER LOOP. LDA ASTDS SET DESCRIPTION STA HOLD1 POINTER. * IO02 LDB AW3 INITIALIZE INNER LOOP. STB HOLD1+1 LDA DM4 SET BIT COUNT STA T6 FOR INNER LOOP. JSB BFILL FILL THE PRINT LINE WITH BLANKS. * IO03 LDB EBUFR+26 PICK UP THE FLAG BITS. LDA "0" SET A-REGISTER TO "0" SLB OR "1" DEPENDING ON LDA "1" RIGHTMOST BIT. RBR SET UP TO TEST NEXT BIT. STB EBUFR+26 STA HOLD1+1,I STORE "0" OR "1" IN PRINT BUFFER. ISZ HOLD1+1 BUMP DESTINATION ADDRESS FOR MOVE. DLD HOLD1 PICK UP POINTERS. JSB .MVW DEF D8 MOVE DESCRIPTION TO PRINT LINE. NOP DST HOLD1 RESET POINTERS. * ISZ T6 HAVE 4 FIELDS BEEN MOVED? JMP IO03 NO. STAY IN INNER LOOP. * JSB PRINT PRINT THE FOUR DESCRIPTIONS. DEF BUFR DEC 38 * ISZ CNTR HAVE ALL 16 BITS BEEN CONVERTED? JMP IO02 NO. STAY IN OUTER LOOP. SPC 2 JSB BLINE * LDA LUNUM SET XLUEX "DON'T IOR BIT15 USE SST" BIT. STA LUNUM * LDA PBUFR+9 IF THIRD PARAMETER CPA "AL" IS "AL" OR "ST", JMP BOARD READ STATISTICS CPA "ST" FROM THE BOARD. JMP BOARD CPA "PA" IF "PA", READ JUST JMP BORDP THE PARAMETERS. JMP EQORT OTHERWISE ALL DONE! * BOARD JSB XLUEX READ DEF *+6 LONG-TERM DEF SD1 STATISTICS. DEF LUNUM EQTBF DEF EBUFR+1 DEF D11 DEF D2 RSS IF RTE ABORTED CALL RAR,SLA OR IF DRIVER BURPED, JMP DVERR REPORT ERROR. * BORDP JSB XLUEX READ DEF *+6 INTERNAL DEF SD1 PARAMETERS. DEF LUNUM DEF EBUFR+12 DEF D7 DEF D1 RSS IF RTE ABORTED CALL RAR,SLA / OR IF DRIVER BURPED, JMP DVERR REPORT ERROR. SPC 1 * THE 16-BIT QUANTITIES RETURNED BY THE DRIVER ARE IN * INVERTED-BYTE ORDER. REVERSE THEM. * REVRS LDA DM18 STA HOLD1 LDB EQTBF LOOPC LDA B,I LOAD THE DATA WORD, ALF,ALF REVERSE THE BYTES STA B,I AND PUT IT BACK. INB BUMP POINTER. ISZ HOLD1 END OF LOOP? JMP LOOPC NO. CONTINUE REVERSING. * SPC 1 * * PRINT BOARD TYPE, FIRMWARE REVISION CODE, AND SPEED. * LDA EBUFR+12 ISOLATE AND B17 BOARD TYPE. LDB @BSC IF 0, IT'S SZA BSC. OTHERWISE LDB @HDLC IT'S HDLC. STB T10 JSB .DFER DEF ASTDX+1 T10 DEF *-* * LDA EBUFR+13 CONVERT JSB CNVTD REVISION DEF HOLD1 CODE. DLD HOLD2 DST ASTD. * LDA EBUFR+14 GET SPEED INDICATOR ASR 11 FROM ON-BOARD AND B34 SWITCH REGISTER. ADA SPTBL ADD SPEED TABLE ADDRESS. LDB @SPDX DESTINATION ADDRESS. JSB .MVW DEF D4 MOVE SPEED. NOP * LDA EBUFR+14 GET INTERNAL/EXTERNAL AND BIT9 CLOCK INDICATOR. LDB "IN" ASSUME INTERNAL CLOCK. SZA IF EXTERNAL, LDB "EX" MAKE MESSAGE "EXTERNAL". STB SPD1 STORE "IN" OR "EX". * JSB PRINT PRINT. DEF ASTDX ABS ASTDN * * DETERMINE FORCE COLD LOAD AND DIAGNOSTIC HOOD STATUS. * DLD "DIS" ASSUME FCL DST SPD2 DISABLED. LDA EBUFR+14 IF IT'S ENABLED, ALF,ALF SLA,RSS JMP CKDGH DLD "EN" REFORMAT DST SPD2 THE MESSAGE. * CKDGH LDA BLANK ASSUME HOOD LDB A SENSED. DST DGH LDA EBUFR+14 IF IT'S SLA NOT THERE, JMP PRP#2 DLD "NOT" REFORMAT DST DGH THE MESSAGE. * PRP#2 JSB PRINT DEF BPLN2 DEF PRLN2 SPC 1 LDA EBUFR+12 GET BOARD AND B17 TYPE. SZA,RSS SET UP PROPER JMP DOBSC PARAMETERS. * * SET UP HDLC CARD PARAMETERS * LDA EBUFR+16 MAKE T1 TIME-OUT CMA,INA POSITIVE. STA EBUFR+14 LDA EBUFR+15 GET "N2" VALUE AND B377 AND STORE IT STA EBUFR+13 IN WORD 13. XOR EBUFR+15 REMOVE IT FROM ALF,ALF WORD 15. STA EBUFR+12 STORE "K" VALUE. LDA ADESC SET UP STA FPNTR DESCRIPTION PNTR. LDA DM14 NUM OF WORDS STA HOLD1 IS 14. JMP CHKPA * * SET UP BSC CARD PARAMETERS * DOBSC LDA EBUFR+18 MOVE DATA STA EBUFR+12 BLOCK SIZE. LDA EBUFR+17 GET CONNECT AND B377 TIMER AND STORE STA EBUFR+14 IN WORD 14. XOR EBUFR+17 REMOVE FROM WORD 17, ALF,ALF MOVE RETRY TO RIGHT BYTE, STA EBUFR+13 AND STORE IN WORD 13. LDA EBUFR+16 ISOLATE MODE AND B377 AND STORE BACK STA EBUFR+16 IN WORD 16. LDA BDESC SET DESCRIPTION STA FPNTR POINTER. LDA DM16 NUMBER OF WORDS STA HOLD1 IS 16. * * PRINT PARAMETERS AND (POSSIBLY) STATISTICS * CHKPA JSB BLINE LDA @CNVD USE DECIMAL STA CNVRT CONVERSION. LDA PBUFR+9 IF ONLY THE PARAMETERS CPA "PA" ARE NEEDED, USE JMP IOX2 THE SHORT SETUP. * * SET UP TO PRINT BOTH * CLA,INA WORD NUMBER STA I IS SET TO 1. LDA D12 HEADING IS STA T9 24 CHARACTERS. JMP IOX3 GO PRINT. * * SET UP TO PRINT JUST PARAMETERS * IOX2 LDA D12 START WITH STA I WORD 12. LDA DM13 HEADING IS STA T9 13 CHARACTERS. LDA FPNTR ADD 110 TO ADA D110 PARAMETER STA FPNTR ^i POINTER LDA HOLD1 AND 11 TO ADA D11 LOOP STA HOLD1 COUNTER. * IOX3 JSB PRINT PRINT DEF EHED6 HEADING. T9 DEF *-* LDA HOLD1 LOAD WORD COUNT. JSB PRWDS GO PRINT. JMP EQORT RETURN. SPC 1 * * PRINT MESSAGE WHEN INFORMATION CALL TO DVA66 FAILS. * DVERR JSB PRINT PRINT "DRIVER DEF DEVER ERROR". DEC 12 JMP EQORT RETURN. * DEVER ASC 12, DRIVER REPORTS ERROR SPC 1 BIT9 OCT 1000 BIT15 OCT 100000 B34 OCT 34 DM4 DEC -4 DM13 DEC -13 DM14 DEC -14 DM16 DEC -16 DM18 DEC -18 D110 DEC 110 SPC 2 * * TYPE IS 67. PRINT SLC LONG TERM STATISTICS. LSTAT JSB BLINE JSB PRINT PRINT DEF SHEAD HEADING. DEC 13 LDA MSGTB INITIALIZE STA FPNTR MESSAGE POINTER. LDA D16 I := 16. STA I LDA @CNVD SET UP DECIMAL STA CNVRT CONVERSION. LDA DM11 SET UP COUNTER FOR 11 FIELDS. JSB PRWDS PRINT STATISTICS. * BLINE; EQORT JSB BLINE JMP EQOUT,I RETURN. SPC 3 * * "EQ" COMMAND STARTS HERE * EQTS NOP ENTRY FOR EQ COMMAND. CLA CLEAR "OLD" STA OLDSC SELECT CODE. JSB BLINE * LDA CONWD IF THIS IS A SZA NON-INTERACTIVE RUN, JMP L857 SET UP TO PRINT IO INFO. * * PARSE INPUT BUFFER FOR "EQ,N" AND STATISTICS OPTIONS * JSB PARSE DEF *+4 DEF FNCTN DEF RDLEN DEF PBUFR LDA INEQT IF "N" NOT SZA,RSS SPECIFIED, JMP L857A PRINT ALL DS EQTS. SSA IF NEGATIVE, JMP EQTS,I RETURN. ADA DM1 STA EQNUM GET EQT JSB GTEQT INFO. LDA INEQT WAS IT CPA EQNUM THE ONE SPECIFIED? JSB EQOUT YES--PRINT THE EQT. JMP EQTS,I RETURN. b SPC 1 * PRINT ALL DS/1000 EQTS: * L857 LDA "AL" FOR NON-INTERACTIVE RUN, STA PBUFR+9 PRINT EVERYTHING. * * & SEARCH ALL EQTS * EQNUM := 0; L857A CLA STA EQNUM * DO * BEGIN * GTEQT(EBUFR[1],EQNUM,LUNUM); L860 JSB GTEQT * IF EQNUM#0 THEN LDA EQNUM SZA,RSS JMP EQTS,I * CALL SUBROUTINE TO PRINT EQT INFORMATION JSB EQOUT * END * UNTIL EQNUM=0; JMP L860 SPC 2 PBUFR BSS 33 PARSE BUFFER INEQT EQU PBUFR+5 SECOND PARAMETER * * & EQT WORDS DESCRIPTIONS--20 CHARACTERS EACH AEQ1 DEF *+1 ASC 10,I/O LIST ADDRESS ASC 10,INITIATION ADDRESS ASC 10,CONTINUATION ADDR ASC 10,FLAGS/SUBCHNL/SC ASC 10,AV/TYPE/STATUS ASC 10,CONWD ASC 10,DATA BUFFER ADDRESS ASC 10,DATA BUFFER LENGTH ASC 10,REQUEST BUFFER ADDR ASC 10,REQUEST BUFFER LEN ASC 10,COROUTINE ADDRESS ASC 10,CURRENT STATUS ASC 10,EQT EXTENSION ADDR ASC 10,NOMINAL TIMEOUT ASC 10,TIMEOUT CLOCK ASC 10,MICROCODE COUNT ASC 10,LAST WORD RECEIVED ASC 10,VERTICAL PARITY WORD ASC 10,DIAGONAL PARITY WORD ASC 10,TOTAL BLOCK TRANSFERS ASC 10,TOTAL WRITE RETRIES ASC 10,LU NUMBER * * EQT DESCRIPTIONS FOR DVA66 AEQ66 DEF *+1 ASC 10,SERVICING PROCESS ASC 10,ASSOCIATED EQT ASC 10,EQT EXTENSION ADDR ASC 10,NOMINAL TIMEOUT ASC 10,TIMEOUT CLOCK ASC 10,RETRY CNTR/READ PNTR ASC 10,1ST READ LEN/SKIP CT ASC 10,2ND READ LEN/SKIP CT ASC 10,FRAME LENGTH ON CARD ASC 10,WRITE POINTER ASC 10,WRITE BUFFERS LENGTH ASC 10,MAX PSI FRAME SIZE ASC 10,NUM OUTPUT BUFFERS ASC 10,READ CONT ADDRESS ASC 10,WRITE CONT ADDRESS ASC 10,FLAG BITS ASC 10,MISCELLANEOUS BITS * * DESCRIPTION OF FLAG BITS (IN EXTENSION WORD # 12) * ASTDS DEF *+1 ASC 8, READ ABORTED BIT 0 ASC 8, WRITE ABORTED 1 ASC 8, RD RQ PENDING 2 ASC 8, WT RQ PENDING 3 ASC 8, BKPL LOCKED RP 4 ASC 8, BKPL LOCKED WP 5 ASC 8, SHORT TO ACTIVE 6 ASC 8, MED. T.O ACTIVE 7 ASC 8, LONG T.O ACTIVE 8 ASC 8, CONNECTED 9 ASC 8, START OF MSG. 10 ASC 8, NON-DS MODE 11 ASC 8, ASKED TO CONNCT 12 ASC 8, SEVERE ERROR 13 ASC 8, P-F RECONNECT 14 ASC 8, RFP WAIT 15 SPC 1 * * STATISTICS AND PARAMETER DESCRIPTIONS * * HDLC BOARD * ADESC DEF *+1 ASC 10,GOOD I-FRAMES RCVD ASC 10,RR FRAMES RECEIVED ASC 10,RNR FRAMES RECEIVED ASC 10,REJECT FRAMES RCVD ASC 10,RCV PROC OVERRUNS ASC 10,CRC ERRORS ASC 10,ABORT SEQ. RECEIVED ASC 10,RECIVER OVERRUNS ASC 10,RX BUFFER OVERFLOWS ASC 10,FRAMES W/BAD ADDR ASC 10,CMDR FRAMES RCVD * PARAMETERS: ASC 10,UNACK FR WINDOW SIZE ASC 10,N2 RETRY COUNT ASC 10,T1 T.O. IN 0.01 SEC * * BSC BOARD * BDESC DEF *+1 ASC 10,GOOD BLOCKS SENT ASC 10,GOOD BLOCKS RCVD ASC 10,BAD BLOCKS RECEIVED ASC 10,NAKS RECEIVED ASC 10,WACKS SENT ASC 10,WACKS RECEIVED ASC 10,TTDS SENT ASC 10,TTDS RECEIVED ASC 10,RESPONSE ERRORS ASC 10,3 SECOND TIMEOUTS ASC 10,LINE ERRORS * PARAMETERS: ASC 10,BLOCK SIZE (BYTES) ASC 10,RETRY LIMIT ASC 10,CONNECT TIMER ASC 10,TRACE SIZE (BYTES) ASC 10,MODE SPC 3 * SHEAD ASC 13, SLC LONG TERM STATISTICS MSGTB DEF *+1 ASC 10,READ REQUESTS ASC 10,WRITE REQUESTS ASC 10,MESSAGES TRANSMITTED ASC 10,SPURIOUS INTERRUPTS ASC 10,LINE ERRORS ASC 10,NAKS RECEIVED ASC 10,BCC/PARITY ERRORS ASC 10,LONG TIMEOUTS ASC 10,RESPONSE ERRORS ASC 10,RESPONSE REJ ASC 10,WACK/TTD RECEIVED EXT D$XS5 FSTVL DEF D$XS5+1 * HED DSINF: PRINT LU INFORMATION * (C) HEWLETT-PACKARD CO. * +---------------------------------+ * ! PRINT INFORMATION ON DS/1000 LU ! * +---------------------------------+ SPC 1 * NOTE: THE LU COMMAND WAS ADDED FOR COMPATIBILITY WITH DSINL, * THE VERSION OF DSINF FOR RTE-L (WRITTEN BY LYLE WEIMAN). * THE LU MUST BE SPECIFIED IN THE COMMAND (TO GET ALL LUS, * USE THE EQ COMMAND) AND IT IS NOT ACCESSABLE VIA RUN-TIME * PARAMETER 5. THE EQ COMMAND IS RETAINED BECAUSE IT IS * POSSIBLE SOME EQTS MAY NOT BE POINTED TO BY AN LU. SPC 1 LUS NOP ENTRY FOR LU COMMAND. CLA CLEAR "OLD" STA OLDSC SELECT CODE. JSB BLINE * PARSE INPUT BUFFER FOR LU NUMBER AND STATISTICS OPTION JSB PARSE DEF *+4 DEF FNCTN DEF RDLEN DEF PBUFR LDA INEQT IF "N" NOT SZA SPECIFIED, SSA OR NEGATIVE, JMP LUS,I RETURN. CMA,INA IF GREATER ADA LUMAX THAN LARGEST SSA LU NUMBER, JMP LUS,I RETURN. * LDA INEQT ADA DM1 ADA DRT GET EQT LDA A,I NUMBER FROM AND B77 DRT. STA INEQT SZA,RSS IF ZERO, JMP LUS,I RETURN. ADA DM1 STA EQNUM GET EQT JSB GTEQT INFORMATION. LDA INEQT IF LU POINTED CPA EQNUM TO A GOOD EQT, JSB EQOUT PRINT INFO. * JMP LUS,I RETURN. UNL IFN LST HED DSINF: PRINT NRV * (MC) HEWLETT-PACKARD CO. * NRV DISPLAY ROUTINE. * DSNRV NOP ENTRY. LDA #NCNT GET NEGATIVE NO. OF NODES. STA NCNT SAVE THE NUMBER OF NODES. CMA,INA,SZA,RSS ANYTHING SPECIFIED? JMP DSNRV,I NO--IGNORE THE REQUEST! * JSB CNVTD CONVERT TO ASCII. DEF NNODS * JSB BLINE * LDA #NODE GET LOCAL NODE NUMBER. JSB CNVTD CONVERT IT TO ASCII. DEF LOCLN JSB PRINT PRINT THE FIRST MESSAGE. DEF NODM1 DEC 10 JSB PRINT DEF NODM2 DEC 21 JSB BLINE JSB PRINT DEF NODM3 DEC 25 * LDA #NRV GET THE NRV ADDRESS, STA NPNT AND SAVE THE POINTER. * DLOOP JSB BFILL CLEAR THE PRINT BUFFER. * LDB NPNT GET A NODE NUMBER. JSB IXGET ISZ NPNT ADVANCE THE POINTER. SSA IF < 0, JMP BLENT IT'S A BLANK ENTRY. JSB CNVTD CONVERT. DEF W3 * LDB NPNT GET TIMEOUT/UPGRADE. JSB IXGET AND B17 ISOLATE THE UPGRADE. JSB CNVTD CONVERT. DEF W22 * LDB NPNT GET TIMEOUT/UPGRADE, AGAIN. JSB IXGET ISZ NPNT ADVANCE POINTER. ALF,ALF POSITION THE TIMEOUT AND B377 TO THE LOWER BYTE. SZA IF =0, THEN NO FILLING NEEDED. IOR DM256 FILL-IN THE UPPER BYTE. CMA,INA MAKE THE VALUE POSITIVE (OR 0). MPY D5 MULTIPLY BY FIVE. JSB CNVTD CONVERT. DEF W15 * LDB NPNT GET NEIGHBOR/LU. JSB IXGET AND B377 ISOLATE THE LU. STA T7 JSB CNVTD CONVERT. DEF W6 * LDB NPNT GET NEIGHBOR/LU JSB IXGET AGAIN. ISZ NPNT AND NBIT ISOLATE NEIGHBOR BIT. LDB LSTAR IF SET, PUT A SZA STAR NEXT TO STB W6 THE NODE NUMBER. * LDA T7 IF LU IS A SZA,RSS ZERO (LOCAL), JMP PRNRV READY TO PRINT. * CMA,INA IF LU IS ADA LUMAX GREATER SSA,RSS THAN MAXIMUM, JMP LUINF LDA STARS PUT ASTERISKS STA W11 IN EQT AND STA W13 SUBCHANNEL FIELDS. JMP PRNRV GO PRINT. * * GOOD LU NUMBER. GET DRT INFORMATION. * LUINF CCA CALCULATE ADA DRT DRT ENTRY ADA T7 ADDRESS. LDA A,I GET CONTENTS. STA T2 AND B377 ISOLATE EQT NO. STA T3 JSB KCVT1 CONVERT TO DECIMAL. STA W11 * LDA T2 CLB LSR 11 ISOLATE SUBCHANNEL. JSB KCVT1 CONVERT TO DECIMAL. STA W13 * CCA CALCULATE ADA T3 EQT ENTRY MPY D15 ADDRESS. ADA EQTA ADA D4 GET WORD LDA A,I FIVE. ALF,ALF ISOLATE DEVICE AND B77 TYPE. JSB CNVTO CONVERT TO DEF W19 OCTAL. * PRNRV JSB PRINT PRINT NODAL DEF BUFR INFORMATION. DEC 24 * ISZ NCNT ANY MORE TO PROCESS? JMP DLOOP YES, CONTINUE. * JSB BLINE JSB PRINT PRINT BOTTOM DEF NODM4 LINE. DEC 15 JSB BLINE * JMP DSNRV,I PROCESS COMPLETE--CHECK FOR NEW REQUEST. SPC 1 BLENT LDA @BLNK SET UP LDB AW3 "BLANK" JSB .MVW DEF W9 MESSAGE. NOP ISZ NPNT BUMP POINTER. ISZ NPNT JMP PRNRV GO PRINT. SPC 2 @BLNK DEF *+1 ASC 9,** BLANK ENTRY ** LSTAR ASC 1,* NBIT BYT 1,0 NODM1 ASC 10, NRV SPECIFICATIONS: NODM2 ASC 7, LOCAL NODE#: LOCLN ASC 3, ASC 8,, NO. OF NODES= NNODS ASC 3, * NODM3 ASC 22, NODE LU EQT SUB T/O(SEC) TYPE ASC 3, LEVEL NODM4 ASC 15, (* INDICATES NEIGHBOR) * DM256 DEC -256 * NCNT NOP +E NUMBER OF NODES NPNT NOP HED DSINF: MESSAGE ACCOUNTING * (C) HEWLETT-PACKARD CO. * +--------------------------------------+ * ! PRINT MESSAGE ACCOUNTING INFORMATION ! * +--------------------------------------+ SPC 1 MAHD1 ASC 16, MESSAGE ACCOUNTING INFORMATION MAHD2 ASC 22, NODE STATE # UNACK # LINEDOWNS TIMEOUT * @STBL DEF *+1 MA STATE TABLE "DOWN ASC 8,DOWNNONEUP PEND * NODE# NOP #DOWN NOP #UNAK NOP #TMAX NOP SPC 2 MSACT NOP ENTRY. JSB BLINE JSB PRINT PRINT HEAD. DEF MAHD1 DEC 16 * LDA #MCTR GET # OF ENTRIES. SZA,RSS IF NONE, JMP NOMA REPORT THE FACT. STA CNTR * JSB BFILL CLEAR PRINT BUFFER. * JSB BLINE JSB PRINT PRINT HEAD. DEF MAHD2 DEC 22 * LDB #MCTR+1 GET ADDRESS OF TABLE. ELB,CLE,ERB CLEAR DEBUG BIT. * CYCLE STB PNTR STORE ENTRY ADDRESS. JSB IXGET GET NODE #. SSA IF NEGATIVE, JMP EOC IT'S A DUMMY. STA NODE# SAVE NODE #. * INB GET STATE JSB IXGET WORD. CLB LSL 4 SHIFT IN # STB #UNAK UNACKNOWLEDGED. LSL 2 THROW AWAY CLB TWO BITS. LSL 8 MOVE IN STB #TMAX TIMEOUT. * ALF,RAR A-REG = OFFSET INTO TABLE. ADA @STBL GET ADDRESS OF STATE. DLD A,I GET 4-CHAR DESCRIPTION. DST W5 STORE IN PRINT BUFFER. * LDB PNTR GET WORD ADB D7 NUMBER 7 JSB IXGET (DOWN). LSL 4 CLB LSR 4 STA #DOWN * LDA NODE# CONVERT JSB CNVTD INFORMATION DEF W1 TO LDA #DOWN ASCII. JSB CNVTD DEF W14 LDA #UNAK JSB CNVTD DEF W8 LDA #TMAX JSB CNVTD DEF W19 * JSB PRINT } PRINT DEF BUFR INFORMATION. DEC 21 * EOC LDB PNTR ADVANCE ADB D10 POINTER. ISZ CNTR IF MORE ENTRIES, JMP CYCLE STAY IN LOOP. * JMP EOMA ALL DONE. SPC 2 NOMA JSB PRINT PRINT DEF NOENT "NO ENTRIES" DEC 6 MESSAGE. SPC 1 EOMA JSB BLINE JMP MSACT,I RETURN. HED DSINF: NODAL REROUTING * (C) HEWLETT-PACKARD CO. * +-----------------------------------+ * ! PRINT NODAL REROUTING INFORMATION ! * +-----------------------------------+ SPC 1 RRHD1 ASC 13, REROUTING SPECIFICATIONS: RRHD2 ASC 11, UP/DOWN RRHD3 ASC 15, LU COST COUNTER STATUS "UP" ASC 2, UP SPC 2 RRTNG NOP ENTRY. JSB BLINE JSB PRINT PRINT HEAD. DEF RRHD1 DEC 13 * LDA #LCNT GET # OF ENTRIES. SZA,RSS IF NONE, JMP NORR REPORT THE FACT. CMA,INA MAKE NEGATIVE STA CNTR LOOP COUNTER. * JSB PRINT PRINT HEADS. DEF RRHD2 DEC 11 JSB PRINT DEF RRHD3 DEC 15 * JSB BFILL CLEAR PRINT BUFFER. * LDB #LV GET ADDRESS OF TABLE. STB PNTR STORE POINTER. * LOOPR LDB PNTR GET JSB IXGET BITS/LU #. CLE,ELA POSITION IN E. DLD "UP" SET PROPER MESSAGE IN SEZ PRINT BUFFER. JMP SUD DLD "DOWN SUD DST W13 * LDB PNTR JSB IXGET GET LU AGAIN. AND B377 ISOLATE IT. JSB CNVTD CONVERT TO ASCII. DEF W1 * ISZ PNTR LDB PNTR GET JSB IXGET COST. JSB CNVTD CONVERT TO ASCII. DEF W4 * LDB PNTR ADB D3 JSB IXGET GET UP/DOWN COUNTER. ADB D2 POINT TO STB PNTR NEXT ENTRY. CMA,INA MAKE COUNTER POSITIVE. JSB CNVTD CONVERT TO ASCII(4. DEF W8 * JSB PRINT PRINT DEF BUFR THE DEC 14 LINE. * ISZ CNTR IF MORE TO DO, JMP LOOPR STAY IN LOOP. JMP EORR SPC 2 NORR JSB PRINT PRINT DEF NOENT "NO ENTRIES". DEC 6 SPC 1 EORR JSB BLINE JMP RRTNG,I RETURN. UNL XIF LST HED DSINF: REMOTE SESSIONS * (C) HEWLETT-PACKARD CO. * +----------------------------------+ * ! PRINT REMOTE SESSION INFORMATION ! * +----------------------------------+ SPC 1 RSHD1 ASC 21, REMOTE SESSIONS ESTABLISHED AT THIS NODE RSHD2 ASC 11, SOURCE SESSION ID RSHD3 ASC 20, NODE SOURCE LOCAL TIMER PROGRAM RSHD4 ASC 10, EMPTY ENTRIES CLONE ASC 4,(CLONE) @CLON DEF CLONE HFLAG NOP NOTUS NOP CLONI NOP AW21 DEF W21 D60 DEC 60 SPC 2 RMSES NOP ENTRY. JSB BLINE JSB PRINT PRINT HEAD. DEF RSHD1 DEC 21 JSB BLINE * CLA CLEAR STA HFLAG HEADING FLAG STA NOTUS AND REM SES COUNT. LDB #POOL GET # OF REMOTE JSB IXGET SESSION ENTRIES. SZA,RSS IF NONE, JMP NORS REPORT "NO ENTRIES". STA CNTR STORE # OF ENTRIES. INB SET POINTER TO 1ST ENTRY. STB PNTR * RSMLP LDB PNTR JSB IXGET GET FIRST WORD OF ENTRY. SSA IF SIGN BIT IS SET, JMP USED ENTRY IS IN USE. * * EMPTY ENTRY FOUND * ISZ NOTUS BUMP UNUSED ID COUNTER. LDB PNTR POINT TO ADB D7 NEXT ENTRY. STB PNTR JMP ENRLP GO TO END OF LOOP. SPC 1 * * ENTRY FOUND IN USE. PRINT INFORMATION. * USED LDA HFLAG GET HEADING FLAG. SZA IF SET, PRINT ENTRY. JMP PRENT * ISZ HFLAG SET HEADING FLAG. JSB PRINT PRINT HEADINGS. DEF RSHD2 DEC 11 JSB PRINT DEF RSHD3 DEC 20 * PRENT JSB BFILL FILL PRINT LINE WITH BLANKS. * JSB IXPTR GET FIRST WORD. STA CLONI SAVE TEMPORARILY. AND B377 ISOLATE LOCAL SESSION ID. JSB CNVTD CONVERT TO DECIMAL DEF W9 AND PUT IN PRINT LINE. * JSB IXPTR GET SOURCE NODE. JSB CNVTD CONVERT TO DECIMAL DEF W2 AND PUT IN PRINT LINE. * LDA CLONI GET CLONE INDICATOR. AND BIT14 SZA,RSS IF NOT SET, JMP GTSRC GO GET SOURCE ID. * LDA @CLON MOVE LDB AW21 "(CLONE)". JSB .MVW DEF D4 NOP * GTSRC JSB IXPTR GET NEXT WORD. AND B377 ISOLATE SOURCE ID WORD. JSB CNVTD CONVERT TO DECIMAL DEF W6 AND PUT IN PRINT BUFFER. * JSB IXPTR GET PROGRAM SZA NAME. IF NON-0, STA W18 STORE CHAR 1 & 2. JSB IXPTR SZA STA W19 STORE CHAR 3 & 4. JSB IXPTR SZA,RSS JMP GTIMR AND UPMSK IOR B40 STA W20 STORE CHAR 5. * GTIMR JSB IXPTR GET # SEC/5. CLB DIVIDE BY 12 DIV D12 FOR MINUTES. STB SEC MULTIPLY REMAINDER CLE,ELB BY 5 FOR # OF ELB SECONDS. ADB SEC STB SEC CLB DIV D60 DIVIDE BY 60 STB MIN FOR HOURS. STA HOUR * LDA SEC CONVERT JSB KCVT1 SECONDS IOR "00" TO STA W16 ASCII LDA MIN CONVERT JSB KCVT1 MINUTES. IOR "00" LDB COLON RRR 8 DST W14 LDA HOUR CONVERT JSB KCVT1 HOURS. STA W13 * JSB PRINT PRINT ENTRY DEF BUFR INFORMATION. DEC 24 * * END OF REMOTE SESSION LOOP * ENRLP ISZ CNTR IF MORE TO DO, JMP RSMLP STAY IN LOOP. * JSB BLINE gDB> LDA NOTUS JSB CNVTD DEF RSHD4 JSB PRINT PRINT NUMBER DEF RSHD4 OF FREE REMOTE DEC 10 SESSION ENTRIES. JMP EORS SPC 2 NORS JSB PRINT PRINT DEF NOENT "NO ENTRIES". DEC 6 SPC 1 EORS JSB BLINE JMP RMSES,I RETURN. SPC 3 * SUBROUTINE TO LOAD CONTENTS OF PNTR FROM SYSTEM MAP INTO A-REG. IXPTR NOP ENTRY. LDB PNTR LOAD ADDRESS. JSB IXGET (CROSS) LOAD CONTENTS. ISZ PNTR BUMP PNTR. JMP IXPTR,I RETURN. HED DSINF: LARGE BUFFER FOR SAM * (C) HEWLETT-PACKARD CO. NOENT ASC 6, NO ENTRIES * SAM BSS 740 SPC 2 PNTR EQU *+3 POINTERS INTO SAM BSS LSTRM+4 SPC 1 BSS 0 SIZE OF DSINF SPC 1 UNS END DSINF |D :S 91750-18079 2013 S C0122 &DSINL              H0101 ASMB,Q,C,N HED DSINF(L): DS/1000 INFORMATION -- L-SERIES VERSION (C) HP CO. IFN NAM DSINF,23,65 91750-16079 REV.2013 800612 L EXT DEXEC,D#OPS XIF IFZ * NAM DSINF,23,65 NO Z-OPTION FOR L VERSION! XIF SPC 1 SUP A EQU 0 B EQU 1 EXT $LIBR,$LIBX,$OPSY,PARSE,KCVT,CNUMO,CNUMD EXT EXEC,RMPAR,$CLTA,$RNTA,.DFER,PGMAD EXT .MVW,.MBT,.CBT,.LAX,.LDX,.ISX,.CAX,.DSX EXT $MM,$LUTA,$LUT#,$IDA,$ID#,$IDSZ,$LUT# SPC 1 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: DSINF *SOURCE: 91750-18079 * RELOC: 91750-16079 * PGMR: LYLE WEIMAN LST ******************************************** * * * NAME: DSINF(L) * * (DS INFORMATION, L-SERIES VERSN) * * * * SOURCE: 91750-18079 * * * * RELOCATABLE: 91750-16079 (N-OPTION) * * NO Z-OPTION FOR L-SERIES * * * * PROGRAMMERS: DMT/LAW * * * * DATE: JULY 1979 * * * ******************************************** SPC 3 * THE ORIGINAL CODE FOR THIS PROGRAM WAS WRITTEN IN HP ALGOL. * MODIFICATIONS HAVE BEEN INTRODUCED SINCE TRANSLATION TO * ASSEMBLY LANGUAGE! SPC 3 * ASSE#MBLY OPTIONS: * N 1000-1000 AND 1000-3000 VERSION * Z 1000-3000 ONLY (NO DEXEC, NRV, MA, OR REROUTING) * NOTES: 1) THE "Z" OPTION IS NOT AVAILABLE ON L-SERIES COMPUTERS, * BECAUSE NO HP 3000 LINK EXISTS. * 2) THE CODE TO CONFIGURE INSTRUCTIONS FOR MAPPED-MEMORY * HAS BEEN MADE INTO COMMENTS. SKP *RUN FROM RTE WITH * RU,DSINF,,,,, *THE RUN-TIME PARAMETERS HAVE THESE MEANINGS: * * THE LOGICAL UNIT NUMBER OF THE INPUT DEVICE. THE DEFAULT * IS THE NUMBER OF THE SCHEDULING TERMINAL PASSED BY M-T-M * OR 1. IF THE INPUT DEVICE IS INTERACTIVE A PROMPT IS * PRINTED ON THE DEVICE BEFORE EACH READ. * * THE LOGICAL UNIT NUMBER OF THE DEVICE WHERE INFORMATION IS * PRINTED. THE DEFAULT IS THE INPUT LU (IF INTERACTIVE) OR 6. * * A CONTROL WORD WHICH SPECIFIES DSINF WILL BE RUN NON- * INTERACTIVELY. THE FUNCTIONS WHICH TAKE PLACE ARE * DETERMINED BY THE BITS SET: * * DECIMAL * VALUE PRINT THIS INFORMATION * ------- ------------------------------ * 1 AVAILABLE MEMORY SUSPEND LIST * 2 I/O CLASSES * 4 DS/1000 VALUES * 8 DUMP OF SAM BLOCK * 16 DS/1000 LISTS * 32 NODAL ROUTING VECTOR * 64 DS/1000 DVT ENTRIES * 128 MESSAGE ACCOUNTING * 256 REROUTING * * FOR EXAMPLE, TO PRINT THE I/O CLASS AND DS/1000 VALUES * ON YOUR TERMINAL, TYPE RU,DSINF,,,6. * * THE NODE NUMBER WHERE I/O IS TO OCCUR. DEFAULT IS LOCAL * NODE (-1). * * SET TO A NON-ZERO VALUE WHEN THE NODE NUMBER IS 0 (TO * DISTINGUISH IT FROM THE DEFAULT). * *DSINF RECOGNIZES THE FOLLOWING COMMANDS: * AV AVAILABLE MEMORY SUSPEND LIST * CL I/O CLASSES * VA F DS/1000 VALUES * DU DUMP OF SAM BLOCK * LI DS/1000 LISTS * NR OR /N NODAL ROUTING VECTOR * LU[,,XX] DS/1000 DVT ENTRIES * LU,N[,XX] PRINT INFORMATION ON LU# N * MA MESSAGE ACCOUNTING * RR REROUTING * EX OR /E TERMINATE DSINF * *ALL OTHER CHARACTERS CAUSE THE FUNCTIONS TO BE LISTED ON THE *OUTPUT DEVICE.; SPC 3 * * THE LU COMMAND USES A THIRD PARAMETER WHICH CAN HAVE THESE VALUES: * CODE PRINT THIS INFORMATION * ---- ---------------------- * (NONE) LU, DVT, AND DRIVER TYPE \ ALWAYS * FLAG BITS (DRIVER 66) / PRINTED * IO DVT WORDS * PA FOR DVA66: INTERFACE PARAMETERS * ST FOR DVA66: INTERFACE PARAMETERS AND STATISTICS * AL ALL OF THE ABOVE * * IF THE PARAMETERS OR STATISTICS ARE READ FROM A DVA66 CARD, THE * DRIVER IS CALLED. IF THE BOARD IS DOWN OR THE DRIVER HAS A LONG * QUEUE, DSINF MUST WAIT. * * HERE IS A SAMPLE PRINTOUT OF A DVA66 ENTRY: * LU # 23, TYPE 66 * WORD VALUE MEANING WORD VALUE MEANING * 1 177777 DVT LINK WORD 2 0 Q!RQST INITIATION LI * 3 31000 N!CIRCULAR NODE LIST 4 31024 P!CIRCULAR DVT LIST * 5 31603 X!IFT REFERENCE 6 33004 AV!TYPE!STATUS * 7 1 SYSTEM FLAGS!LU LOCK 8 0 B!BUFFER ACCUM. * 9 11060 S! HL-LL/16! LL/16 10 0 RESERVED * 11 177777 T.O. LIST 12 0 DEVICE T.O. VALUE * 13 0 I/F T.O. VALUE 14 0 DEVICE DVR ADDR * 15 150101 TY!E!Z!SUBFN!RQ 16 0 RQ.PARM/ERR CODE * 17 0 RQST PARAM2/XLOG 18 22 RQST PARAM3/EXT STAT * 19 24 RQST PARAM4/EXT STAT 20 177766 RETRY CNTR/READ PNTR * 21 0 1ST READ LEN/SKIP CT 22 0 2ND READ LEN/READ CT * 23 0 READY FRAME LENGTH 24 34564 WRITE POINTER * 25 Z0 0 WRITE BUFFERS LENGTH 26 1000 MAX PSI FRAME SIZE * 27 0 NUM OUTPUT BUFFERS 28 26155 READ CONT ADDRESS * 29 26667 WRITE CONT ADDRESS 30 53000 FLAG BITS* * 31 27 MISCELLANEOUS BITS * * NOTE: INFORMATION BELOW IS ONLY PRINTED FOR THE FIRST DVT OF A PAIR: * * FLAG BITS (DVT WORD 30) * 0 READ ABORTED 0 WRITE ABORTED 0 RD RQ PENDING 0 WT RQ PENDING * 0 BKPL LOCKED RP 0 BKPL LOCKED WP 0 SHORT TO ACTIVE 0 MED. T.O ACTIVE * 0 LONG T.O ACTIVE 1 CONNECTED 1 START OF MSG. 0 NON-DS MODE * 1 ASKED TO CONNCT 0 SEVERE ERROR 1 P-F RECONNECT 0 RFP WAIT * * HDLC BOARD, FIRMWARE REV.1950, SPEED: MAXIMUM, INTERNAL CLOCK * FCL DISABLED, DIAGNOSTIC HOOD NOT SENSED * * PARAMETERS/STATISTICS * 2 GOOD I-FRAMES RCVD 50 RR FRAMES RECEIVED * 0 RNR FRAMES RECEIVED 0 REJECT FRAMES RCVD * 0 RCV PROC OVERRUNS 0 CRC ERRORS * 0 ABORT SEQ. RECEIVED 0 RECEIVER OVERRUNS * 0 RX BUFFER OVERFLOWS 0 FRAMES W/BAD ADDR * 0 CMDR FRAMES RCVD 7 UNACK FR WINDOW SIZE * 10 N2 RETRY COUNT 15 T1 T.O. IN 0.01 SEC * * * THE FORM OF THE SPEED AND CLOCK MESSAGES DEPENDS ON THE * SETTING OF THE SWITCHES ON THE I/F BOARD: * * SPEED: 300 BPS, INTERNAL CLOCK * ^ ^ * ! ! * ! +----- OR EXTERNAL * ! * +---- THIS FIELD MAY HAVE ANY OF THE FOLLOWING: * 300 BPS * 1200 BPS * 2400 BPS * 4800 BPS * 9600 BPS * 19.2KBPS * 57.6KBPS * p MAXIMUM * * WHEN USING EXTERNAL CLOCK, THE ACTUAL SPEED IS DETERMINED BY MODEM, * BUT SETTING SHOULD MATCH, OR BE SLOWER THAN, THAT OF THE MODEM USED. * HED DSINF: DATA DECLARATION * (C) HEWLETT-PACKARD CO. * RUN-TIME PARAMETERS INLU BSS 01 OUTLU BSS 01 CONWD BSS 01 NODE BSS 01 FLAG BSS 01 SPC 2 *INTEGER I,J, & COUNTERS I BSS 01 J BSS 01 * MAXID, & # OF ID SEGMENTS IN SYSTEM MAXID BSS 01 * SSIZE; & SIZE OF SAM BLOCK SSIZE BSS 01 SPC 2 * DS/1000 VALUES EXT #CNOD,#FWAM,#TBRN,#MSTO,#SVTO,#WAIT,#QRN EXT #BREJ,#LU3K,#QZRN,#GRPM,#NRV,#TST EXT #RFSZ,#LDEF,#NCNT,#NODE,#LNOD,D$LID,D$RID EXT #QCLM,#RTRY,#PLOG,#TRCL,#INCV,#OTCV,#QXCL EXT #RQCV,#RPCV,#CLRN,#RDLY,#PRLU,#MHCT,#LEVL EXT #TRCN,#MCTR,#LCNT,#MAHC,#MARN,#RSM,#LV EXT #MDCT,#POOL SPC 2 *INTEGER ARRAY BUFR[1:1]; & OUTPUT BUFFER BUFR EQU * * OUTPUT FIELDS (WORDS 1 THROUGH 39) W1 BSS 1 W2 BSS 1 W3 BSS 1 W4 BSS 1 W5 BSS 1 W6 BSS 1 W7 BSS 1 W8 BSS 1 W9 BSS 1 W10 BSS 1 W11 BSS 1 W12 BSS 1 W13 BSS 1 W14 BSS 1 W15 BSS 1 W16 BSS 1 W17 BSS 1 W18 BSS 1 W19 BSS 1 W20 BSS 1 W21 BSS 1 W22 BSS 18 * * HOLDING AREA FOR NUMBER CONVERSION *INTEGER HOLD1,HOLD2,HOLD3; HOLD1 BSS 1 HOLD2 BSS 1 HOLD3 BSS 1 * SAMIN BSS 1 SAM ARRAY INITIALIZED? * *EQUATE LSTRM := 10; & LAST STREAM NUMBER LSTRM EQU 10 NOSTR ABS LSTRM * NAME BSS 3 NAMEF BSS 3 IDAD NOP ISTAT NOP IDTYP NOP IFTHR NOP @NAMF DBL NAMEF @NAME DBL NAME HED DSINF: MAIN PROGRAM * (C) HEWLETT-PACKARD CO. *+-----------------------------+ *! BEGINNING OF MAIN PR|ROGRAM ! *+-----------------------------+; SPC 1 * PICK UP RUN-TIME PARAMETERS *RMPAR(INLU); DSINF JSB RMPAR DEF *+2 DEF INLU * * IFZ ** SPACE SAVER ** * FOR MAPPED SYSTEMS, CONFIGURE DMS INSTRUCTIONS. LDA $OPSY RAR,SLA RSS RSS JMP STFLS LDA MWF CLB DST DMS1 LDA RSS STA DMS2 XIF ** END SPACE SAVER ** * *& SET FLAGS *PRMPT := SAMIN := FALSE; STFLS CLA STA SAMIN STA PRMPT * STA NAME STA IDAD JSB PGMAD GET OWN NAME DEF *+6 AND FATHER'S DEF NAME ID SEGMENT. DEF IDAD DEF ISTAT DEF IDTYP DEF IFTHR * UNL IFN LST * DETERMINE THE NODE NUMBER: LDA NODE IF NODE SZA NOT 0, JMP OK USE IT. LDB FLAG CHECK SZB NODE 0 JMP OK FLAG. * WE HAVE BEEN SCHEDULED WITH BOTH FLAG AND NODE SET TO 0. * IF OUR FATHER IS "EXECW", USE #CNOD AS THE NODE NUMBER. LDA IFTHR GET FATHER'S CMA,INA ID SEGMENT ADDR. SSA,RSS IF <= 0, JMP LOCAL WE ARE LOCAL. STA IFTHR JSB PGMAD GET FATHER'S DEF *+3 NAME. DEF NAMEF DEF IFTHR LDA @NAMF IS HIS NAME LDB @EXCW EXECW? JSB .CBT DEF D5 NOP JMP NTLOC YES--NOT LOCAL NOP LOCAL CCA NODE:=-1 RSS NTLOC LDA #CNOD NODE:=#CNOD STA NODE OK EQU * UNL XIF LST SPC 1 * GET TRUE PROGRAM NAME (USUALLY WILL BE DSINF). LDA @NAME MOVE FOR LDB @RUNL "IrNITIALIZE" MESSAGE. JSB .MBT DEF D5 NOP LDA @NAME MOVE FOR LDB @FINS FINAL MESSAGE. JSB .MBT DEF D5 NOP LDA @NAME MOVE FOR LDB @PRMP PROMPT. JSB .MBT DEF D5 NOP * *IF INLU<1 THEN CCA ADA INLU SSA,RSS JMP L968 * BEGIN * INLU := @401; & DEFAULT INPUT LU IS SYS CONSOLE LDA B401 STA INLU * PRMPT := TRUE; & INTERACTIVE DEVICE CCA STA PRMPT * END * ELSE JMP L977 * BEGIN & GET LU INFORMATION UNL IFN LST * DEXEC(NODE,13,INLU,DVR,T1,SUB); L968 JSB DEXEC DEF *+7 DEF NODE UNL XIF LST UNL IFZ LST * EXEC(13,INLU,DVR,T1,SUB); L968 JSB EXEC DEF *+6 UNL XIF LST DEF D13 DEF INLU DEF DVR DEF T1 DEF SUB * SUB := SUB AND @17; LDA SUB AND B17 STA SUB * DVR := ROTATE DVR AND @77; LDA DVR ALF,ALF AND B77 STA DVR * PRMPT := (DVR=00) OR (DVR=07 OR DVR=05 AND SUB=0); CCB SZA,RSS JMP TRU CPA D7 JMP SUBCK CPA D5 JMP SUBCK JMP FLS SUBCK EQU * UNL IFN LST LDA D#OPS IF REMOTE SYSTEM IS CPA $RTEL RTE-L, THERE ARE JMP TRU NO SUBCHANNELS. UNL XIF LST LDA SUB SZA FLS CMB TRU STB PRMPT * IF PRMPT THEN SSB,RSS JMP L977 * INLU:=INLU OR @400; & SET "K" BIT FOR INTERACTIVE INPUT LDA INLU IOR B400 STA INLU * END; * CHECK OUTPUT LU DEVICE *IF OUTLU<1 THEN L977 CCA ADA OUTLU SSA,RSS JMP L984 * OUTLU := IF PRMPT THEN INLU ELSE 6; LDB INLU LDA PRMPT SSA,RSS LDB D6 STB OUTLU *** SPECIAL FOR RTE-L: ADD NON-BUFFERED I/O OVERRIDE BIT L984 EQU * LDA NODE IF NODE NUMBER ISN'T CMA,SZA -1, DON'T ASSUME JMP L984A IT'S FOR AN L. LDA OUTLU ADD BIT TO IOR BIT14 OUTPUT LU STA OUTLU LDA INLU AND INPUT LU. IOR BIT14 STA INLU * L984A LDA $OPSY CPA $RTEL RTE-L? RSS JMP WRSYS NO--PRINT ERROR. * * FIND # OF PROGRAM ID SEGMENTS IN SYSTEM LDA $ID# STA MAXID * *SSIZE := #NRV - #FWAM; & UNLESS THERE IS NO NRV! LDA #NRV SZA JMP GTSTR LDA #TST+1 MPY D14 ADA #TST GTSTR LDB #FWAM CMB,INB ADA B STA SSIZE *IF SSIZE>740 THEN ADA DM740 SZA SSA JMP L1001 * & DON'T OVERRUN SAM ARRAY * SSIZE := 740; LDA D740 STA SSIZE * * CHECK TO SEE IF NODE HAS BEEN INITIALIZED *IF FWAM=0 THEN L1001 LDA #FWAM SZA JMP L1007 * JSB PRINT DEF RUNL DEC 13 * ELSE JMP L1037 * * * CHECK FOR NON-INTERACTIVE RUN *IF CONWD # 0 THEN L1007 LDA CONWD SZA,RSS JMP L1033 * BEGIN * INTEGER TMSC,SEC,MIN,HOUR; JMP L1014 TMSC BSS 01 SEC BSS 01 MIN BSS 01 HOUR BSS 01 BSS 1 TIME ASC 8, TIME---XX:XX:XX COLON ASC 1,:: "00" ASC 1,00 * PRMPT := FALSE; L1014 CLA STA PRMPT * EXEC(11,TMSC); JSB EXEC - DEF *+3 DEF D11 DEF TMSC * TIME[8] := KCVT(SEC); LDA SEC JSB KCVT1 IOR "00" STA TIME+7 * TIME[6] := KCVT(MIN); LDA MIN JSB KCVT1 IOR "00" LDB COLON RRR 8 DST TIME+5 * TIME[4] := KCVT(HOUR); LDA HOUR JSB KCVT1 STA TIME+4 JSB BLINE * JSB PRINT DEF TIME D8 DEC 8 UNL IFN LST * PRINT LOCAL NODE NUMBER LDA #NODE JSB CNVTD DEF LOCLN JSB PRINT DEF NODM2 DEC 10 UNL XIF LST * BLINE; JSB BLINE * IF (CONWD AND 1)#0 THEN AVMEM; LDA CONWD AND D1 SZA JSB AVMEM * IF (CONWD AND 2)#0 THEN CLASS; LDA CONWD AND D2 SZA JSB CLASS * IF (CONWD AND 4)#0 THEN VALUS; LDA CONWD AND D4 SZA JSB VALUS * IF (CONWD AND 8)#0 THEN DUMP; LDA CONWD AND D8 SZA JSB DUMP * IF (CONWD AND 16)#0 THEN LISTS; LDA CONWD AND D16 SZA JSB LISTS UNL IFN LST * IF (CONWD AND 32)#0 THEN DSNRV; LDA CONWD AND D32 SZA JSB DSNRV UNL XIF LST * IF (CONWD AND 64)#0 THEN LUTS; LDA CONWD AND D64 SZA JSB LUTS UNL IFN LST * IF (CONWD AND 128)#0 THEN MSACT; LDA CONWD AND D128 SZA JSB MSACT * IF (CONWD AND 256)#0 THEN RRTNG; LDA CONWD AND D256 SZA JSB RRTNG UNL XIF LST IFZ ** SPACE SAVER ** * IF (CONWD AND 512)#0 THEN RMSES; LDA CONWD AND D512 SZA JSB RMSES XIF ** END SPACE SAVER ** * END * * *ELSE JMP L1037 * SET PROGRAM NAME IN FUN1 AND FUN10 L1033 LDA @NAME LDB @FUN1 JSB .MBT DEF D5 NOP * MOREC := TRUE; CCA STA MOREC LDA @NAME LDB @FN10 JSB .MBT DEF D5 NOP * WHILE MOREC DO L1034 LDA MOREC SSA,RSS * XEQFN; JMP L1037 JSB XEQFN JMP L1034 * L1037 JSB PRINT DEF FINIS D11 DEC 11 * * DSINF REUSES PARAMETERS IF IN TIME LIST * EXEC(6,0,0,INLU,OUTLU,CONWD); JSB EXEC DEF *+9 DEF D6 DEF D0 DEF D0 DEF INLU DEF OUTLU DEF CONWD DEF NODE DEF FLAG D0 DEC 0 D128 DEC 128 SPC 2 * * $OPSY SAYS THIS IS NOT AN RTE-L SYSTEM * WRSYS JSB PRINT PRINT DEF BDRTE "WRONG DSINF LOADED". DEC 10 JSB EXEC TERMINATE DEF *+4 (WITH PREJUDICE). DEF D6 DEF D0 DEF D3 * BDRTE ASC 10, WRONG DSINF LOADED HED DSINF: EXECUTE A FUNCTION * (C) HEWLETT-PACKARD CO. *PROCEDURE XEQFN; * "AV" ASC 1,AV "CL" ASC 1,CL "VA" ASC 1,VA "DU" ASC 1,DU "LI" ASC 1,LI "NR" ASC 1,NR "/N" ASC 1,/N *"EQ" ASC 1,EQ "LU" ASC 1,LU "MA" ASC 1,MA "RR" ASC 1,RR *"RS" ASC 1,RS "/E" ASC 1,/E "EX" ASC 1,EX FNCTN ASC 5, FUNCTION TO BE PERFORMED RDLEN BSS 1 DM10 DEC -10 * XEQFN BSS 01 * BEGIN * * COMMENT * +----------------------+ * ! EXECUTE A FUNCTION ! * +----------------------+; * * IF PRMPT THEN LDA PRMPT SSA,RSS @ JMP L928 * BEGIN & PROMPT FOR COMMAND UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF BLANK DEF D1 * & PRINT THE PROMPT UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF PROMP DEF DM21 * END; * * CLEAR WORDS 2 & 3 OF FNCTN LDA BLANK STA FNCTN+1 STA FNCTN+2 * READ COMMAND FROM INPUT LU UNL IFN LST L928 JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST L928 JSB EXEC DEF *+5 UNL XIF LST DEF SD1 SET NO-ABORT BIT. DEF INLU DEF FNCTN DEF DM10 JMP EX ERROR: TREAT AS "/E". STB RDLEN SAVE NUMBER OF BYTES READ. * * EXECUTE COMMAND * IF FNCTN="AV" THEN AVMEM LDA FNCTN CPA "AV" RSS JMP *+3 JSB AVMEM JMP L939 * ELSE IF FNCTN="CL" THEN CLASS CPA "CL" RSS JMP *+3 JSB CLASS JMP L939 * ELSE IF FNCTN="VA" THEN VALUS CPA "VA" RSS JMP *+3 JSB VALUS JMP L939 * ELSE IF FNCTN="DU" THEN DUMP CPA "DU" RSS JMP *+3 JSB DUMP JMP L939 * ELSE IF FNCTN="LI" THEN LISTS CPA "LI" RSS ]5 JMP *+3 JSB LISTS JMP L939 UNL IFN LST * ELSE IF FNCTN="NR" OR FNCTN="/N" THEN DSNRV CPA "NR" RSS JMP *+3 TONRV JSB DSNRV JMP L939 CPA "/N" JMP TONRV UNL XIF LST ** ELSE IF FNCTN="EQ" THEN EQTS * CPA "EQ" * RSS * JMP *+3 * JSB EQTS * JMP L939 * ELSE IF FNCTN="LU" THEN LUTS CPA "LU" RSS JMP *+3 JSB LUTS JMP L939 UNL IFN LST * ELSE IF FNCTN="MA" THEN MSACT CPA "MA" RSS JMP *+3 JSB MSACT JMP L939 * ELSE IF FNCTN="RR" THEN RRTNG CPA "RR" RSS JMP *+3 JSB RRTNG JMP L939 UNL XIF LST IFZ ** SPACE SAVER ** * ELSE IF FNCTN="RS" THEN RMSES CPA "RS" RSS JMP *+3 JSB RMSES JMP L939 XIF ** END SPACE SAVER ** * ELSE IF FNCTN="/E" OR FNCTN="EX" THEN MOREC:=FALSE CPA "/E" JMP EX CPA "EX" RSS JMP BADF EX CLA STA MOREC JMP L939 * ELSE LFUNS; BADF JSB LFUNS * END OF XEQFN; L939 JMP XEQFN,I SPC 6 B400 OCT 400 B401 OCT 401 DM740 DEC -740 DM21 DEC -21 D16 DEC 16 D64 DEC 64 D256 EQU B400 D740 DEC 740 SD1 DEF 1,I @EXCW DBL EXECW EXECW ASC 3,EXECW PROMP ASC 11,/DSINF(L): FUNCTION?_ * RUNL ASC 13, /DSINF: INITIALIZE NODE! FINIS ASC 11, *** END OF DSINF *** STARS EQU FINIS+1 @RUNL DBL RUNL+1 @PRMP DBR PROMP @FINS DBL FINIS+6 SUB BSS 1 INPUT LU'S SUBCHANNEL DVR BSS 1 INPUT LU'S DRIVER TYPE MOREC BSS 1 ͍ MORE COMMANDS TO READ? PRMPT BSS 1 PROMPT FOR COMMANDS? HED DSINF: UTILITY SUBROUTINES * (C) HEWLETT-PACKARD CO. * +--------------+ * ! PROCEDURES ! * +--------------+ SPC 1 * * CONVERT NUMBER TO ASCII DECIMAL * CNVTD NOP STA RAW SAVE THE RAW DATA, TEMPORARILY. LDA CNVTD,I GET THE DESTINATION ADDRESS. STA STUFM CONFIGURE THE CALL TO 'CNUMD'. JSB CNUMD GO TO DEF *+3 CONVERT DEF RAW THE VALUE STUFM NOP TO ASCII. ISZ CNVTD ADJUST THE RETURN POINTER, JMP CNVTD,I AND RETURN TO THE CALLER. * RAW BSS 1 SPC 2 * * CONVERT NUMBER TO ASCII OCTAL * CNVTO NOP ENTRY. STA RAW SAVE THE NUMBER. LDA CNVTO,I GET DESTINATION ADDRESS. STA STUF1 SET ADDRESS IN CNUMO CALL. JSB CNUMO CALL SYSTEM DEF *+3 ROUTINE TO DEF RAW CONVERT. STUF1 NOP ISZ CNVTO ADJUST RETURN ADDRESS JMP CNVTO,I AND RETURN TO CALLER. SPC 2 * * CONVERT DECIMAL NUMBER TO ASCII, TWO DIGITS * (VALUE GOES IN A-REGISTER) * KCVT1 NOP STA T1 SAVE DATA TEMPORARILY. JSB KCVT CALL SYSTEM ROUTINE DEF *+2 FOR CONVERSION. DEF T1 JMP KCVT1,I RETURN. SKP * * CHASE DOWN INDIRECTS * INDR NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP INDR,I SPC 3 * * FILL BUFR ARRAY WITH A-REGISTER CONTENTS * FILL NOP ENTRY POINT STA BUFR STORE IN FIRST WORD. LDA AW1 PROPAGATE THROUGH LDB A ENTIRE FIELD INB WITH A JSB .MVW MOVE. DEF D38 NOP * JMP FILL,I RETURN SPC 2 * SUBROUTINE TO FILL PRINT BUFFER WITH BLANKS BFILL NOP LDA BLANK JSB FILL JMP BFILL,I RETURN SKP * * PRINT A STRING * MSG BSS 1 STRING ADDRESS LEN BSS 1 LENGTH * PRINT NOP ENTRY POINT LDA PRINT,I GET PARAMETERS STA MSG ISZ PRINT LDA PRINT,I STA LEN ISZ PRINT * UNL IFN LST JSB DEXEC CALL DEXEC FOR WRITE DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC CALL EXEC FOR WRITE DEF *+5 UNL XIF LST DEF D2 DEF OUTLU DEF MSG,I DEF LEN * JMP PRINT,I RETURN SPC 2 * PROCEDURE TO PRINT A BLANK LINE BLINE NOP JSB PRINT DEF BLANK D1 DEC 1 JMP BLINE,I SKP * * MOVE THE DS/1000 BLOCK OF SAM * DEST DEF SAM DESTINATION ADDRESS PONTR NOP ADDRESS WHERE POINTER IS STORED DEF PNTR-3 POINTERS' ARRAY * GTSAM NOP ENTRY POINT JSB $LIBR INSURE NOBODY CHANGES SAM NOP BY GOING PRIVILEGED * LDA #FWAM A-REG := SOURCE ADDR IN SAM LDB DEST B-REG := DESTINATION JSB .LDX X-REG := # OF WORDS TO MOVE DEF SSIZE DMS1 JSB .MVW MOVE WORDS [IN DMS: MWF] DEF SSIZE NOP * LDA PONTR+1 STA PONTR CCA \ GET ADDRESS ADA #LDEF / OF FIRST POINTER JSB .LDX INITIALIZE COUNTER DEF D14 LOOP2 LDB A,I PICK UP POINTER LDB B,I STB PONTR,I STORE POINTER INA INCREMENT SOURCE ADDR ISZ PONTR INCREMENT DEST ADDR JSB .DSX DONE? JMP LOOP2 NO--MOVE NEXT POINTER * JSB $LIBX RESTORE SYSTEM / DEF GTSAM AND RETURN * *MWF MWF INSTRUCTION FOR DMS OPERATING SYS SPC 3 * * PLACE THE CONTENTS OF A LOCATION IN ALTERNATE MAP (IF MAPPED SYS) * INTO THE A-REGISTER * IXGET NOP ENTRY POINT DMS2 LDA B,I [RSS IF DMS SYSTEM] JMP IXGET,I RETURN IF NON-MAPPED. * * XLA B,I * JMP IXGET,I RETURN. HED DSINF: LIST FUNCTIONS * (C) HEWLETT-PACKARD CO. *PROCEDURE LFUNS; * BEGIN * * COMMENT * +------------------------------------+ * ! LIST FUNCTIONS PROVIDED BY DSINF ! * +------------------------------------+; * @FUN1 DBL FUN1+1 FUN1 ASC 13, /DSINF: VALID FUNCTIONS-- FUN2 ASC 21, AV AVAILABLE MEMORY SUSPEND LIST FUN3 ASC 12, CL I/O CLASSES FUN5 ASC 14, VA DS/1000 VALUES FUN6 ASC 17, DU DUMP OF DS SAM BLOCK FUN7 ASC 13, LI DS/1000 LISTS UNL IFN LST FUN9 ASC 17, NR OR /N NODAL ROUTING VECTOR UNL XIF LST FUN8 ASC 16, LU DS/1000 LUT ENTRIES FUN8A ASC 17, LU,N DS/1000 LU # N UNL IFN LST FUN11 ASC 16, MA MESSAGE ACCOUNTING FUN12 ASC 11, RR REROUTING UNL XIF LST FUN10 ASC 14, EX OR /E TERMINATE DSINF @FN10 DBR FUN10+11 * LFUNS NOP * JSB BLINE * JSB PRINT DEF FUN1 DEC 13 * JSB PRINT DEF FUN2 DEC 21 * JSB PRINT DEF FUN3 DEC 12 * JSB PRINT DEF FUN5 DEC 14 * JSB PRINT DEF FUN6 DEC 17 * JSB PRINT DEF FUN7 DEC 13 * JSB PRINT DEF FUN9 DEC 17 * JSB PRINT DEF FUN8 DEC 16 * A JSB PRINT DEF FUN8A DEC 17 * JSB PRINT DEF FUN11 DEC 16 * JSB PRINT DEF FUN12 DEC 11 * JSB PRINT DEF FUN10 DEC 14 * JSB BLINE * END OF LFUNS; JMP LFUNS,I HED DSINF: PRINT AVAILABLE MEM LIST * (C) HEWLETT-PACKARD CO. *PROCEDURE AVMEM; * BEGIN * COMMENT * +---------------------------------------+ * ! PRINT AVAILABLE MEMORY SUSPEND LIST ! * +---------------------------------------+; * MHED1 ASC 20, AVAILABLE MEMORY SUSPEND LIST IS EMPTY MHED2 ASC 23, C PRGRM R PRIOR AMT.MEM FATHER * B40K OCT 40000 BIT14 EQU B40K B77 OCT 77 D3 DEC 3 D6 DEC 6 HYPHN ASC 1,-- FATHR BSS 1 FATHER'S ID SEGMENT WORD 1 BAW7 DBL W7 * AVMEM NOP JSB BLINE * IF (LINK := $MM ) # 0 THEN LDA $MM STA LINK SZA,RSS JMP L383 * BEGIN * & PRINT HEADING JSB PRINT DEF MHED1 D15 DEC 15 * JSB BLINE * JSB PRINT DEF MHED2 D23 DEC 23 * & PRINT A LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR D35 DEC 35 * & PRINT ID INFORMATION FOR EACH PROGRAM IN LIST * DO * BEGIN * & POINT TO NEXT LINK IN "AVAILABLE MEMORY" LIST * FILL(BUFR,BLANK); & CLEAR OUTPUT BUFR L338 JSB BFILL * & MOVE PROGRAM NAME LDA LINK ADA D12 CLE,ELA LDB BAW7 JSB .MBT DEF D5 NOP * STORE "MR" IF PROGRAM IS MEMORY-RESIDENT LDB LINK GET ITS ID SEGMENT ADDRESS ADB D15 ADVANCE TO MR/NA/SC, ETC. WORD LDA B,I LOAD THAT WORD SSA,RS9S BIT SET? JMP *+3 NO, LEAVE FIELD BLANK LDA =AMR STA W10 STORE "MR" IN PRINT LINE LDA B,I LOAD WORD AGAIN AND =B4000 MASK "SYSTEM COMMON" BIT SZA,RSS BIT SET? JMP *+3 NO, LEAVE FIELD BLANK LDA =ASC STA W15 * CNUMD(IGET(LINK+6),W11); & PRIORITY LDA LINK ADA D6 LDA A,I JSB CNVTD DEF W11 * CNUMD(IGET(LINK+1),W15); & AMOUNT OF MEMORY REQUESTED LDA LINK INA LDA A,I JSB CNVTD DEF W15 * & PUT LINE LENGTH IN "I" * I := 20; LDA D20 STA I * & CHECK "FATHER WAITING" LDA LINK GET ID SEGMENT ADDRESS ADA D14 COMPUTE ADDRESS OF "FATHER" WORD LDA A,I LOAD THE "FATHER" WORD AND B377 MASK FATHER'S ID SEGMENT #, IF ANY SZA,RSS IS THERE A FATHER? JMP L373 NO ADA DM1 CONVERT TO AN MPY $IDSZ ID SEGMENT ADA $IDA ADDRESS STA FATHR ...BECOMES NEW 'FATHER' * & MOVE FATHER NAME(S) * WHILE MORE DO * BEGIN * & MOVE THE NAME L354 LDA FATHR ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB JSB .MBT DEF D5 NOP * & CHECK FOR GRANDFATHER WAITING LDA FATHR ADA D14 LDA A,I AND B377 SZA,RSS JMP L373 CCB * STB MORE * BEGIN ADA DM1 CONVERT TO ID SEGMENT ADDRESS MPY $IDSZ ADA $IDA STA FATHR * I := I + 3; LDA I * ADA D3 * STA I * & CHECK FOR FULL OUTPUT BUFFER * IF I > 35 THEN LDA I ADA DM34  SSA JMP L354 * BEGIN & WRITE LINE, THEN CLEAR BUFFER * JSB PRINT DEF BUFR D38 DEC 38 * FILL(BUFR,BLANK); JSB BFILL * I := 20; LDA D20 STA I * END; * END; * END; JMP L354 * END; * & PRINT OUTPUT BUFFER * PRINT1(I+3); L373 LDA I ADA D3 STA T1 JSB PRINT DEF BUFR T1 DEC 0 * LINK := IGET(LINK); & NEXT ID SEGMENT IN LIST OR 0 LDA LINK,I STA LINK * END * UNTIL LINK=0; SZA JMP L338 * & PRINT LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * END * ELSE JMP L384 * & NO PROGRAMS IN "AVAILABLE MEMORY" LIST * L383 JSB PRINT DEF MHED1 D20 DEC 20 * BLINE; L384 JSB BLINE * END OF AVMEM; JMP AVMEM,I HED DSINF: PRINT I/O CLASS INFORMATION * (C) HEWLETT-PACKARD CO. *PROCEDURE CLASS; * BEGIN * * COMMENT * +-------------------------------+ * ! PRINT I/O CLASS INFORMATION ! * +-------------------------------+; * *INTEGER NBLCK, & NUMBER OF BLOCKS WAITING IN SAM NBLCK BSS 01 * TBLCK; & TOTAL SIZE OF SAM BLOCKS FOR A CLASS TBLCK BSS 01 * CHED1 ASC 11, I/O CLASS INFORMATION CHED2 ASC 12, CLASSES IN SYSTEM CHED3 ASC 10, CLASSES IN USE: CHED4 ASC 18, CLASS STATE GET OWNER CHED5 ASC 12, CLASSES AVAILABLE CHED6 ASC 11, BLOCK(S) WORDS] "[" BYT 133,0 * ACHD6 DEF CHED6 "BU" ASC 1,BU "AL" ASC 1,AL "GT" ASC 1,GT D4 DEC 4 B17 EQU D15 D32 DEC 32 DM31 ?F DEC -31 $RTEL EQU DM31 $OPSY CODE FOR RTE-L DM34 DEC -34 DCLAS DEF $CLTA AVLBL BSS 1 NUMBER OF CLASSES AVAILABLE TADDR BSS 1 I/O CLASS OR RN TABLE ADDRESS TSIZE BSS 1 TABLE SIZE ENTRY BSS 1 TABLE ENTRY NUMBER TWORD BSS 1 CONTENTS OF TABLE ENTRY LINK BSS 1 ID SEGMENT WORD 1 LASTI BSS 1 AW11 DEF W11 * * & GET CLASS I/O TABLE START ADDRESS & NUMBER OF ENTRIES * GETCL(TADDR,TSIZE); CLASS NOP LDA DCLAS GET CLASS TABLE ADDRESS LDA A,I JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF CHED1 DEC 11 * & PRINT NUMBER OF CLASSES * CNUMD(TSIZE,CHED2); LDA TSIZE JSB CNVTD DEF CHED2 * JSB PRINT DEF CHED2 D12 DEC 12 * BLINE; JSB BLINE * & PRINT HEAD FOR CLASSES IN USE * JSB PRINT DEF CHED3 D10 DEC 10 * JSB PRINT DEF CHED4 D18 DEC 18 * & LOOK AT EACH CLASS TO DETERMINE STATE AND POSSIBLE OWNER * AVLBL := 0; CLA STA AVLBL * FOR ENTRY := TADDR+1 TO TADDR+TSIZE DO LDA TADDR INA STA ENTRY LDB TADDR ADB TSIZE STB LASTI L424 CMA,INA ADA LASTI SSA JMP L498 * BEGIN * INTOF; JSB $LIBR NOP * IF (TWORD := IGET(ENTRY))=0 THEN LDA ENTRY,I STA TWORD SZA JMP L434 * BEGIN * INTON; JSB $LIBX DEF *+1 DEF *+1 * AVLBL := AVLBL + 1; & CLASS IS AVAILABLE ISZ AVLBL * END * ELSE JMP L497 * BEGIN * FILL(BUFR,BLANK); L434 JSB BFILL * CNUMD(ENTRY-TADDR,W3); LDA TADDR CMA,INA ADA ENTRY JSB CNVTD DEF W3 * * MOVE NAME OF OWNER PROGRAM, OR IF NO OWNERSHIP ASSIGNED * LDA ENTRY ADA TSIZE LDA A,I LOAD 2ND CLASS WORD SSA,RSS CLASS BEING FLUSHED? JMP L435 NO, CONTINUE * * THIS CLASS NUMBER IS CURRENTLY BEING FLUSHED BY * THE SYSTEM. LDA =AFL STA W8 JSB $LIBX RESTORE INTERRUPTS DEF *+1 DEF *+1 JMP L476 * L435 EQU * AND B377 MASK LOW 8 BITS SZA,RSS GLOBAL? JMP L442 YES,... ADA DM1 CONVERT TO MPY $IDSZ AN ID ADA $IDA SEGMENT ADDRESS ADA D12 NAME CLE,ELA CONVERT TO BYTE ADDRESS LDB AW16 CLE,ELB JSB .MBT MOVE TO PRINT BUFFER DEF D5 NOP JMP L443 * * MOVE * L442 JSB .DFER AW16 DEF W16 DEF NONE+4 * L443 EQU * * IF TWORD>0 THEN LDA TWORD SZA SSA JMP L456 * BEGIN & STATE 2--BUFFERED REQUESTS * & FOLLOW LINKS TO BLOCKS OF SAM * NBLCK := TBLCK := 0; CLA STA TBLCK STA NBLCK * WHILE TWORD>0 DO L441 LDA TWORD SZA SSA * BEGIN JMP L447 * NBLCK := NBLCK + 1; ISZ NBLCK * TBLCK := TBLCK + IXGET(TWORD+3); LDB TWORD ADB D3 JSB IXGET ADA TBLCK STA TBLCK * TWORD := IXGET(TWORD); LDB TWORD JSB IXGET STA TWORD * END; JMP L441 * INTON; L447 JSB $LIBX DEF *+1 DEF *+1 * & PuRINT INFORMATION * & MOVE # OF BLOCKS AND WORDS HEAD TO OUTPUT BUFFER LDA ACHD6 LDB AW11 JSB .MVW DEF D11 NOP * & MOVE THE TOTAL (3 DIGITS) LDA NBLCK JSB CNVTD DEF W8 LDA "BU" STA W8 LDA W9 AND B377 IOR "[" STA W9 * CNUMD(TBLCK,HOLD1); LDA TBLCK JSB CNVTD DEF HOLD1 * MOVE(HOLD2,W16,4); DLD HOLD2 DST W16 * JSB PRINT DEF BUFR D22 DEC 22 * FILL(BUFR,BLANK); JSB BFILL * END * ELSE INTON; JMP L457 L456 JSB $LIBX DEF *+1 DEF *+1 * IF (TWORD AND @40000)=0 THEN L457 LDA TWORD AND B40K SZA JMP L461 * W8 := "AL" & ALLOCATED * ELSE LDA "AL" STA W8 JMP L476 * BEGIN * W8 := "GT"; & GET L461 LDA "GT" STA W8 * & SOMEONE MUST BE WAITING ON THIS CLASS'S GET LDA $ID# SET UP LOOP TO SEARCH ALL ID SEGMENTS, CMA,INA LOOKING FOR ONE WITH ADDRESS OF CLASS STA PRINT NUMBER IN 1ST TEMP WORD LDA $IDA STORE POINTER TO ID SEGMENTS STA LINK * WHILE IGET(LINK+1)#ENTRY DO L465 LDA LINK INA LDA A,I CPA ENTRY MATCH ADDRESS OF CLASS # ENTRY? RSS JMP L475 NO LDA LINK YES, MOVE PROGRAM NAME ADA D12 CLE,ELA CONVERT TO BYTE ADDRESS LDB AW11 CLE,ELB JSB .MBT MOVE PROGRAM NAME DEF D5 NOP JMP L476 * L475 EQU * LDA LINK ADVANCE TO NEXT ID SEGMENT ADA $IDSZ STA LINK ISZ PRINT END OF LOOP? JMP L465 NO, CONTINUE JMP L476 YES, PRINT * END; L476 EQU * * I := 18; & OUTPUT BUFFER POINTER LDA D18 STA I * & PRINT LINE OF INFORMATION FOR THIS CLASS LDA I STA T4 JSB PRINT DEF BUFR T4 DEC 0 * END; * END; L497 LDA ENTRY INA STA ENTRY JMP L424 * IF AVLBL=TSIZE THEN L498 LDA TSIZE CMA,INA ADA AVLBL SZA JMP L502 * JSB PRINT DEF NONE DEC 7 * ELSE JMP L507 * BEGIN & PRINT NUMBER OF AVAILABLE CLASSES * BLINE; L502 JSB BLINE * CNUMD(AVLBL,CHED5); LDA AVLBL JSB CNVTD DEF CHED5 * JSB PRINT DEF CHED5 DEC 12 * END; * BLINE; L507 JSB BLINE * END OF CLASS; JMP CLASS,I SPC 3 IDNUM BSS 1 INDEX INTO KEYWORD TABLE NONE ASC 7, HED DSINF: PRINT DS/1000 VALUES * (C) HEWLETT-PACKARD CO. *PROCEDURE VALUS; * BEGIN * * COMMENT * +------------------------+ * ! PRINT DS/1000 VALUES ! * +------------------------+; * * HEADINGS: VHED1 ASC 8, DS/1000 VALUES: VHED2 ASC 20, RESOURCE NUMBERS: OWNER LOCKER VHED3 ASC 13, MAXIMUM HOP COUNT VHD19 ASC 14, MAX LINK DOWN COUNT VHED4 ASC 11, PROGL MESSAGE LU VHED5 ASC 9, UPGRADE LEVEL APMSG ASC 11, LAST APLDR LOAD-NODE APNOD ASC 3, NONE VHD17 ASC 16, CLASSES ASSIGNED TO PROGRAMS: VHD12 ASC 12, TIMEOUT VALUES (SEC): VHD13 ASC 13, MASTER T/O VHD14 ASC 13, SLAVE T/O VHD15 ASC 13, REMOTE BUSY RETRIES VHD16 ASC 13, REMOTE QUIET WAIT VHD18 ASC 13, MAX RETRY DELAY VHED7 ASC 15, RFA FILES MAY BE OPEN IFZ ** SPACE SAVER ** VHED9 ASC 15, HP 3000 IS ON LU  *DOWN* VHD20 ASC 12, BUFFER SIZE XXXXXX VHD10 ASC 21, LOCAL ID SEQUENCE: VHD11 ASC 21, REMOTE ID SEQUENCE: XIF ** END SPACE SAVER ** * * TABLES FOR RESOURCE NUMBER INFORMATION: * RNTAB DEF *+1,I DEF #MARN DEF #PLOG+1 DEF #TRCN DEF #CLRN DEF #QZRN DEF #QRN DEF #TBRN NUMRN ABS RNTAB+1-* * RNDES DEF *+1 ASC 8,MA TABLE ACCESS ASC 8,PLOG SYNCH. ASC 8,TRC65 TRACE ASC 8,QUEX CLEANUP ASC 8,QUEZ "LISTEN" ASC 8,QUIESCENT ASC 8,TCB ACCESS * * TABLES FOR I/O CLASS INFORMATION: * CLTAB DEF *+1,I I/O CLASSES DEF #MAHC DEF #TRCL DEF #PLOG DEF #RSM DEF #OTCV DEF #INCV DEF #QCLM DEF #RTRY DEF #GRPM DEF #RPCV DEF #RQCV DEF #QXCL NUMCL ABS CLTAB+1-* * CLPRG DEF *+1 PROGRAM NAMES ASC 3, M. A. ASC 3,TRC65 ASC 3,PLOG ASC 3,RSM ASC 3,OTCNV ASC 3,INCNV ASC 3,QCLM ASC 3,RTRY ASC 3,GRPM ASC 3,RPCNV ASC 3,RQCNV ASC 3,QUEX * B377 OCT 377 UPMSK OCT 177400 PERID BYT 56,0 PERIOD, LEFT BYTE MASK2 OCT 177760 D5 DEC 5 D26 DEC 26 IFZ ** SPACE SAVER ** AVH10 DBL VHD10+13 AVH11 DBL VHD11+13 XIF ** END SPACE SAVER ** DRNTB DEF $RNTA RN BSS 1 FMTAD BSS 1 POINT BSS 1 CNTR BSS 1 GLBAL ASC 5, AGLBL DEF GLBAL AW3 DEF W3 * * PROCEDURE RNOUT(RN,FMTAD); RNOUT BSS 01 * VALUE RN,FMTAD; INTEGER RN,FMTAD; * BEGIN & PRINT RN INFORMATION AND B377 ISOLATE RESOURCE STA RN NUMBER. h LDB RNOUT,I ISZ RNOUT STB FMTAD SZA,RSS IF RN NOT ASSIGNED, JMP RNOUT,I RETURN. * FILL(BUFR,BLANK); JSB BFILL * & MOVE TITLE LDA FMTAD LDB AW3 JSB .MVW DEF D8 NOP * & CONVERT RN NUMBER * W11 := KCVT(RN); LDA RN JSB KCVT1 STA W11 * & FIND LOCKER * TWORD := IGET(TADDR+RN); LDA TADDR ADA RN LDA A,I STA TWORD * IF (IDNUM := TWORD AND @377)=@377 THEN AND B377 STA IDNUM CPA B377 RSS JMP L548 * & MOVE "" LDA AGLBL LDB AW17 JSB .MVW DEF D5 NOP * ELSE IF IDNUM=0 THEN JMP L553 L548 LDA IDNUM SZA JMP L551 * & MOVE "" JSB .DFER AW18 DEF W18 DEF NONE+4 * ELSE JMP L553 * & MOVE THE PROGRAM NAME L551 CCA ADA IDNUM MPY $IDSZ ADA $IDA ADA D12 CLE,ELA LDB AW18 CLE,ELB JSB .MBT DEF D5 NOP * & FIND OWNER * IF (IDNUM := ROTATE(TWORD) AND @377)=@377 THEN L553 LDA TWORD ALF,ALF AND B377 STA IDNUM CPA B377 RSS JMP L555 * & MOVE "" LDA AGLBL LDB AW11 INB JSB .MVW DEF D5 NOP * ELSE IF IDNUM=0 THEN JMP L560 L555 LDA IDNUM SZA JMP L558 * & MOVE "" JSB .DFER AW13 DEF W13 DEF NONE+4 * ELSE JMP L560 * & MOVE THE PROGRAM NAME L558 CCA ADA IDNUM  MPY $IDSZ ADA $IDA ADA D12 CLE,ELA LDB AW13 CLE,ELB JSB .MBT DEF D5 NOP * & PRINT INFORMATION L560 JSB PRINT DEF BUFR D21 DEC 21 * END OF RNOUT; JMP RNOUT,I AW17 DEF W17 * * SUBROUTINE TO PRINT CLASS NUMBER AND ASSIGNED PROGRAM NAME. * CALLING SEQUENCE: * LDA * JSB PRCLS * PRCLS NOP ENTRY. AND B377 ISOLATE NUMBER. SZA,RSS IF NOT ALLOCATED, JMP PRCLS,I RETURN. JSB CNVTD CONVERT TO AW1 DEF W1 ASCII DECIMAL. JSB .DFER MOVE DEF W5 PROGRAM PRGM NOP NAME. JSB PRINT PRINT DEF BUFR INFORMATION. DEC 7 JMP PRCLS,I RETURN. * * & PRINT HEADINGS VALUS NOP * BLINE; JSB BLINE * JSB PRINT DEF VHED1 DEC 8 * BLINE; JSB BLINE * & RESOURCE NUMBERS JSB PRINT DEF VHED2 DEC 20 * GETRN(TADDR,TSIZE); LDA DRNTB GET RN TABLE ADDRESS LDA A,I JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * PRINT ASSIGNED RESOURCE NUMBER INFORMATION LDA RNDES SET UP STA DESCR DESCRIPTION POINTER. LDA RNTAB SET UP RESOURCE STA POINT NUMBER POINTER. LDA NUMRN SET UP LOOP STA CNTR COUNTER. * RLOOP LDA POINT,I PRINT RN JSB RNOUT INFORMATION. DESCR DEF *-* ISZ POINT BUMP LDA DESCR POINTERS. ADA D8 STA DESCR ISZ CNTR IF MORE RNS, JMP RLO~oOP STAY IN LOOP. * * BLINE; JSB BLINE * ASSIGNED I/O CLASSES JSB PRINT PRINT DEF VHD17 HEADING. B20 DEC 16 LDA CLPRG SET UP PROGRAM STA PRGM NAME POINTER. LDA CLTAB SET UP CLASS STA POINT NUMBER POINTER. LDA NUMCL SET UP LOOP STA CNTR COUNTER. JSB BFILL * CLOOP LDA POINT,I PRINT CLASS JSB PRCLS INFORMATION. ISZ POINT BUMP LDA PRGM POINTERS. ADA D3 STA PRGM ISZ CNTR IF MORE CLASSES, JMP CLOOP STAY IN LOOP. JSB BLINE * & TIMEOUT VALUES JSB PRINT DEF VHD12 DEC 12 * CNUMD(-(MSTO OR @177400)*5,VHD13[10]); LDA #MSTO IOR UPMSK CMA,INA MPY D5 JSB CNVTD DEF VHD13+10 * JSB PRINT DEF VHD13 D13 DEC 13 * CNUMD(-(SVTO OR @177400)*5,VHD14[10]); LDA #SVTO IOR UPMSK MPY D5 CMA,INA JSB CNVTD DEF VHD14+10 * JSB PRINT DEF VHD14 DEC 13 * HOLD1 := KCVT(NOT(ROTATE(BREJ) OR @177760)); LDA #BREJ ALF,ALF IOR MASK2 CMA JSB KCVT1 STA VHD15+12 * JSB PRINT DEF VHD15 DEC 13 * CNUMD(-WAIT,HOLD1); LDA #WAIT CMA,INA JSB CNVTD DEF HOLD1 * MOVII(AHLD2,FADDRESS(VHD16)+12,4); LDA HOLD2 STA VHD16+11 LDA HOLD3 STA VHD16+12 * JSB PRINT DEF VHD16 DEC 13 * LDA #RDLY GET MAX RETRY DELAY. CMA,INA JSB CNVTD DEF VHD18+10 DLD VHD18+10 INCLUDE AND B377 DECIMFAL PT. IOR PERID RRL 8 ROTATE INTO POSITION. DST VHD18+10 STORE. JSB PRINT DEF VHD18 DEC 13 * * BLINE; JSB BLINE * * MAXIMUM HOP COUNT LDA #MHCT CMA,INA JSB CNVTD DEF VHED3+10 JSB PRINT DEF VHED3 DEC 13 * MAXIMUM LINK DOWN COUNT LDA #MDCT CMA,INA JSB CNVTD DEF VHD19+11 JSB PRINT DEF VHD19 DEC 14 * PROGL MESSAGE LU LDA #PRLU JSB CNVTD DEF HOLD1 DLD HOLD2 DST VHED4+9 JSB PRINT DEF VHED4 DEC 11 * * APLDR DOWN-LOAD NODE LDA #LNOD GET THE DOWN-LOAD NODE NUMBER. CPA DM1 IF IT HAS NOT BEEN USED, JMP PRAPM THEN IGNORE THE CONVERSION. JSB CNVTD CONVERT TO ASCII, DEF APNOD AND CONFIGURE THE MESSAGE. PRAPM JSB PRINT PRINT NODE NUMBER (OR "NONE"). DEF APMSG DEC 14 * * UPGRADE LEVEL DOLVL LDA #LEVL JSB KCVT1 STA VHED5+8 JSB PRINT DEF VHED5 DEC 9 * * & NUMBER OF FILES WHICH MAY BE OPEN AT ONCE * CNUMD(RFSZ,VHED7[2]); LDA #RFSZ JSB CNVTD DEF VHED7+1 * JSB PRINT DEF VHED7 DEC 15 * IFZ ** SPACE SAVER ** * & CHECK FOR HP3000 AGAIN * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L611 * BEGIN * BLINE; JSB BLINE * & HP3000 LU * VHED9[10] := KCVT(LU3K); LDA #LU3K JSB CNVTD DEF HOLD1 DLD HOLD2 DST VHED9+9 LDB D11 IF SIGN BIT LDA #QXCL SET IN QUEX SSA CLASS WORD, LDB D15 INCLUDE "DOWN".  STB QLULN * JSB PRINT DEF VHED9 QLULN DEF *-* * & BUFFER SIZE LDA D$BSZ JSB CNVTD DEF VHD20+9 JSB PRINT DEF VHD20 DEC 12 * & LOCAL ID SEQUENCE LDA D$LID LOCAL ID POINTER IN "RES" LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0 JMP L603 INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH10 B := DEST ADDRESS JSB .MBT DEF I MOVE CHARACTERS NOP L603 LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L607 * PRINT(VHD10,26+I); ADA D26 CMA,INA STA T3 JSB PRINT DEF VHD10 T3 DEC 0 * & REMOTE ID SEQUENCE L607 LDA D$RID GET REMOTE POINTER IN "RES" INA LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0, JMP L603A INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH11 B := DESTINATION ADDR JSB .MBT DEF I MOVE CHARACTERS NOP L603A LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L611 * PRINT(VHD11,26+I); ADA D26 CMA,INA STA T7 JSB PRINT DEF VHD11 T7 DEC 0 XIF ** END SPACE SAVER ** * END; * BLINE; L611 JSB BLINE *END OF VALUS; JMP VALUS,I HED DSINF: DUMP CONTENTS OF DS SAM BLOCK * (C) HEWLETT-PACKARD CO. *PROCEDURE DUMP; * BEGIN * * COMMENT * +--------------------------------------+ * ! DUMP CONTENTS OF DS/1000 SAM BLOCK ! * +--------------------------------------+; * * INTEGER BADDR, & DUMP BEGINNING ADDRESS BADDR BSS 01 * EADDR, & DUMP ENDING ADDRESS EADDR BSS 01 * INCR; & ADDRESS INCREMENT INCR BSS 01 * DHED1 ASC 9, DUMP OF TCB BLOCK DHED2 ASC 25, LOC OCTAL CONTENTS OF LOC THROUGH LOC+6 DHED3 ASC 20, DUMP OF HP3000 TRANSACTION STATUS TABLE PLUS5 ASC 1,+5 PLUS6 ASC 1,+6 * D33 DEC 33 DM1 DEC -1 * PROCEDURE DODMP; DODMP BSS 01 * BEGIN * FILL(BUFR,BLANK); JSB BFILL * FOR I := BADDR STEP INCR UNTIL EADDR DO LDA BADDR STA I L637 CMA,INA ADA EADDR LDB INCR SSB CMA,INA SSA JMP L647 * BEGIN * & CONVERT ADDRESS * CNUMO(I,W2); LDA I JSB CNVTO DEF W2 * FOR J := 0 TO INCR-1 DO CLA STA J CCB ADB INCR STB T1 L641 CMA,INA ADA T1 SSA JMP L645 * & CONVERT CONTENTS * CNUMO(SAM[I+J-FWAM],BUFR[7+4*J]); LDA I ADA J CMA ADA #FWAM CMA JSB .CAX JSB .LAX DEF SAM LDB J RBL,RBL ADB D6 ADB AW1 STB T8 JSB CNVTO T8 DEF *-* LDA J INA STA J JMP L641 * & PRINT L645 JSB PRINT DEF BUFR LEN1 NOP * END; LDA I ADA INCR STA I JMP L637 * BLINE; L647 JSB BLINE * END OF DODMP; JMP DODMP,I * * & GET DS/1000 SAM BLOCK DUMP NOP * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * SAMIN := TRUE; 6CCA STA SAMIN * BLINE; JSB BLINE * & DUMP TCB AREA IN SAM JSB PRINT DEF DHED1 D9 DEC 9 * LDA PLUS5 STA DHED2+24 JSB PRINT DEF DHED2 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := FWAM; LDA #FWAM STA BADDR * EADDR := (IF TST#0 THEN TST ELSE NRV) - 1; LDA #TST SZA,RSS LDA #NRV ADA DM1 STA EADDR * INCR := 6; LDA D6 STA INCR LDA D29 SET LEN1 STA LEN1 TO 29. * DODMP; JSB DODMP IFZ ** SPACE SAVER ** * & HP3000 CONNECTED? * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L674 * BEGIN * & DUMP TST AREA IN SAM * JSB PRINT DEF DHED3 DEC 20 * LDA PLUS6 STA DHED2+24 JSB PRINT DEF DHED2 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := TST; LDA #TST STA BADDR * EADDR := FWAM + SSIZE - 1; CCA ADA #FWAM ADA SSIZE STA EADDR * INCR := 7; LDA D7 STA INCR LDA D33 SET LEN1 STA LEN1 TO 33. * DODMP; JSB DODMP * END; XIF ** END SPACE SAVER ** * END OF DUMP; L674 JMP DUMP,I HED DSINF: PRINT DS/1000 LISTS * (C) HEWLETT-PACKARD CO. *PROCEDURE LISTS; * BEGIN * * COMMENT * +----------------------------------+ * ! PRINT DS/1000 LIST INFORMATION ! * +----------------------------------+; * * INTEGER COUNT, & # OF ENTRIES IN A LIST COUNT BSS 01 * STCB, & # OF SLAVE TCB ENTRIES STCB BSS 01 * HEAD, & LIST HEAD HEAD BSS 01 * NEXT ; & NEXT LIST ELEMENT NEXT BSS 01 * LHED1 ASC 7, DS/1000 LISTS LHED2 ASC 20, ENTRIES IN MASTER REQUEST LIST, ASC 9, STARTING AT LHED3 ASC 24, ACTIVE SLAVE MONITORS: 1ST TCB LHED4 ASC 24, STREAM CLASS MONITOR ENTRIES LOCATION LHED5 ASC 24, ENTRIES IN NULL LIST, STARTING AT LHED7 ASC 20, ENTRIES IN PROCESS NUMBER LIST, ASC 9, STARTING AT LHED8 ASC 16, ENTRIES IN SLAVE LISTS LHED9 ASC 14, PROG CLASS T/O CTR LHD10 ASC 10, PROG LOGLU BAW5 DBL W5 NOT15 OCT 77777 D2 DEC 2 D19 DEC 19 D39 DEC 39 RSTAR ASC 1, * * * PROCEDURE CHASE; CHASE BSS 01 * BEGIN * COMMENT CHASE A LIST TO ITS END; * COUNT := 0; CLA STA COUNT * WHILE NEXT#0 DO L705 LDA NEXT SZA,RSS * BEGIN JMP L710 * NEXT := SAM[NEXT-FWAM]; LDA #FWAM CMA,INA ADA NEXT JSB .CAX JSB .LAX DEF SAM STA NEXT * COUNT := COUNT + 1; ISZ COUNT * LDA LFLAG LONG FORMAT? SZA,RSS NO-- JMP L705 GET NEXT. * JSB BFILL JSB .ISX GET TCB JSB .LAX WORD 1. DEF SAM AND B377 ISOLATE TIMEOUT. CMA,INA SUBTRACT FROM ADA B377 OCTAL 377. MPY D5 MULTIPLY BY 5. STA T1 SAVE. IFZ ** SPACE SAVER ** LDB RSTAR JSB .LAX DEF SAM GET WORD 1. RAL IF "HP 3000" SSA BIT IS SET, STB W4 STORE "*". XIF ** END SPACE SAVER ** JSB .ISX GET TCB JSB .ISX WORD 3. JSB .LAX DEF SAM ISOLATE AND B377 CLASS #/LOG LU. STA T2 SAVE. JSB .ISX POINT TO WORD 4. JSB .LAX DEF SAM GET ID SEG ADDR. ADA D12 POINT TO CLE,ELA NAME (BYTE). LDB BAW5 GET DESTINATION. JSB .MBT DEF D5 MOVE 5 CHARACTERS. NOP LDA T1 CONVERT T/O JSB CNVTD CNTR OR DEST. NODE DEF W11 TO DECIMAL. LDA T2 CONVERT JSB CNVTD CLASS NUMBER OR LU DEF HOLD1 TO DECIMAL. DLD HOLD2 DST W8 JSB PRINT PRINT LINE OF DEF BUFR INFORMATION. LFLAG NOP * * END; JMP L705 * END; L710 LDA COUNT PUT COUNT IN A-REG. JMP CHASE,I RETURN. * * LISTS NOP * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF LHED1 D7 DEC 7 * BLINE; JSB BLINE * & DO WE NEED TO GET SAM AND POINTERS? * IF NOT SAMIN THEN LDA SAMIN SSA JMP L721 * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * & CHECK OUT MASTER REQUEST LIST * HEAD := NEXT := PNTR[-1]; L721 LDA PNTR-1 STA NEXT STA HEAD CLA CLEAR "LONG" STA LFLAG FLAG (FOR CHASE). * CHASE; JSB CHASE * CNUMD(COUNT,LHED2[1]); JSB CNVTD DEF LHED2+1 * CNUMO(HEAD,LHED2[26]); LDA HEAD JSB CNVTO DEF LHED2+26 * PRINT(LHED2,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T2 JSB PRINT DEF LHED2 T2 DEC 0 * LDA HEAD GET HEAD OF LIST. SZA,RSS IF NOTHING THERE, JMP PRBL1 SKIP THE 2ND CHASE. STA NEXT SET UP CHASE POINTER. JSB PRINT PRINT DEF LHED9 HEADING. D14 DEC 14 LDA D13 SET "LONG" STA LFLAG FLAG (FOR CHASE). JSB CHASE DO "LONG" CHASE. * * BLINE; PRBL1 JSB BLINE * & CHECK SLAVE STREAMS CLA CLEAR "LONG" STA LFLAG FLAG (FOR CHASE). JSB PRINT DEF LHED3 DEC 24 JSB PRINT DEF LHED4 DEC 24 * STCB := 0; CLA STA STCB * FOR I := 0 TO LSTRM DO CLA STA I L733 CMA,INA ADA NOSTR SSA JMP L753 * BEGIN * HEAD := IGET(LDEF+2+I); LDA #LDEF ADA D2 ADA I LDA A,I STA HEAD * NEXT := PNTR[I]; JSB .LDX DEF I JSB .LAX DEF PNTR STA NEXT * FILL(BUFR,BLANK); JSB BFILL * & GET MONITOR NAME FROM ID SEGMENT LDA HEAD ADA D2 LDB A,I * (CHECK FOR INACTIVE MONITOR:) SZB,RSS JMP L751A LDB AW11 JSB .MVW DEF D3 NOP * TURN OFF POSSIBLE "NO-ABORT" BIT LDA W11 AND NOT15 STA W11 * W5 := KCVT(I); & STREAM NUMBER LDA I JSB KCVT1 STA W5 * W9 := KCVT(IGET(HEAD+1) AND @377); & CLASS NUMBER LDA HEAD INA LDA A,I AND B377 JSB CNVTD DEF W7 * IF NEXT>0 THEN LDA NEXT SZA SSA JMP L751 * BEGIN * & WE HAVE AN ACTIVE STREAM * CNUMO(NEXT,W21); & STARTING LOCATION JSB CNVTO DEF W21 * CHASE; ?# JSB CHASE * CNUMD(COUNT,W16); & NUMBER OF ENTRIES JSB CNVTD DEF W16 * JSB PRINT DEF BUFR DEC 23 * STCB := STCB + COUNT; LDA STCB ADA COUNT STA STCB JMP L751A * END; * EMPTY SLAVE LIST-- W18:="0" L751 LDA "0" STA W18 JSB PRINT DEF BUFR DEC 18 *** * END; L751A LDA I INA STA I JMP L733 * & TOTAL NUMBER OF SLAVE TCBS * CNUMD(STCB,LHED8[1]); L753 LDA STCB JSB CNVTD DEF LHED8+1 * JSB PRINT DEF LHED8 DEC 16 * BLINE; JSB BLINE * & NULL LIST * HEAD := NEXT := PNTR[-2]; LDA PNTR-2 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED5[1]); JSB CNVTD DEF LHED5+1 * CNUMO(HEAD,LHED5[21]); LDA HEAD JSB CNVTO DEF LHED5+21 * PRINT(LHED5,29+19*SIGN(HEAD)); LDB D29 LDA HEAD SZA ADB D19 CMB,INB STB T5 JSB PRINT DEF LHED5 T5 DEC 0 * & PROCESS NUMBER LIST * HEAD := NEXT := PNTR[-3]; LDA PNTR-3 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED7[1]); JSB CNVTD DEF LHED7+1 * CNUMO(HEAD,LHED7[26]); LDA HEAD JSB CNVTO DEF LHED7+26 * PRINT(LHED7,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T6 JSB PRINT DEF LHED7 T6 DEC 0 * LDA HEAD GET HEAD OF LIST. SZA,RSS IF NOTHING THERE, JMP PRBL2 SKIP THE 2ND CHASE. S STA NEXT SET UP CHASE POINTER. JSB PRINT PRINT DEF LHD10 HEADING DEC 10 LDA D10 SET "LONG" STA LFLAG CHASE FLAG. JSB CHASE DO THE CHASE. * * BLINE; PRBL2 JSB BLINE * SAMIN := FALSE; CLA STA SAMIN * END OF LISTS; JMP LISTS,I HED DSINF: PRINT DVT INFORMATION * (C) HEWLETT-PACKARD CO. *PROCEDURE LUTS; * * COMMENT * +----------------------------------+ * ! PRINT CONTENTS OF DS/1000 LUS ! * +----------------------------------+; * * BEGIN * EHED3 ASC 10, LU # , TYPE EHED4 ASC 18, WORD VALUE MEANING ASC 11, WORD VALUE MEANING BLANK EQU EHED4 EHED6 ASC 12, PARAMETERS/STATISTICS EHED7 ASC 13, FLAG BITS (DVT WORD 30) * * & DVT WORDS DESCRIPTIONS--20 CHARACTERS EACH ADV1 DEF *+1 ASC 10,DVT LINK WORD ASC 10,Q!RQST INITIATION LIST ASC 10,N!CIRCULAR NODE LIST ASC 10,P!CIRCULAR DVT LIST ASC 10,X!IFT REFERENCE ASC 10,AV!TYPE!STATUS ASC 10,SYSTEM FLAGS!LU LOCK!A!RS ASC 10,B!BUFFER ACCUM. ASC 10,S! HL-LL/16! LL/16 ASC 10,RESERVED ASC 10,T.O. LIST ASC 10,DEVICE T.O. VALUE ASC 10,I/F T.O. VALUE ASC 10,DEVICE DVR ADDR ASC 10,TY!E!Z!SUBFN!RQ ASC 10,RQ.PARM/ERR CODE ASC 10,RQST PARAM2/XLOG ASC 10,RQST PARAM3/EXT STAT1 ASC 10,RQST PARAM4/EXT STAT2 ASC 10,RETRY CNTR/READ PNTR ASC 10,1ST READ LEN/SKIP CT ASC 10,2ND READ LEN/READ CT ASC 10,READY FRAME LENGTH ASC 10,WRITE POINTER ASC 10,WRITE BUFFERS LENGTH ASC 10,MAX PSI FRAME SIZE ASC 10,NUM OUTPUT BUFFERS ASC 10,READ CONT ADDRESS ASC 10,WRITE CONT ADDRESS ASC 10,FLAG BITS* i ASC 10,MISCELLANEOUS BITS * * * DESCRIPTION OF PARAMETERS & ERROR STATISTICS * ADESC DEF *+1 ASC 10,GOOD I-FRAMES RCVD ASC 10,RR FRAMES RECEIVED ASC 10,RNR FRAMES RECEIVED ASC 10,REJECT FRAMES RCVD ASC 10,RCV PROC OVERRUNS ASC 10,CRC ERRORS ASC 10,ABORT SEQ. RECEIVED ASC 10,RECEIVER OVERRUNS ASC 10,RX BUFFER OVERFLOWS ASC 10,FRAMES W/BAD ADDR ASC 10,CMDR FRAMES RCVD * PARAMETERS ASC 10,UNACK FR WINDOW SIZE ASC 10,N2 RETRY COUNT ASC 10,T1 T.O. IN 0.01 SEC * * * DESCRIPTION OF STATUS BITS (IN DVT EXT WORD # 12) * ASTDS DEF *+1 ASC 8, READ ABORTED BIT 0 ASC 8, WRITE ABORTED BIT 1 ASC 8, RD RQ PENDING BIT 2 ASC 8, WT RQ PENDING 3 ASC 8, BKPL LOCKED RP 4 ASC 8, BKPL LOCKED WP 5 ASC 8, SHORT TO ACTIVE 6 ASC 8, MED. T.O ACTIVE 7 ASC 8, LONG T.O ACTIVE 8 ASC 8, CONNECTED 9 ASC 8, START OF MSG. 10 ASC 8, NON-DS MODE 11 ASC 8, ASKED TO CONNCT 12 ASC 8, SEVERE ERROR 13 ASC 8, P-F RECONNECT 14 ASC 8, RFP WAIT 15 SPC 2 * BOARD PARAMETER MESSAGE: DO NOT REARRANGE NEXT LINES. ASTDX ASC 14, HDLC BOARD, FIRMWARE REV. ASTD. ASC 7,YYWW, SPEED: SPDX. ASC 5,........, SPD1 ASC 7,..TERNAL CLOCK ASTDN EQU *-ASTDX SIZE OF MESSAGE BPLN2 ASC 3, FCL SPD2 ASC 13, ...ABLED, DIAGNOSTIC HOOD DGH ASC 6, ... SENSED PRLN2 EQU *-BPLN2 SPC 2 * "SPEED SETTING" TABLE FOR FIRMWARE SPTBL DEF *+1 ASC 4,300 BPS ASC 4,1200 BPS ASC 4,2400 BPS ASC 4,4800 BPS ASC 4,9600 BPS ASC 4,19.2KBPS ASC 4,57.6KBPS ASC 4, MAXIMUM * @SPDX DEF SPDX. "EN" ASC 2, EN "DIS" ASC 2, DIS "IN" ASC 1,IN "ST" ASC 1,ST "PA" ASC 1,PA "NOT" ASC 2, NOT LUNUM BSS 01 TYPE BSS 01 * FPNTR, & FORMAT ADDRESS POINTER FPNTR BSS 01 * * INTEGER ARRAY EBUFR[1:22]; & HOLDS DVT WORDS EBUFR EQU *-1 BSS 31 * "0" ASC 1, 0 "1" ASC 1, 1 AW20 DEF W20 COL1 BSS 1 COL3 BSS 1 SKP * RETRIEVE DS/1000 DVT CONTENTS * * EBUFR+1 - BUFFER TO ACCOMODATE 19 WORDS OF DVT + 12 WORD EXTENT * LUNUM- LU NUMBER TO PRINT DVT INFORMATION ON (IF DEVICE TYPE * IS FOR DS LINK DRIVER) * * GTDVT NOP CCB STB TYPE LDA $LUT# IF REQUEST IS FOR N> NUMBER CMA,INA OF LUS IN SYSTEM, ERROR! ADA LUNUM SSA,RSS JMP GTDVT,I * CCA FIND ADA LUNUM ADDRESS OF ADA $LUTA LU TABLE ENTRY LDA A,I LOAD DVT ADDRESS SZA,RSS LU EMPTY? JMP GTDVT,I YES, RETURN STA DVADR SAVE ADA D5 CHECK TYPE CODE LDA A,I ALF,ALF POSITION TO RIGHT BYTE AND B77 AND ISOLATE. STA TYPE CPA B66 TYPE 66?? JMP MOVE JMP GTDVT,I NO, EXIT * * MOVE DVT TO LOCAL BUFFER MOVE LDA DVADR A := SOURCE ADDRESS LDB DVTBF B := DESTINATION JSB $LIBR MAKE SURE DVT ISN'T CHANGED NOP BY HOLDING OFF INTERRUPTS JSB .MVW MOVE 19 WORDS FROM DVT DEF D19 NOP * MOVE DVT EXTENSION LDA DVADR GET ADDRESS OF IFT EXTENSION ADA D4 (IT'S IN DVT WORD 5) LDA A,I SZA,RSS IF THERE AIN'T NONE, JMP ERTN SKIP THE MOVE. ADA D7 ADVANCE TO IFT EXTENSION AREA JSB .MVW MOVE 12 WORD EXTENSION DEF D12 NOP ERTN JSB $LIBX RESTORE INTERRUPTS. DEF *+1 DEF *+1 * JMP GTDVT,I * DVADR BSS 1 CNVRT NOP ADDRESS OF CONVERSION ROUTINE TO BE USED. B66 OCT 66 SPC 3 * SUBROUTINE TO MOVE DVT DESCRIPTION WORD TO PRINT BUFFER. * (A-REG CONTAINS DESTINATION ADDRESS, FPNTR CONTAINS SOURCE, * AND I CONTAINS WORD NUMBER. "CNVRT" MUST CONTAIN ADDRESS * OF CONVERSION ROUTINE TO BE USED--EITHER CNVTO OR CNVTD). * DVMOV NOP STA COL1 ADA D2 STA COL2 ADA D4 STA COL3 * COL1 := KCVT(I); & DVT WORD NUMBER LDA I JSB KCVT1 LDB CNVRT DO WE WANT TO PRINT THE WORD #? CPB @CNVD (WE PRINT DECIMAL WHEN WE DON'T) LDA BLANK USE BLANKS INSTEAD STA COL1,I * CONVERT ACCORDING TO REQUIRED NUMBER BASE (OCTAL OR DECIMAL) JSB .LDX DEF I JSB .LAX DEF EBUFR JSB CNVRT,I COL2 DEF *-* * & MOVE MEANING LDA FPNTR LDB COL3 JSB .MVW DEF D10 NOP * I := I + 1; ISZ I * POINT TO NEXT MEANING LDA FPNTR ADA D10 STA FPNTR * END OF DVMOV; JMP DVMOV,I SPC 3 * SUBROUTINE TO PRINT WORDS IN DVT BUFFER. * BEFORE CALLING, SET UP: * FPNTR - POINTER TO NEXT DVT WORD DESCRIPTION * I - NEXT DVT WORD NUMBER * A-REG - NEGATIVE NUMBER OF WORDS (CNTR) * B-REG - ADDRESS OF CONVERSION ROUTINE (CNVTO OR CNVTD) * PRWDS NOP ENTRY. STB CNVRT SAVE CONVERSION ROUTINE ADDRESS STA CNTR SAVE COUNTER. * ELOOP JSB BFILL CLEAR PRINT BUFFER. LDA AW3 MOVE LEFT JSB DVMOV DESCRIPTION. ISZ CNTR IF LAST WORD JMP MV#2 WAS DESCRIBED, CCA FAKE COUNTER STA CNTR TO -1. JMP PRDVI GO PRINT. * MV#2 LDA AW20 MOVE RIGHT JSB DVMOV DESCRIPTION. * PRDVI JSB PRINT PRINT  DEF BUFR BOTH DEC 36 DESCRIPTIONS. * ISZ CNTR IF MORE TO DO, JMP ELOOP STAY IN LOOP. * JMP PRWDS,I RETURN. SPC 3 * * SUBROUTINE TO PRINT THE CONTENTS OF THE DVT BUFFER. * DVOUT NOP ENTRY. LDA TYPE WAS TYPE CPA B66 VALID LINK? RSS JMP DVOUT,I LDA LUNUM CONVERT LU JSB CNVTD NUMBER AND DEF HOLD1 STORE IN DLD HOLD2 PRINT BUFFER. DST EHED3+3 * LDA TYPE CONVERT DRIVER JSB CNVTO TYPE AND DEF HOLD1 STORE IN LDA HOLD3 PRINT BUFFER. STA EHED3+9 * JSB BLINE JSB PRINT PRINT DEF EHED3 DEC 10 HEADING. * LDA PBUFR+9 DID USER WANT CPA "AL" EVERYTHING? RSS OR CPA "IO" JUST DVT INFORMATION? RSS YES, CONTINUE JMP PRLBT NO, SKIP DVT INFO PRINTOUT * JSB PRINT DEF EHED4 D29 DEC 29 * * PRINT FIRST 31 WORDS OF DVT. * LDA ADV1 SET UP DESCRIPTION STA FPNTR POINTER TO DV1. CLA,INA SET DVT NUMBER STA I TO 1. LDB @CNVO (WE WANT OCTAL CONVERSION) LDA DM31 SET COUNTER TO 31. JSB PRWDS PRINT FIRST 31 WORDS. * * * IF THIS IS THE 2ND DVT OF A PAIR, THEN THE INFORMATION * IN THE DVT EXTENSION, COMMUNICATION STATISTICS, FIRMWARE * REV, SPEED, ETC., WILL ALL BE THE SAME. THIS SITUATION * IS DETECTED BY NOTING THAT THE IFT WILL BE THE SAME. * PRLBT LDA EBUFR+5 DOES THIS ENTRY HAVE THE CPA LIFT SAME IFT AS THE LAST ONE WE DID? JMP DVORT YES, EXIT THIS ROUTINE STA LIFT SAVE "LAST IFT" ADDRESS * * SET UP TO ANNOTATE STATUS BITS IN DVT EXT (WORD 12) * * THE CODE BELOW FORMATS ALL 16 BITS INTO FOUR LINES OF FOUR FIELDS EACH. * JSB BLINE JSB PRINT PRINT ANNOTATION HEADER DEF EHED7 DEC 13 LDA DM4 SET LINE COUNT STA CNTR FOR OUTER LOOP. LDA ASTDS SET DESCRIPTION STA HOLD1 POINTER. * IO02 LDB AW3 INITIALIZE INNER LOOP. STB HOLD1+1 LDA DM4 SET BIT COUNT STA T6 FOR INNER LOOP. JSB BFILL FILL THE PRINT LINE WITH BLANKS. * IO03 LDB EBUFR+30 PICK UP THE FLAG BITS. LDA "0" SET A-REGISTER TO "0" SLB OR "1" DEPENDING ON LDA "1" RIGHTMOST BIT. RBR SET UP TO TEST NEXT BIT. STB EBUFR+30 STA HOLD1+1,I STORE "0" OR "1" IN PRINT BUFFER. ISZ HOLD1+1 BUMP DESTINATION ADDRESS FOR MOVE. DLD HOLD1 PICK UP POINTERS. JSB .MVW DEF D8 MOVE DESCRIPTION TO PRINT LINE. NOP DST HOLD1 RESET POINTERS. * ISZ T6 HAVE 4 FIELDS BEEN MOVED? JMP IO03 NO. STAY IN INNER LOOP. * JSB PRINT PRINT THE FOUR DESCRIPTIONS. DEF BUFR DEC 38 * ISZ CNTR HAVE ALL 16 BITS BEEN CONVERTED? JMP IO02 NO. STAY IN OUTER LOOP. SPC 2 JSB BLINE * * CHECK FOR OPTIONAL THIRD PARAMETER. IF ANY VALUE SPECIFIED, * PICK UP INTERFACE PARAMETERS & ERROR STATISTICS. * STATISTICS ARE CLEARED BY THE I/F AFTER BEING READ. * LDA LUNUM SET UP SUB-FUNCTION IOR =B3600 STA BLINE * LDA PBUFR+9 IF THIRD PARAMETER CPA "AL" IS "AL" OR "ST", JMP BOARD READ STATISTICS CPA "ST" FROM THE BOARD. JMP BOARD CPA "PA" IF "PA", READ JUST JMP BORDP THE PARAMETERS. JMP DVORT OTHERWISE ALL DONE. * BOARD JSB EXEC READ DEF *+6 LONG-TERM DEF SD1 STATISTICS. DEF BLINE DVTBF DEF EBUFR+1 DEF D11 DEF D2 RSS IF RTE ABORTED CALL RAR,SLA OR IF DRIVER BUMRPED, JMP DVERR REPORT ERROR. * BORDP JSB EXEC READ DEF *+6 INTERNAL DEF SD1 PARAMETERS. DEF BLINE (LU + SUBFUNCTION) DEF EBUFR+12 DEF D5 DEF D1 RSS IF RTE ABORTED CALL RAR,SLA OR IF DRIVER BURPED, JMP DVERR REPORT ERROR. SPC 1 * THE 16-BIT QUANTITIES RETURNED BY THE DRIVER ARE IN * INVERTED-BYTE ORDER. REVERSE THEM. * REVRS LDA DM16 STA HOLD1 LDB DVTBF INITIALIZE BUFFER POINTER LOOPC LDA B,I LOAD THE DATA WORD, ALF,ALF REVERSE THE BYTES STA B,I AND PUT IT BACK. INB BUMP POINTER. ISZ HOLD1 END OF LOOP? JMP LOOPC NO. CONTINUE REVERSING. * SPC 1 * * PRINT BOARD TYPE, FIRMWARE REVISION CODE, AND SPEED. * LDA EBUFR+13 CONVERT JSB CNVTD REVISION DEF HOLD1 CODE. DLD HOLD2 DST ASTD. * LDA EBUFR+14 GET SPEED INDICATOR ASR 11 FROM ON-BOARD AND B34 SWITCH REGISTER. ADA SPTBL ADD SPEED TABLE ADDRESS. LDB @SPDX DESTINATION ADDRESS. JSB .MVW DEF D4 MOVE SPEED. NOP * LDA EBUFR+14 GET INTERNAL/EXTERNAL AND BIT9 CLOCK INDICATOR. LDB "IN" ASSUME INTERNAL CLOCK. SZA IF EXTERNAL, LDB "EX" MAKE MESSAGE "EXTERNAL". STB SPD1 STORE "IN" OR "EX". * JSB PRINT PRINT. DEF ASTDX ABS ASTDN * * DETERMINE FORCE COLD LOAD AND DIAGNOSTIC HOOD STATUS. * DLD "DIS" ASSUME FCL DST SPD2 DISABLED. LDA EBUFR+14 IF IT'S ENABLED, ALF,ALF SLA,RSS JMP CKDGH DLD "EN" REFORMAT DST SPD2 THE MESSAGE. * CKDGH LDA BLANK ASSUME HOOD LDB A SENSED. DST DGH LDA EBUFR+14 IF IT'S SLA NOTWQ THERE, JMP PRP#2 DLD "NOT" REFORMAT DST DGH THE MESSAGE. * PRP#2 JSB PRINT DEF BPLN2 DEF PRLN2 SPC 1 * * SET UP HDLC CARD PARAMETERS * LDA EBUFR+16 MAKE T1 TIME-OUT CMA,INA POSITIVE. STA EBUFR+14 LDA EBUFR+15 GET "N2" VALUE AND B377 AND STORE IT STA EBUFR+13 IN WORD 13. XOR EBUFR+15 REMOVE IT FROM ALF,ALF WORD 15. STA EBUFR+12 STORE "K" VALUE. LDA ADESC SET UP STA FPNTR DESCRIPTION PNTR. LDA DM14 NUM OF WORDS STA HOLD1 IS 14. * * PRINT PARAMETERS AND (POSSIBLY) STATISTICS * CHKPA JSB BLINE LDA @CNVD USE DECIMAL STA CNVRT CONVERSION. LDA PBUFR+9 IF ONLY THE PARAMETERS CPA "PA" ARE NEEDED, USE JMP IOX2 THE SHORT SETUP. * * SET UP TO PRINT BOTH * CLA,INA WORD NUMBER STA I IS SET TO 1. LDA D12 HEADING IS STA T9 24 CHARACTERS. JMP IOX3 GO PRINT. * * SET UP TO PRINT JUST PARAMETERS * IOX2 LDA D12 START WITH STA I WORD 12. LDA DM13 HEADING IS STA T9 13 CHARACTERS. LDA FPNTR ADD 110 TO ADA D110 PARAMETER STA FPNTR POINTER LDA HOLD1 AND 11 TO ADA D11 LOOP STA HOLD1 COUNTER. * IOX3 JSB PRINT PRINT DEF EHED6 HEADING. T9 DEF *-* LDA HOLD1 LOAD WORD COUNT. LDB @CNVD (USE DECIMAL CONVERSION) JSB PRWDS GO PRINT. * DVORT JSB BLINE JMP DVOUT,I RETURN. "IO" ASC 1,IO @CNVO DEF CNVTO @CNVD DEF CNVTD SPC 2 * * PRINT MESSAGE WHEN INFORMATION CALL TO DVA66 FAILS. * DVERR JSB PRINT PRINT "DRIVER DEF DEVER ERROR". DEC 12 JMP DVORT RETURN. * DEVER ASC 12, DRIVER REPORTS ERROR SPC 1 BIT9E OCT 1000 B34 OCT 34 DM4 DEC -4 DM13 DEC -13 DM14 DEC -14 DM16 DEC -16 D110 DEC 110 SKP * SUBROUTINE TO PROCESS "LU" COMMAND SPC 2 LUTS NOP ENTRY FOR LU COMMAND. JSB BLINE PRINT BLANK LINE * PARSE INPUT BUFFER FOR "LU,N" OPTION JSB PARSE DEF *+4 DEF FNCTN DEF RDLEN DEF PBUFR * LDB "AL" LDA CONWD SZA NON-INTERACTIVE MODE? STB PBUFR+9 YES, PRINT ALL DVT INFO * LDA INDVT STA LIFT CLEAR LAST IFT ENTRY SZA,RSS IF "N" NOT SPECIFIED, JMP L857A PRINT ALL DS LUS. STA LUNUM GET LU# JSB GTDVT INFO. JSB DVOUT PRINT THE DVT INFO, IF IT'S A VALID LINK JMP LUTS,I RETURN. SPC 1 * PRINT ALL DS/1000 LUS: * * LUNUM := 1; L857A CLA,INA STA LUNUM L860 JSB GTDVT GATHER INFORMATION ON THIS LU JSB DVOUT PRINT INFO ON THIS LU, IF A VALID DS LINK LDA LUNUM CPA $LUT# LAST LU? JMP LUTS,I YES, RETURN TO CALLER ISZ LUNUM NO, GO AROUND AGAIN JMP L860 NO, PRINT MORE SPC 2 LIFT NOP LAST IFT ENTRY ADDRESS PBUFR BSS 33 PARSE BUFFER INDVT EQU PBUFR+5 SECOND PARAMETER SPC 2 UNL IFN LST HED DSINF: PRINT NRV * (C) HEWLETT-PACKARD CO. * NRV DISPLAY ROUTINE. * DSNRV NOP ENTRY. LDA #NCNT GET NEGATIVE NO. OF NODES. STA NCNT SAVE THE NUMBER OF NODES. CMA,INA,SZA,RSS ANYTHING SPECIFIED? JMP DSNRV,I NO--IGNORE THE REQUEST! * JSB CNVTD CONVERT TO ASCII. DEF NNODS * JSB BLINE * LDA #NODE GET LOCAL NODE NUMBER. JSB CNVTD CONVERT IT TO ASCII. DEF LOCLN JSB PRINT PRINT THE FIRST MESSAGE. DEF NODM1 DEC 10 JSB PRINT DEF NODM2 DEC 21 JSB BLINE JSB (PRINT DEF NODM3 DEC 21 * LDA #NRV GET THE NRV ADDRESS, STA NPNT AND SAVE THE POINTER. * DLOOP JSB BFILL CLEAR THE PRINT BUFFER. * LDB NPNT GET A NODE NUMBER. JSB IXGET ISZ NPNT ADVANCE THE POINTER. SSA IF < 0, JMP BLENT IT'S A BLANK ENTRY. JSB CNVTD CONVERT. DEF W3 * LDB NPNT GET TIMEOUT/UPGRADE. JSB IXGET AND B17 ISOLATE THE UPGRADE. JSB CNVTD CONVERT. DEF W17 * LDB NPNT GET TIMEOUT/UPGRADE, AGAIN. JSB IXGET ISZ NPNT ADVANCE POINTER. ALF,ALF POSITION THE TIMEOUT AND B377 TO THE LOWER BYTE. SZA IF =0, THEN NO FILLING NEEDED. IOR DM256 FILL-IN THE UPPER BYTE. CMA,INA MAKE THE VALUE POSITIVE (OR 0). MPY D5 MULTIPLY BY FIVE. JSB CNVTD CONVERT. DEF W9 * LDB NPNT GET NEIGHBOR/LU. JSB IXGET AND B377 ISOLATE THE LU. STA T7 JSB CNVTD CONVERT. DEF W6 * LDB NPNT GET NEIGHBOR/LU JSB IXGET AGAIN. ISZ NPNT AND NBIT ISOLATE NEIGHBOR BIT. LDB LSTAR IF SET, PUT A SZA STAR NEXT TO STB W6 THE NODE NUMBER. * LDA T7 IF LU IS SZA,RSS ZERO (LOCAL), JMP PRNRV READY TO PRINT. * * * GOOD LU NUMBER. GET DRT INFORMATION. * JSB EXEC GET DEVICE TYPE DEF *+4 DEF D13 DEF T7 LU DEF #UNAK DEVICE TYPE LDA #UNAK LOAD DEVICE TYPE ALF,ALF ISOLATE DEVICE AND B77 TYPE. JSB CNVTO CONVERT TO DEF W15 OCTAL. * PRNRV JSB PRINT PRINT NODAL DEF BUFR INFORMATION. DEC 20 * ISZ NCNT ANY MORE TO PROCESS? JMP DLOOP YES, CONTINUE. * JSB BLINE .JSB PRINT PRINT BOTTOM DEF NODM4 LINE. DEC 15 JSB BLINE * JMP DSNRV,I PROCESS COMPLETE--CHECK FOR NEW REQUEST. SPC 1 BLENT LDA @BLNK SET UP LDB AW3 "BLANK" JSB .MVW DEF W9 MESSAGE. NOP ISZ NPNT BUMP POINTER. ISZ NPNT JMP PRNRV GO PRINT. SPC 2 @BLNK DEF *+1 ASC 9,** BLANK ENTRY ** LSTAR ASC 1,* NBIT BYT 1,0 NODM1 ASC 10, NRV SPECIFICATIONS: NODM2 ASC 7, LOCAL NODE#: LOCLN ASC 3, ASC 8,, NO. OF NODES= NNODS ASC 3, * NODM3 ASC 18, NODE LU T/O(SEC) TYPE ASC 3, LEVEL NODM4 ASC 15, (* INDICATES NEIGHBOR) * DM256 DEC -256 * NCNT NOP NUMBER OF NODES NPNT NOP T7 NOP HED DSINF: MESSAGE ACCOUNTING * (C) HEWLETT-PACKARD CO. * +--------------------------------------+ * ! PRINT MESSAGE ACCOUNTING INFORMATION ! * +--------------------------------------+ SPC 1 MAHD1 ASC 16, MESSAGE ACCOUNTING INFORMATION MAHD2 ASC 22, NODE STATE # UNACK # LINEDOWNS TIMEOUT * @STBL DEF *+1 MA STATE TABLE "DOWN ASC 8,DOWNNONEUP PEND * NODE# NOP #DOWN NOP #UNAK NOP #TMAX NOP SPC 2 MSACT NOP ENTRY. JSB BLINE JSB PRINT PRINT HEAD. DEF MAHD1 DEC 16 * LDA #MCTR GET # OF ENTRIES. SZA,RSS IF NONE, JMP NOMA REPORT THE FACT. STA CNTR * JSB BFILL CLEAR PRINT BUFFER. * JSB BLINE JSB PRINT PRINT HEAD. DEF MAHD2 DEC 22 * LDB #MCTR+1 GET ADDRESS OF TABLE. ELB,CLE,ERB CLEAR DEBUG BIT. * CYCLE STB PNTR STORE ENTRY ADDRESS. JSB IXGET GET NODE #. SSA IF NEGATIVE, JMP EOC IT'S A DUMMY. STA NODE# SAVE NODE #. * INB GET STATE JSB IXGET WORD. CLB LSL 4 SHIFT IN # STB #UNAK UNACKNOWLEDGED.R LSL 2 THROW AWAY CLB TWO BITS. LSL 8 MOVE IN STB #TMAX TIMEOUT. * ALF,RAR A-REG = OFFSET INTO TABLE. ADA @STBL GET ADDRESS OF STATE. DLD A,I GET 4-CHAR DESCRIPTION. DST W5 STORE IN PRINT BUFFER. * LDB PNTR GET WORD ADB D7 NUMBER 7 JSB IXGET (DOWN). LSL 4 CLB LSR 4 STA #DOWN * LDA NODE# CONVERT JSB CNVTD INFORMATION DEF W1 TO LDA #DOWN ASCII. JSB CNVTD DEF W14 LDA #UNAK JSB CNVTD DEF W8 LDA #TMAX JSB CNVTD DEF W19 * JSB PRINT PRINT DEF BUFR INFORMATION. DEC 21 * EOC LDB PNTR ADVANCE ADB D10 POINTER. ISZ CNTR IF MORE ENTRIES, JMP CYCLE STAY IN LOOP. * JMP EOMA ALL DONE. SPC 2 NOMA JSB PRINT PRINT DEF NOENT "NO ENTRIES" DEC 6 MESSAGE. SPC 1 EOMA JSB BLINE JMP MSACT,I RETURN. HED DSINF: NODAL REROUTING * (C) HEWLETT-PACKARD CO. * +-----------------------------------+ * ! PRINT NODAL REROUTING INFORMATION ! * +-----------------------------------+ SPC 1 RRHD1 ASC 13, REROUTING SPECIFICATIONS: RRHD2 ASC 11, UP/DOWN RRHD3 ASC 15, LU COST COUNTER STATUS "UP" ASC 2, UP SPC 2 RRTNG NOP ENTRY. JSB BLINE JSB PRINT PRINT HEAD. DEF RRHD1 DEC 13 * LDA #LCNT GET # OF ENTRIES. SZA,RSS IF NONE, JMP NORR REPORT THE FACT. CMA,INA MAKE NEGATIVE STA CNTR LOOP COUNTER. * JSB PRINT PRINT HEADS. DEF RRHD2 DEC 11 JSB PRINT DEF RRHD3 DEC 15 * JSB BFILL CLEAR PRINT BUFFER. * LDB #LV GET ADDRESS OF TABLE. STB PNTR! STORE POINTER. * LOOPR LDB PNTR GET JSB IXGET BITS/LU #. CLE,ELA POSITION IN E. DLD "UP" SET PROPER MESSAGE IN SEZ PRINT BUFFER. JMP SUD DLD "DOWN SUD DST W13 * LDB PNTR JSB IXGET GET LU AGAIN. AND B377 ISOLATE IT. JSB CNVTD CONVERT TO ASCII. DEF W1 * ISZ PNTR LDB PNTR GET JSB IXGET COST. JSB CNVTD CONVERT TO ASCII. DEF W4 * LDB PNTR ADB D3 JSB IXGET GET UP/DOWN COUNTER. ADB D2 POINT TO STB PNTR NEXT ENTRY. CMA,INA MAKE COUNTER POSITIVE. JSB CNVTD CONVERT TO ASCII. DEF W8 * JSB PRINT PRINT DEF BUFR THE DEC 14 LINE. * ISZ CNTR IF MORE TO DO, JMP LOOPR STAY IN LOOP. JMP EORR SPC 2 NORR JSB PRINT PRINT DEF NOENT "NO ENTRIES". DEC 6 SPC 1 EORR JSB BLINE JMP RRTNG,I RETURN. UNL XIF LST HED DSINF: REMOTE SESSIONS * (C) HEWLETT-PACKARD CO. IFZ ** SPACE SAVER ** * +----------------------------------+ * ! PRINT REMOTE SESSION INFORMATION ! * +----------------------------------+ SPC 1 RSHD1 ASC 21, REMOTE SESSIONS ESTABLISHED AT THIS NODE RSHD2 ASC 11, SOURCE SESSION ID RSHD3 ASC 20, NODE SOURCE LOCAL TIMER PROGRAM RSHD4 ASC 10, EMPTY ENTRIES CLONE ASC 4,(CLONE) @CLON DEF CLONE HFLAG NOP NOTUS NOP CLONI NOP AW21 DEF W21 D60 DEC 60 SPC 2 RMSES NOP ENTRY. JSB BLINE JSB PRINT PRINT HEAD. DEF RSHD1 DEC 21 JSB BLINE * CLA CLEAR STA HFLAG HEADING FLAG STA NOTUS AND REM SES COUNT. LDB #POOL GET # OF REMOTE JSB IXGET SESSION ENTRIES. SZA,RSS IF NONE, JMP NO0RS REPORT "NO ENTRIES". STA CNTR STORE # OF ENTRIES. INB SET POINTER TO 1ST ENTRY. STB PNTR * RSMLP LDB PNTR JSB IXGET GET FIRST WORD OF ENTRY. SSA IF SIGN BIT IS SET, JMP USED ENTRY IS IN USE. * * EMPTY ENTRY FOUND * ISZ NOTUS BUMP UNUSED ID COUNTER. LDB PNTR POINT TO ADB D7 NEXT ENTRY. STB PNTR JMP ENRLP GO TO END OF LOOP. SPC 1 * * ENTRY FOUND IN USE. PRINT INFORMATION. * USED LDA HFLAG GET HEADING FLAG. SZA IF SET, PRINT ENTRY. JMP PRENT * ISZ HFLAG SET HEADING FLAG. JSB PRINT PRINT HEADINGS. DEF RSHD2 DEC 11 JSB PRINT DEF RSHD3 DEC 20 * PRENT JSB BFILL FILL PRINT LINE WITH BLANKS. * JSB IXPTR GET FIRST WORD. STA CLONI SAVE TEMPORARILY. AND B377 ISOLATE LOCAL SESSION ID. JSB CNVTD CONVERT TO DECIMAL DEF W9 AND PUT IN PRINT LINE. * JSB IXPTR GET SOURCE NODE. JSB CNVTD CONVERT TO DECIMAL DEF W2 AND PUT IN PRINT LINE. * LDA CLONI GET CLONE INDICATOR. AND BIT14 SZA,RSS IF NOT SET, JMP GTSRC GO GET SOURCE ID. * LDA @CLON MOVE LDB AW21 "(CLONE)". JSB .MVW DEF D4 * GTSRC JSB IXPTR GET NEXT WORD. AND B377 ISOLATE SOURCE ID WORD. JSB CNVTD CONVERT TO DECIMAL DEF W6 AND PUT IN PRINT BUFFER. * JSB IXPTR GET PROGRAM SZA NAME. IF NON-0, STA W18 STORE CHAR 1 & 2. JSB IXPTR SZA STA W19 STORE CHAR 3 & 4. JSB IXPTR SZA,RSS JMP GTIMR AND UPMSK IOR B40 STA W20 STORE CHAR 5. * GTIMR JSB IXPTR GET # SEC/5. CLB DIVIDE BY 12 DIV D12 FOR MINUTES. &$ STB SEC MULTIPLY REMAINDER CLE,ELB BY 5 FOR # OF ELB SECONDS. ADB SEC STB SEC CLB DIV D60 DIVIDE BY 60 STB MIN FOR HOURS. STA HOUR * LDA SEC CONVERT JSB KCVT1 SECONDS IOR "00" TO STA W16 ASCII LDA MIN CONVERT JSB KCVT1 MINUTES. IOR "00" LDB COLON RRR 8 DST W14 LDA HOUR CONVERT JSB KCVT1 HOURS. STA W13 * JSB PRINT PRINT ENTRY DEF BUFR INFORMATION. DEC 24 * * END OF REMOTE SESSION LOOP * ENRLP ISZ CNTR IF MORE TO DO, JMP RSMLP STAY IN LOOP. * JSB BLINE LDA NOTUS JSB CNVTD DEF RSHD4 JSB PRINT PRINT NUMBER DEF RSHD4 OF FREE REMOTE DEC 10 SESSION ENTRIES. JMP EORS SPC 2 NORS JSB PRINT PRINT DEF NOENT "NO ENTRIES". DEC 6 SPC 1 EORS JSB BLINE JMP RMSES,I RETURN. SPC 3 * SUBROUTINE TO LOAD CONTENTS OF PNTR FROM SYSTEM MAP INTO A-REG. IXPTR NOP ENTRY. LDB PNTR LOAD ADDRESS. JSB IXGET (CROSS) LOAD CONTENTS. ISZ PNTR BUMP PNTR. JMP IXPTR,I RETURN. XIF ** END SPACE SAVER ** HED DSINF: LARGE BUFFER FOR SAM * (C) HEWLETT-PACKARD CO. NOENT ASC 6, NO ENTRIES * SAM BSS 740 SPC 2 PNTR EQU *+3 POINTERS INTO SAM BSS LSTRM+4 SPC 1 BSS 0 SIZE OF DSINF SPC 1 UNS END DSINF /& 5O 91750-18081 2013 S C0122 &DSLB1              H0101 xiASMB,R,L NAM DSLB1,0 91750-1X081 REV 2013 791026 ALL * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END   91750-18082 2013 S C0122 &DSLB2              H0101 yjASMB,L NAM DSLB2,0 91750-1X082 REV 2013 791026 ALL W/ RTE LINKS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END  ! 91750-18083 2013 S C0122 &DSLB3              H0101 zkASMB,L NAM DSLB3,0 91750-1X083 REV 2013 791026 ALL W/O 3K LINKS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END  " 91750-18084 2013 S C0122 &DSLB4              H0101 {lASMB,L NAM DSLB4,0 91750-1X084 REV 2013 791026 ALL RTES EXCEPT RTE-M * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END  # 91750-18085 2013 S C0122 &DSLCL              H0101 }ASMB,R,L NAM DSLCL,0 91750-1X085 REV 2013 791026 L-ONLY * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * DS/1000 LIBRARY FOR L-SERIES COMPUTERS ONLY END E $ 91750-18087 2013 S C0122 &DSLSM +              H0101 ASMB,R,L NAM DSLSM,0 91750-1X087 REV.2013 800509 ALL, W/O S.M. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: DSLSM * SOURCE: 91750-18087 * RELOC: PART OF 91750-12015 * PRGMR: JIM HARTSELL * * END  % 91750-18088 2013 S C0122 &DSMA +              H0101 ~dASMB,R NAM DSMA,0 91750-1X088 REV 2013 791026 ALL M.A. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END QV  & 91750-18090 2013 S C0122 &DSML1 +              H0101 vASMB,L NAM DSML1,0 91750-1X090 REV 2013 791026 RTE-M W/ FILE SYS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END c !' 91750-18091 2013 S C0122 &DSML2 +              H0101 wASMB,L NAM DSML2,0 91750-1X091 REV 2013 791026 RTE-M W/O FILE SYS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END l# "( 91750-18092 2013 S C0122 &DSMOD +              H0101 ASMB,Q,R,C HED DS/1000 MAINTENANCE PROGRAM REV 2013 NAM DSMOD,19,26 91750-16092 REV 2013 800707 ALL SPC 1 * * NAME: DSMOD * SOURCE: 91750-18192 * RELOC.: 91750-16192 * PGMR: L. WEIMAN * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 * 'DSMOD' MAY BE USED TO PERFORM A VARIETY OF NETWORK TABLE AND * PARAMETER MODIFICATION FUNCTIONS. IT CONTAINS THE FOLLOWING CAPABILITIES: * * 1) RE-ENABLE A LINK * 2) DISPLAY THE NETWORK ROUTING VECTOR, AT LOCAL NODE * 3) CHANGE THE LOCAL NODE'S NRV * 4) QUIESCE NODE * 5) (UN)-QUIESCE NODE * 6) SCHEDULE ADDITIONAL MONITORS * 7) ADJUST TIMNG PARAMETERS * * * 'DSMOD' MAY NOT BE RUN UNTIL AFTER THE NODE HAS BEEN INITIALIZED * (VIA 'DINIT'). SPC 2 * +----------------------------------------------------------------+ * * !SCHEDULING TO ENABLE A LINE: ! * +--------------------------------------------------------------+ * * *ON,DSMOD,(LINE LU#),(ERROR LU#) * * THIS PROCEDURE IS USED TO RE-ENABLE THE LINE INTERFACE FOR A * SINGLE LOGICAL UNIT NUMBER. THERE IS NO INTERACTION WITH THE * USER, UNLESS AN ERROR IS DETECTED. IN THE EVENT OF ERROR * DETECTION, THE USER WILL BE QUERIED ON THE (ERROR LU#) DEVICE. * * (INPUT LU# OR FILE),(ERROR LU#) * / * *ON,DSMOD, * \ * FI,LE,NM [,SECURITY CODE [,CARTRIDGE NUMBER] ] * * SCHEDULING WITH AN INTERACTIVE TERMINAL * AS THE (INPUT LU#) DEVICE, ORP UNDER THE CONTROL OF A COMMAND FILE, * WILL ALLOW THE USER TO SELECT SEVERAL POSSIBLE OPERATIONS. * * +-------------------------------------------------------------------+ * ! QUERIES AND VALID RESPONSES: ! * +-------------------------------------------------------------------+ * * NOTES: ANY LINE WHICH BEGINS WITH AN ASTERISK IS TREATED AS A COMMENT. * /A (ABORT ) IS A VALID RESPONSE TO ALL QUERIES. * * **** ACCEPTABLE RESPONSES--NON-QUIESCENT SYSTEM **** * * -------------- TO RE-ENABLE A LINE ----------------- * * /DSMOD: OPERATION? * (REPEAT FOR AS MANY AS DESIRED) * /DSMOD: ENABLE LU# ? * * ---------------- TO DISPLAY THE NODAL ROUTING VECTOR -------- * * /DSMOD: OPERATION? LOAD-NODE= NNNNN (OR "NONE") [DISPLAYED FOR RTE-M & -L ONLY] * * --------------- TO ADJUST SYSTEM TIMING -------------------- * /DSMOD: OPERATION? * [ RESOLUTION = 5 SECONDS ] (DEFAULT VALUE = 45) * * /DSMOD: SLAVE T/O [5 TO 1275 SECONDS] ? <5 TO 1275 (NUMERIC RESPONSE)> * [ RESOLUTION = 5 SECONDS ] (DEFAULT VALUE = 30) * * /DSMOD: REMOTE-BUSY RETRIES [1 TO 10]? <1 TO 10(NUMERIC)> * x  (DEFAULT VALUE =3) * * /DSMOD: REMOTE-QUIET WAIT [0 TO 7200 SEC.]? <0 TO 7200 (NUMERIC)> * (DEFAULT VALUE =0) * /DSMOD: MAXIMUM HOP COUNT? * (ENTER ANY POSITIVE NUMBER) * * ---------------- TO TEMPORARILY SUSPEND NETWORK TRANSACTIONS ----- * (I.E., "QUIESCE" THE NODE) * * /DSMOD: OPERATION? PRINTS "SYSTEM IS QUIESCENT" ON LU#1. * * --------- TO SCHEDULE ADDITIONAL MONITORS ------- * * /DSMOD: OPERATION? * /DSMOD: MONITOR NAME? * /DSMOD: OPERATION? * END DSMOD (TERMINATION MESSAGE) * * --------- TO CHANGE THE NRV ----------------- * /DSMOD: OPERATION? CN * /DSMOD: NETWORK MANAGEMENT SECURITY CODE? * THE NETWORK MANAGEMENT SECURITY CODE MUST BE ENTERED CORRECTLY, * OR 'DSMOD' WILL ABORT. IF A NON-ASCII CODE IS ENTERED, THE * QUESTION WILL BE REPEATED. THE CODE IS NOT ECHOED TO THE TERMINAL, * FOR SECURITY REASONS. * /DSMOD:NODE # TO CHANGE? ENTER NODE NUMBER. MUST ALREADY * EXIST IN NRV. * * THE CURRENT NRV ENTRY FOR THAT NODE IS PRINTED. YOU * MAY CHANGE ANY OR ALL FIELDS, EXCEPT CPU NUMBER. SIMPLY DEFAULT * A FIELD IF YOU WISH IT TO RETAIN THE SAME VALUE. * THE QUESTION WILL BE REPEATED UNTIL YOU ENTER "/E" TO EXIT * (OR NON-NUMERIC VALUE). * * /DSMOD: LU,TIMEOUT,UPGRADE LEVEL[,N]? * * THE "N" AT THE END IS REQUIRED WHEN THE ENTRaY IS A NEIGHBOR TO * THE LOCAL NODE, AND MUST BE CORRECT, OR "NEIGHBOR ADDRESSING" * CANNOT BE USED. * * AFTER EACH ENTRY HAS BEEN MADE, THE NEW VALUES ARE * PRINTED. SKP * --------------- TO LIST ALL COMMANDS ------------------------ * * /DSMOD: OPERATION? * /DSMOD: QUIESCENT RE-START * /DSMOD: NETWORK MANAGEMENT SECURITY CODE? * THE NETWORK MANAGEMENT SECURITY CODE MUST BE ENTERED CORRECTLY, * OR 'DSMOD' WILL ABORT. IF A NON-ASCII CODE IS ENTERED, THE * QUESTION WILL BE REPEATED. SKP * * ERROR MESSAGES--INTERPRETATION AND APPROPRIATE ACTION: * ----------------------------------------------------- * * [ ALL MESSAGES ARE PRECEDED BY "/DSMOD:"] SPC 1 * CLASS I/O ERROR - A REQUIRED CLASS NUMBER CANNOT BE ALLOCATED. * IS ABORTED. THIS ERROR MAY REQUIRE * RE-GENERATION WITH A LARGER ALLOTMENT OF CLASS NO'S. * * * END DSMOD - NORMAL COMPLETION MESSAGE. THE TEN CHARACTERS COMPRISING * THE MESSAGE ARE ALSO RETURNED IN THE 5-WORD TEMPORARY * STORAGE AREA OF A SCHEDULER'S I.D. SEGMENT. THEY MAY BE * RECOVERED THROUGH THE USE OF . * IF HAS BEEN ABORTED, THE FIVE WORDS OF RETURNED- * DATA CONSIST OF: 100000B,ER, L,ST,EN * * ERROR: MON?: AAAAA - THE SPECIFIED MONITOR IS NOT IN THE SYSTEM. * ABORT , USING /A COMMAND, AND THEN LOAD * THE MONITOR INTO THE SYSTEM. RE-STARTI8 . * * ERROR: STAT: AAAAA - THE MONITOR'S STATUS IS NOT 'DORMANT', AND * THEREFORE IT CANNOT BE SCHEDULED. * ABORT , USING /A COMMAND, AND THEN USE * RTE OPERATOR COMMANDS TO CHANGE THE STATUS. * * FILE ERROR - IMPROPER RESPONSE TO "INPUT # OF FILES". RETRY. * * INVALID NAME! - MONITOR NAME IS NOT RECOGNIZED BY . RETRY. * * INVALID RESPONSE! - OPERATOR ENTRY ERROR. RETRY. * (NO RETRY ALLOWED FOR QUIESCENT OR RE-START MODE) * * DSMOD ABORTED - /A COMMAND ENTERED, OR IRRECOVERABLE ERROR OCCURRED. * EXPLANATION WILL HAVE BEEN PRINTED PRIOR TO THIS * MESSAGE. IF INPUT FROM A FILE, LINE # OF LAST ERROR * ALSO PRINTED. * * LU ERROR - IMPROPER LU# SPECIFIED, OR LU# NOT TIED TO COMMUNICATION * LINK DRIVER. RETRY. * * NODE SPEC. ERROR - IMPROPER NODAL REFERENCE VALUE. ABORTED! * CORRECT INITIALIZATION ANSWERS AND RESTART . * THIS MESSAGE OCCURS WHEN CHANGING THE NRV IF * THE NRV TABLE IS EMPTY, OR IF THE SPECIFIED NODE * NUMBER CANNOT BE LOCATED IN THE TABLE, OR IF * THE NEW NODE NUMBER ALREADY EXISTS IN THE TABLE. * * READ ERROR - END-OF-FILE OR FMGR ERROR HAS BEEN DETECTED ON THE * INPUT DEVICE/FILE. THE QUESTION IS REPEATED ON THE * (ERROR LU) DEVICE. THE USER MAY SUPPLY THE REQUIRED * RESPONSE FROM THIS DEVICE. * * RN ERROR - A REQUIRED RESOURCE NUMBER CANNOT BE ALLOCATED; * IS ABORTED. RE-GENERATION, WITH A LARGER * ALLOTMENT OF RESOURCE NUMBERS, MAY BE REQUIRED. * * TR FILE ERROR - THE FILE MANAGER CANNOT PROCESS THE FILE * WHICH WAS SPECIFIED IN THE SCHEDULING * PARAMETERS. CORRECT THE FILE PROBLEM, *  AND RE-SCHEDULE . * * NO MSG.CNVRTS! --MAY OCCUR WHEN CHANGING THE NRV, IF AN ENTRY IS MADE * FOR A NODE WHICH DOES NOT SPECIFY THE SAME LEVEL * NUMBER AS THE LOCAL NODE, AND THE MESSAGE CONVERTERS * WERE NOT SCHEDULED WHEN THE NODE WAS INITIALIZED. SPC 2 EXT READF,CLOSE,OPEN,RNRQ,PRTN,REIO,PGMAD,IFTTY EXT EXEC,MESSS,$LIBR,$LIBX,$BMON,#PKUP,PARSE EXT CLRQ,XLUEX,D$LID,D$RID EXT #INCV,#OTCV,#MSTO,#QRN,#LDEF,#GTOP,$OPSY EXT #BREJ,#SVTO,#WAIT,#NODE,#NRV,#NCNT EXT #RFSZ,#BUSY,#MAQS,#RR4,#RR5,#RR6 EXT #LNOD,#LEVL,#MDCT EXT #FWAM,#MHCT,#LU3K,EXEC EXT .MVW,.MBT,.SBT EXT .LDX,.CMW,#NMSC SPC 2 * DEFINE ENTRY POINTS FOR REMOTE SESSION SET-UP ROUTINES ENT PRNT#,READ#,INBF#,PRNL#,ERFR#,EXFR#,ABRT# * EXT #DSSM SUP SKP DSMOD EQU * JSB #PKUP GET THE DEF *+4 PARAMETERS DEF PMASK FOR LOCAL USE. DEF NAME DEF DEFLU * * LDA @ENMG INITIALIZE ADDRESS OF RETURN PARAMS TO STA $RTRN 'FATHER' PROGRAM * * SET "OPTYP" ACCORDING TO LOCAL NODE OP-SYSTEM TYPE. * RELEVENT BITS: * BIT 15 = 1 IF DMS NODE, ELSE 0 * BIT 0 = 1 IF RTE-III OR IV. 0 FOR RTE-M OR L LDA $OPSY GET THE SYSTEM SPECIFICATIONS. RAR,RAR BIT#15: 1=DMS BIT#0: 1=RTE, 0=RTE-M. STA OPTYP SAVE THE USEFUL SYSTEM SPECIFICATIONS. SSA,RSS JMP NODMS THIS IS A NON-DMS SYSTEM * DLD XSBAI GET THE CROSS-STORE INSTRUCTION, DLD XLBAI DST DSMD0 DST DSMD1 DST DSMD2 DLD MWII DST STNOP DLD MWFI PICK UP MWF INSTRUC DST STND2 * PICK UP READ LU NODMS EQU * CLB INITIALIZE EQUIPMENT TYPE CODE STB ERFLG CLEAR ERROR FLAG STB TYPEQ TO INDICATE AN INTERACTIVE DEVICE. STB WCLFLG CLEAR CLASS I/O FLAG. * LDA NAME GET THE INPUT LU--IF ANY. LDB DEFLU IF LU NOT SUPPLIED, USE DEFAULT. SZA SUPPLIED? LDB A YES, USE SUPPLIED VALUE AND =B37400 MASK OFF LOW ORDER BITS SZA TEST FOR LU OR FILE: CLB FILE...CLEAR FILE FLAG STB RLU SAVE READ LU OR 0 (FILE). STB XLU AND SAVE PURE LU SZB,RSS LU OR FILE? JMP LSTN1 FILE * JSB TTY? CHECK DEF RLU READ LU. SZB,RSS TTY? IOR B400 YES...SET IN ECHO BIT STA RLU SAVE AS INPUT LU STB TYPEQ SAVE INPUT DEVICE EQUIPMENT CODE. * * PICK UP ERROR LU LSTN1 LDA PRM2 SZA IS ERROR LU SUPPLIED? JMP LSTN2 YES...SAVE IT. LDA RLU NO. GET THE INPUT LU. SZA,RSS IS INPUT FROM FILE? JMP SDFLU YES...USE DEFAULT. LSTN2 STA ERLU SAVE ERROR LU * LDA #FWAM HAS THIS NODE SZA BEEN INITIALZED? JMP *+3 YES, CONTINUE JSB SYSER NO--CATASTROPHIC ERROR. DEF NINIT "NODE NOT INITIALIZED" & ABORT * JSB TTY? CHECK DEF ERLU ERROR LU. SZB INTERACTIVE? SDFLU LDA DEFLU NO...SET TO DEFAULT. IOR B400 STA ERLU * JSB CHCKN SEE IF FILE JMP OPTN2 NOT FILE * LDA NAME WAS 1ST PARAMETER SSA NEGATIVE? JMP CLASS YES--GO SET UP TO GET SPECIAL "CLASS FILE" * JSB OPENX OPEN THE FILE JMP *+2 OPEN ERROR! JMP OPT20 OPEN WAS SUCCESSFUL. * JSB SYSER SYSTEM ERROR DEF TRFM "TR FILE ERROR" SKP * SET UP DCB FOR DUMMY READFS DMDCB OCT 0,0 DIRECTORY ADDR DEC 2 FILE TYPE DEC 1,1 TRACK,SECTOR OF FILE DEC 2 # OF SECTORS (128 WORDS TOTAL) RECL BSS 1 RECORD, LEN (3RD PARAMETER) D128 OCT 200 1 BLOCK IN DCB DEC 96 # SECTORS/TRACK OPNFL BSS 1 "OPEN" FLAG DEC 1,1 CURRENT TRACK,SECTOR DEF INDCB+16 ADDRESS OF DCB DATA OCT 100000 DATA IS IN DCB DEC 1 RECORD # DEC 0 EXTENT # @DMDC DEF DMDCB @DCB DEF INDCB * * A SPECIAL "CLASS FILE" OPTION HAS BEEN BUILT IN, TO ALLOW * AUTOMATIC INITIALIZATION IN NODES WITH NO RESIDENT DISC. * THE INITIALIZATION COMMANDS ARE PASSED TO DINIT VIA A CLASS * BUFFER, AND A DUMMY DCB IS SET UP TO LOOK LIKE IT'S BEEN * READ FROM A DISC, I.E., "FAKED" SO READF WILL TRANSFER * EACH RESPONSE TO DINIT AS READ. * CLASS STA CLFLG SET CLASS I/O FLAG < 0. LDA $BMON CHECK FOR NEW DCB FORMAT SZA NEW? JMP ABORT NEW FORMAT NOT ALLOWED. LDA PRM3 GET RECORD STA RECL LENGTH. JSB #GTOP OBTAIN "OPEN" FLAG STA OPNFL AND SAVE IT. JSB EXEC MOVE DEF *+5 DCB DEF CLS21 DATA DEF PRM2 VIA DEF INDCB+16 CLASS DEF D128 I/O. JMP ABORT [ERROR RETURN] LDA @DMDC MOVE LDB @DCB DCB HEADER JSB .MVW INFORMATION. DEF D15 NOP JMP OPT20 CONTINUE WITH NORMAL PROCESSING. SKP OPTN2 JSB CHCKN SEE IF THEY WANT TO READ FROM A FILE JMP *+2 NO...IT'S AN LU. JMP OPT20 YES CPB #LU3K IS IT THE HP3000 LU? JMP OPT23 .YES CPA B65 IS IT DVA65? JMP OPT22 YES CPA B66 DVA66? JMP OPT22 SKP * HERE TO OBTAIN NEXT NEW COMMAND * OPT20 EQU * JSB READ GET THE RESPONSE. DEF OPMES CPB /E REQUEST TO TERMINATE? JMP TERM YES. GO TO OBLIGE. CPB "EX" JMP TERM CPB /S REQUEST TO SCHEDULE MONITOR(S)? JMP SKEDM YES. GO TO^b SET UP TO SCHEDULE. CPB /T REQUEST TO MODIFY TIMING? JMP TIME YES. CPB /N REQUEST TO DISPLAY NRV? JMP DSNRV YES. SATISY THE REQUEST. CPB /I JMP IDSEQ CPB CN CHANGE NRV? JMP CHNRV YES. CPB /P CHANGE NON-SESSION ACCESS PASSWORD? JMP CUPSW YES CPB /U CHANGE DEFAULT SESSION USER-NAME? JMP CUSNM YES JSB RNRQ GO TO RTE DEF *+4 TO OBTAIN THE DEF GLCNW STATUS OF THE DEF #QRN SYSTEM QUIESCENT DEF TEMP1 RESOURCE NUMBER. LDB PARSB+1 GET THE USER COMMAND, AGAIN. LDA TEMP1 GET THE STATUS OF #QRN. CPA B7 IF THE SYSTEM IS ALREADY QUIESCENT, JMP QCHNG THEN ONLY /R IS ALLOWED; ELSE, CPB /L REQUEST TO RE-ENABLE A LINE? JMP OPT21 YES. GO TO DETERMINE THE LU NUMBER. CPB /Q REQUEST TO MAKE THIS NODE QUIESCENT? JMP QUIES YES.GO TO PROCESS THE REQUEST. QCHNG CPB /R REQUEST TO RE-START FROM QUIESCENCE? JMP REQUE YES. GO TO START IT UP AGAIN. JSB PRNTX EXPLAIN THE COMMANDS DEF EXPMS TO THE CONFUSED USER. JMP OPT20 REPEAT THE QUESTION. SKP * HERE ON "CHANGE NRV" COMMAND (CN) * CHNRV EQU * JSB NMSCX OBTAIN & VERIFY NETWORK MANAGEMENT SECURITY CODE * (RETURN ONLY IF CODES MATCH) * CHN0 EQU * DLD #NCNT SET UP POINTERS, COUNTERS, ETC. SZA,RSS IS THERE AN NRV SET UP? JMP FRMER NO, ERROR! STA NCNT STB NPNT CMA,INA SAVE STA NRVSZ POSITIVE # NODES LDA #NODE SAVE LOCAL NODE STA XNODE NUMBER IN LOCAL STORAGE * JSB READ GET RESPONSE DEF NODEX CPA B1 NUMERIC? RSS YES, GO ON... JMP OPT20 NON-NUMERIC, GO GET NEW COMMAND. SPC 2 CHN1 EQU *  STB NRV1 SAVE NODE # WE'RE SEARCHING FOR LDB NPNT BEGIN SEARCH OF NRV FOR SPECIFIED NODE DSMD0 LDA B,I [XLA B,I IF DMS] NOP [REQUIRED FOR XLA] CPA NRV1 MATCH? JMP CHN2 YES, ALLOW IT TO BE CHANGED ADB NRVS. NO, ADVANCE TO NEXT ENTRY STB NPNT SAVE POINTER ISZ NCNT ANY MORE IN TABLE? JMP DSMD0 YES, CONTINUE SEARCH JMP FRMER TABLE EMPTY, NODE NOT FOUND! SPC 2 CHN2 EQU * JSB PRNRV PRINT THIS NRV ENTRY JSB READ GET RESPONSE. DEF NODEF * SZA,RSS LU DEFAULTED? JMP STND. YES, SKIP TESTS FOR IT. CPA B2 ASCII? JMP FRMER YES, ERROR! LDA PARSB+1 AND =B177400 LU > 255? SZA JMP FRMER YES, ERROR! LDA PARSB+1 RECOVER LU STA TEMP SAVE LU LDA NRV3 INCLUDE REMAINING BITS FROM 3RD NRV WORD AND =B177400 IOR TEMP STA NRV3 * * STND. EQU * LDB PARSB+4 GET TIMEOUT SPECIFICATION TYPE. CPB B2 IF THE PARAMETER IS INVALID, JMP FRMER THEN SCREAM ABOUT IT! LDA PARSB+5 GET TIME-OUT SPECIFICATION SZB,RSS DEFAULTED? JMP MSGFM YES, LEAVE FIELD AS IS SSA T/O<0? JMP FRMER YES, ERROR SZA,RSS ZERO? JMP STND5 CMA,INA LDB A ADB D1275 SSB JMP FRMER JSB CFSEC ALF,ALF POSITION TO HIGH HALF-WORD * STND5 EQU * STA TEMP LDA NRV2 AND B377 IOR TEMP STA NRV2 * MSGFM EQU * HERE TO MERGE UPGRADE LEVEL NUMBER LDB PARSB+8 IS THIS NUMERIC, OR CPB B2 DEFAULTED? JMP FRMER NO, SCREAM ABOUT IT. LDA PARSB+9 GET UPGRADE LEVEL NUMBER SSA NEGATIVE? JMP FRMER YES, ERROR! AND B17 MASK SZB,RSS DEFAULTED? JMP 1 STND6 YES, SKIP THIS BLOCK STA TEMP ADA NMXLV > MAX LEVEL? SSA,RSS JMP FRMER YES, THIS IS AN ERROR. * LDA NRV2 AND B177. IOR TEMP INCLUDE THE UPGRADE LEVEL NUMBER STA NRV2 * STND6 EQU * LDA PARSB+12 IS "NEIGHBOR" FIELD DEFAULTED? SZA,RSS JMP STND7 LDB PARSB+13 LOAD "NEIGHBOR" INDICATION, IF ANY LDA NRV3 LOAD LU WORD AND NOT8 CLEAR "NEIGHBOR" INDICATOR CPB "N "NEIGHBOR" ? IOR B400 YES, SET "NEIGHBOR" BIT STA NRV3 * STND7 EQU * JSB CKNRE CHECK THIS NRV ENTRY (RETURN ONLY IF OK) * LDA NRV2 GET LEVEL # AND B17 MASK LEVEL FIELD STA B LDA #LEVL GET LOCAL NODE'S LEVEL AND B17 MASK LEVEL FIELD CMA,INA ADA B SSA,RSS IS NEW ENTRY LEVEL < LOCAL? JMP STNX NO, WE DON'T NEED TO WORRY ABOUT CONVERTERS * * WHEN THE NEW NODE IS OF A LOWER LEVEL THAN THE LOCAL, * WE NEED TO CHECK WHETHER THE MESSAGE CONVERTERS ARE * SCHEDULED. IF NOT, THEN REJECT THE NEW ENTRY. * LDA #INCV CHECK CLASS NUMBER (THAT'S THE EASIEST WAY) SZA JMP STNY CLASS # ASSIGNED, CHECK FOR OTCNV'S CLASS * MESSAGE CONVERTERS NOT SCHEDULED. THAT'S A BAD ERROR! NCVTR EQU * JSB ERROR DEF NCVT. JMP CHN0 * STNY EQU * LDA #OTCV DOES OTCNV HAVE A CLASS #? SZA,RSS JMP NCVTR NO, GIVE ERROR! * STNX EQU * JSB $LIBR LOWER SYSTEM DEFENSES NOP LDA @NRV1 LOAD SOURCE ADDRESS LDB NPNT LOAD DESTINATION ADDRESS JSB .LDX LOAD # WORDS TO MOVE DEF NRVS. STNOP JSB .MVW [MWI IF IN DMS CPU] DEF NRVS. NOP JSB $LIBX RESTORE SYSTEM PROTECTIONS DEF *+1 DEF *+1 * JSB PRNRV PRINT NEW NRV ENTRY FOR USER JMP CHN0 GO LOOK FOR ANOTHER NODEt TO CHANGE * NRVSZ NOP # WORDS IN NRV NOT8 OCT 177377 NOT BIT 8 SPC 2 SKP * FRMER EQU * JSB ERROR DEF NOSZR NODE SPEC. ERROR * JMP OPT20 RETRY NRV SET-UP * LUERX JSB SYSER DEF LUERM * * * * * * * * DO NOT CHANGE ORDER OF NEXT TWO STATEMENTS * * * * * CNODE OCT -1 CURRENT-USER NODE; -1=INACTIVE. OCT -1 DOWN-LOAD NODE: INITIAL VALUE. * NCNT NOP NODE LOOP COUNTER (-NO. OF NODES). NPNT NOP LOCAL NRV TABLE POINTER. XNODE NOP LOCAL SAVE OF LOCAL NODE # * * NRV ENTRY TEMPLATE. DO NOT DISTURB ORDER! * NRV1 NOP STORAGE FOR CPU NUMBER NRV2 NOP STORAGE FOR TIME-OUT/UPGRADE LEVEL # NRV3 NOP STORAGE FOR COMMUNICATION LINK LU @NRV1 DEF NRV1 NMXLV DEC -2 - (MAXIMUM UPGRADE LEVEL ALLOWED + 1) SKP SKP * * SUBROUTINE TO CHECK VALIDITY OF AN NRV ENTRY * CKNRE NOP LDA NRV3 CHECK THAT LU SPECIFIED AND B377 MASK LU PART... SZA,RSS IS A BONA FIDE COMMUNICATION JMP *+4 LU JSB LUTST JMP LUERX ILLEGAL LU--TAKE ERROR EXIT. JMP LUERX IT'S NOT A GOOD LU! SCREAM ABOUT IT! LDB NRV1 LOAD CPU NUMBER LDA NRV3 IF THIS ENTRY IS FOR THE LOCAL NODE, CPB #NODE SET THE "NEIGHBOR" BIT. IOR B400 STA NRV3 LDA NRV2 LOAD UPGRADE LEVEL CPB #NODE SAME AS LOCAL NODE? LDA #LEVL YES, FORCE LOCAL NODE'S UPGRADE LEVEL STA NRV2 JMP CKNRE,I RETURN TO CALLER SKP * ROUTINE TO OPEN ANSWER FILE. * OPENX NOP * JSB OPEN OPEN THE FILE DEF *+7 DEF INDCB DEF TEMP1 ERROR-RETURN LOC'N. DEF NAME FILE NAME LOC'N. DEF ZERO EXCLUSIVE OPEN. DEF ISEC SECURITY CODE (OR 0). DEF ICR CARTRIDGE NO. (OR 0). SSA,RSS ER RORS? ISZ OPENX NO--RETURN VIA P+2. JMP OPENX,I RETURN. * SKP SKEDM EQU * =1 TO DISALLOW DEFAULT SCHEDULING. JSB MSET GO TO SCHEDULE MONITOR(S). JMP OPT20 RETURN TO CHECK FOR OTHER OPTIONS. * OPT21 JSB LUIN GO TO ENABLE THE LINE. JMP OPT20 CHECK FOR OTHER OPTIONS. * OPT22 STB NRV3 SAVE THE SPECIFIED LOGICAL UNIT NO. JSB LUSET GO TO SET UP THE LOGICAL UNIT NO. JMP OPT2E * RTE-DETECTED ERROR--TRY AGAIN! * JMP TERM DON'T ASK FOR MORE INPUT * OPT23 JSB EN3K RE-ENABLE HP3000 LINK JMP TERM AND TERMINATE * OPT2E JSB ERROR REPORT THE DEF LUERM " LU ERROR", JMP TERM AND TERMINATE. * GLCNW OCT 100006 GLOBAL LOCK/CLEAR--NO WAIT. CUSNM EQU * CHANGE DEFAULT SESSION USER-NAME CLA,RSS CALL #DSSM W/ (A) = 0 * CUPSW EQU * CHANGE PASSWORD CLA,INA CALL #DSSM W/ (A) = 1 JSB #DSSM CALL EXTERNAL ROUTINE FOR THIS SET-UP JMP OPT20 GET NEXT OPTION SKP * NRV DISPLAY ROUTINE. * DSNRV LDA #NCNT GET ADDRESS OF NO. OF NODES. STA NCNT SAVE THE NUMBER OF NODES. CMA,INA,SZA,RSS ANYTHING SPECIFIED? JMP OPT20 NO--IGNORE THE REQUEST! JSB CNVTD CONVERT + NODE COUNT TO ASCII DBL NNODS * LDA #NODE GET LOCAL NODE NUMBER. JSB CNVTD CONVERT IT TO ASCII, DBL LOCLN AND CONFIGURE THE MESSAGE. JSB PRNTX PRINT THE FIRST MESSAGE DEF NODM1 WITHOUT A HEADER. * LDA #NRV GET THE NRV ADDRESS, STA NPNT AND SAVE THE POINTER. * DLOOP EQU * JSB PRNRV PRINT THIS NRV ENTRY LDA NPNT UPDATE POINTER ADA NRVS. STA NPNT * ISZ NCNT ANY MORE TO PROCESS? JMP DLOOP YES, CONTINUE. SPC 1 LDA OPTYP GET THE SYSTEM SPECIFICATION. SLA FOR DISC-BASED RTE SYST!TEMS, JMP OPT20 THE PROCESS IS COMPLETE. * LDA #LNOD GET THE DOWN-LOAD NODE NUMBER. CPA M1 IF IT HAS NOT BEEN USED, JMP PRAPM THEN IGNORE THE CONVERSION. JSB CNVTD CONVERT TO ASCII, DBL APNOD AND CONFIGURE THE MESSAGE. * PRAPM JSB PRNTX PRINT NODE NUMBER (OR "NONE"), DEF APMSG WITHOUT A HEADER. JMP OPT20 PROCESS COMPLETE--CHECK FOR NEW REQUEST. SKP * SUBROUTINE TO PRINT NEXT NRV ENTRY LINE * NPNT --> NEXT NRV ENTRY * PRNRV NOP * LDA NPNT MOVE ENTRY TO LOCAL STORAGE LDB @NRV1 JSB .LDX DEF NRVS. STND2 JSB .MVW (MWF IF IN DMS) DEF NRVS. NOP * LDA NRV1 GET A NODE NUMBER. CPA M1 BLANK ENTRY? JMP BLEN YES, PRINT "BLANK ENTRY" * JSB CNVTD CONVERT & CONFIGURE DBR NODEN * LDA NRV2 GET TIMEOUT/MSG FORMAT NUMBER AND B377 ISOLATE THE MSG. FORMAT # JSB CNVTD CONVERT DBL .LVL. & CONFIGURE. STB TEMP --> NEXT AVAILABLE BYTE * LDA NRV2 OBTAIN ALF,ALF TIME-OUT AND B377 VALUE SZA ZERO? IOR DM256 NO, SET ALL BITS IN UPPER BYTE CMA,INA MAKE THE VALUE POSITIVE (OR 0). MPY B5 CONVERT # INTERVALS TO # SECONDS JSB CNVTD CONVERT TO ASCII DBR NRVTO LDA NRV3 GET COMMUNICATION LU AND B377 MASK LU JSB CNVTD CONVERT AND CONFIGURE DBR VECTR ( RETURNS NEXT ADDRS) * LDB @SPC --> SPACES LDA NRV3 AND B400 IS THIS NODE SZA A NEIGHBOR OF OURS? LDB @.N. . YES --> ,(N) LDA 1 LDB TEMP --> NEXT AVAILABLE BYTE JSB .MBT MOVE IN SPACES OR NEIGHBOR INDICATION DEF D6 NOP JSB PRNTX PRINT NODAL ADDRESS DATA / DEF NRVMS WITHOUT THE HEADER. JMP PRNRV,I RETURN TO CALLER * BLEN JSB PRNTX DEF BLEN1 JMP PRNRV,I RETURN TO CALLER * BLEN1 DEF *+2 DEF D8 BLNKS ASC 7, BLANK ENTRY OCT 6412 SPC 3 NODM1 DEF *+2 DEF NODMX ASC 10,NRV SPECIFICATIONS: OCT 6412 ASC 7, LOCAL NODE#: LOCLN ASC 3, ASC 8, NO. OF NODES = NNODS ASC 3, NODMX ABS *-NODM1-2 * NRVMS DEF *+2 DEF NODML ASC 3, NODE= NODEN ASC 3, ASC 2, LU= VECTR ASC 3, ASC 5, TO(SEC.)= NRVTO ASC 3, ASC 4, LEVEL= .LVL. ASC 5, UPGRADE LEVEL & NEIGHBOR INDICATION NODML ABS *-NRVMS-2 * APMSG DEF *+2 DEF D17 ASC 13, LAST LOAD-NODE= APNOD ASC 3,NONE OCT 6412 @.N. DBL *+1 ASC 3,,(N) * BT137 OCT 37700 SKP * CHANGE 3000 ID SEQUENCE * IDSEQ EQU * JSB READ GET THE RESPONSE DEF DSMS4 LDA PRNTL GET # BYTES THAT WERE INPUT CPB /E IF ID SEQ NOT WANTED CLA LENGTH IS 0 LDB D$LID JSB STRID STORE LOCAL ID SEQ IN RES * JSB READ DEF DSMS5 LDA PRNTL CPB /E CLA LDB D$RID INB SKIP WORD FOR RETURN PARAM. JSB STRID JMP OPT20 * * DSMS4 DEF *+2 DEF D10 ASC 10,LOCAL ID SEQUENCE? _ DSMS5 DEF *+2 DEF D10 ASC 10,REMOTE ID SEQUENCE?_ * * SUBROUTINE TO STORE ID SEQ IN RES * (A) = # BYTES * (B) = ADDRESS IN RES * INBUF = ASCII INPUT BUFFER (ADDR = DINBF) * STRID NOP STB TEMP1 DESTINATION ADDR. * LDB A IS # BYTES .LE. 16? ADB DM17 SSB,RSS LDA D16 NO. TRUNCATE TO 16 BYTES. STA TEMP1,I STORE # BYTES. SZA,RSS JMP STRID,I IF NO ID, RETURN STA B BRS GET LAST CHARACTER IN BUFFER. ADB M1 ADB DINBF LDA B,I AND D255 CPA D32  IS IT A BLANK? JMP STR1 YES. LDA TEMP1,I NO. ARE THERE 16 BYTES? CPA D16 RSS JMP STR2 NO. STR1 LDA B,I YES. CLEAR THE BLANK (OR 16TH BYTE), AND DM256 STA B,I LDA TEMP1,I AND DECREMENT BYTE COUNT. ADA M1 STA TEMP1,I INA STR2 ISZ TEMP1 CLE,ERA NO. OF WORDS TO STORE. SZA,RSS JMP STRID,I IF NO ID, RETURN LDB TEMP1 DESTINATION ADDRESS STA TEMP1 # OF WORDS LDA DINBF SOURCE ADDRESS JSB .MVW PERFORM MOVE DEF TEMP1 NOP * JMP STRID,I RETURN TO CALLER SKP * NETWORK TIMING-VALUE MODIFICATION SECTION * TIME JSB GETV GO TO GET CURRENT VALUES. JSB PRNTX PRINT SECTION HEADER. DEF TMES " TIMING MODIFICATION" * JSB NMSCX OBTAIN & VERIFY NM SECURITY CODE * (RETURN ONLY IF CODES MATCH) JSB GTIME GET MASTER TIMEOUT VALUE DEF MSTMG MESSAGE DEF D1275 UPPER LIMIT JMP TI.SV DEFAULT ESCAPE JSB CFSEC CONVERT TIME IN SECONDS TO STA #MSTO COUNT OF 5-SEC INTERVALS * TI.SV JSB GTIME GET SLAVE TIMEOUT VALUE DEF SLVMG DEF D1275 JMP TI.BR JSB CFSEC STA #SVTO * TI.BR JSB GTIME GET BUSY REJECT RETRY WAIT DEF BZMG DEF D10 JMP TI.WA ADA M1 ALF,ALF BITS 11-8 HAVE BUSY RETRY COUNT AND B7400 ISOLATE THEM STA #BREJ * TI.WA JSB GTIME GET REMOTE-QUIET WAIT DEF WAITM DEF D7200 JMP TI.GH STA #WAIT * TI.GH EQU * GET MAXIMUM HOP COUNT JSB GTIME DEF MHCM DEF D327. JMP TI.GD STA #MHCT * TI.GD EQU * GET MAXIMUM LINE "DOWN" COUNTER JSB GTIME DEF MDCM DEF D327. JMP OPT20 STA #MDCT JMP OPT20 DONE WITH THIS SECTION SKP * S SUBROUTINE TO ASK FOR, GET, AND VERIFY A TIMING PARAMETER * GTIME NOP LDA GTIME,I GET MSG ADDR STA GTI1 ISZ GTIME LDA GTIME,I GET MAX ALLOWED VALUE ADDR STA VCKAD SAVE IT ISZ GTIME * GTI2 EQU * JSB READ GET RESPONSE GTI1 NOP SZA,RSS ANY CHANGE DESIRED? JMP GTIME,I NO CPA B1 NUMERIC RESPONSE? JMP VCHEK YES, CHECK THE LIMITS CPB /E DONE WITH TIMING PARAMETERS? JMP OPT20 YES * GTER JSB ERXFR INVALID RESPONSE DEF IVRES JMP GTI2 * VCHEK SSB VALUE NEGATIVE? JMP GTER YES, ERROR LDA GTI1 CMB,INB,SZB,RSS WAS VALUE NON-ZERO? CPA TI.WA+1 NO, IS THIS QUIESCENT WAIT? RSS YES, LOWER LIMIT OK JMP GTER NO, INPUT ERROR LDA 1 ADB VCKAD,I MAX-INPUT VALUE SSB TOO LARGE? JMP GTER YES ISZ GTIME NO, RETURN IT IN A JMP GTIME,I * SKP * * ROUTINE TO GET CURRENT SYSTEM TIMING VALUES FOR REPORT TO USER. * GETV NOP ENTRY/EXIT LDA #MSTO GET MASTER TIMEOUT VALUE. ADA DM256 FORM FULL DATA WORD. CMA,INA MAKE IT POSITIVE. MPY B5 CONVERT TO SECONDS JSB CNVTD GO TO CONVERT IT TO ASCII. DBR MSVAL+5 SPECIFY DESTINATION OF RESULT. * LDA #SVTO GET SLAVE TIMEOUT VALUE. ADA DM256 FORM FULL DATA WORD. CMA,INA MAKE IT POSITIVE. MPY B5 CONVERT TO SECONDS JSB CNVTD GO TO CONVERT IT TO ASCII. DBL SLVAL+5 SPECIFY DESTINATION OF RESULT. * LDA #BREJ GET REMOTE-BUSY RETRY COUNT. ALF,ALF RIGHT JUSTIFY IOR DM16 SET BITS 15-4 CMA MAKE IT POSITIVE JSB CNVTD GO TO CCONVERT IT TO ASCII. DBL RTVAL+6 SPECIFY DESTINATION OF RESULT. * LDA #WAIT GET QUIESCENT-WAIT INTERVAL VALUE. CMXeA,INA MAKE IT POSITIVE. JSB CNVTD GO TO CONVERT IT TO ASCII. DBR WTVAL+6 SPECIFY DESTINATION OF RESULT. LDA #MHCT LOAD "MAXIMUM HOP COUNT" CMA,INA JSB CNVTD CONVERT DBR GTNUM+7 LDA #MDCT MAKE VALUE POSITIVE CMA,INA JSB CNVTD CONVERT & PRINT MSG DBL MDVAL+13 JMP GETV,I RETURN. SKP * CNVTD- CONVERTS BINARY TO DECIMAL (LEFT JUST) * = BINARY * CNVTD NOP ENTRY/EXIT: ASCII CONVERSION ROUTINE. STA FLAG LDA @SPC LDB CNVTD,I JSB .MBT CLEAR AREA DEF D6 NOP LDA FLAG LDB CNVTD,I --> OUTPUT AREA ISZ CNVTD STA NBR SSA,RSS NEGATIVE NUMBER? JMP DEC1 . NO CMA,INA STA NBR SSA SPECIAL LOW NUMBER (-32768)? JMP DEC4 . YES LDA DASH JSB .SBT DEC1 STB ADR SAVE OUTPUT POINTER LDA DTBL STA D D --> DIVISOR TABLE LDA DM4 STA CTR STA FLAG CLEAR OUTPUT FLAG (SET TO 1) * DEC2 LDB NBR LSR 16 DIV D,I ISZ D STB NBR REMAINDER SZA OUTPUT OTHER THAN ZERO? JMP *+4 . YES OUTPUT IT LDB FLAG SSB OK TO OUTPUT? JMP DEC3 . NO FINISH LOOP IOR "0" STA FLAG SET OUTPUT FLAG (BIT15=0) LDB ADR --> OUTPUT FIELD JSB .SBT STB ADR SAVE OUTPUT FIELD DEC3 ISZ CTR JMP DEC2 * LDA NBR := ONES DIGIT LDB ADR --> OUTPUT IOR "0" JSB .SBT JMP CNVTD,I AND RETURN * DEC4 LDA @32K MOVE IN -32768 JSB .MBT DEF D6 NOP JMP CNVTD,I * @32K DBL *+1 ASC 3,-32768 DTBL DEF *+1 DEC 10000 DEC 1000 DEC 100 DEC 10 * "0" OCT 60 DASH ASC 1,-- @SPC DBL *+1 ASC 3, * CTR BSS 1 `FLAG BSS 1 BIT15=1 NO OUTPUT; BIT15=0 OUTPUT D BSS 1 ADR BSS 1 NBR BSS 1 * SPC 1 * UTILITY SUBROUTINE CFSEC NOP ENTRY/EXIT CCB CONVERT SECONDS TO DIV B5 FIVE SECOND INTERVALS. ADB B2 IF THE REMAINDER IS SSB THREE OR MORE, ADA M1 ROUND TO NEXT INTERVAL. SZA,RSS INSIST UPON A CCA MINIMUM COUNT = -1. AND D255 MASK OFF HIGH BITS JMP CFSEC,I RETURN SKP * TMES DEF *+2 DEF TMESL MESSAGE LENGTH ASC 18,TIMING MODIFICATION--CURRENT VALUES: OCT 6412 MSVAL ASC 9,MASTER T/O=XXXXXX OCT 6412 SLVAL ASC 8,SLAVE T/O=XXXXXX OCT 6412 RTVAL ASC 9,REMOTE-BUSY=XXXXXX OCT 6412 WTVAL ASC 10,REMOTE-QUIET=XXXXXX OCT 6412 GTNUM ASC 11,MAX. HOP COUNT=XXXXXX OCT 6412 MDVAL ASC 16,MAX LINE DWN CNT IN 5 MIN=XXXXXX OCT 6412 TMESL ABS *-TMES-2 * MSTMG DEF *+2 DEF D16 ASC 16,MASTER T/O [5 TO 1275 SECONDS]?_ SLVMG DEF *+2 DEF D16 ASC 16,SLAVE T/O [5 TO 1275 SECONDS] ?_ BZMG DEF *+2 DEF D15 ASC 15,REMOTE-BUSY RETRIES[1 TO 10]?_ WAITM DEF *+2 DEF D17 ASC 17,REMOTE-QUIET WAIT[0 TO 7200 SEC]?_ MHCM DEF *+2 DEF D16 ASC 16,MAXIMUM HOP COUNT[1 TO 32767]? _ ... MDCM DEF *+2 DEF D20 ASC 20,MAX LINE DWN CNT IN 5 MIN?[1 TO 32767]?_ .... * VCKAD EQU GETV * SKP * SUBROUTINE TO VERIFY THAT LU IS LINKED TO COMMUNICATION LINK DRIVER. * LUTST NOP LDA NRV3 GET LU # IOR BIT15 STA LU1 CONFIGURE FOR 'XLUEX' CALL CLA CLEAR 2ND WORD STA LU2 JSB XLUEX GO TO OBTAIN DEF *+4 THE EQUIPMENT TYPE DEF SD13 CODE FOR THE DEF LU1 SPECIFIED LOGICAL UNIT. DEF LUSET JMP LUTST,I TAKE THE ERROR EXIT! * ISZ LUTST LDA LUSET GET STATUS WORD. ALF,ALF AND B77 ISOLATE THE EQUIPMENT TYPE-CODE. CPA B65 IS THE LU LINKED TO 'DVA65'? ISZ LUTST YES. TAKE GOOD EXIT (P+2). CPA B66 LINKED TO DVA 66? ISZ LUTST YES. TAKE GOOD EXIT (P+2) JMP LUTST,I NO. ERROR: RETURN TO P+1. * LU1 NOP LU2 NOP NOTE: MUST FOLLOW 'LU1' IMMEDIATELY! BIT15 OCT 100000 OPT NOP SPC 2 * SUBROUTINE TO SET-UP & ENABLE A COMMUNICATION LINK. * LUSET NOP * LDA NRV3 GET THE LOGICAL UNIT NUMBER. AND B377 MASK LU FIELD STA OPT IOR BIT15 STA LU1 STORE LU LDA B3000 SET FOR ENABLE LISTEN REQUEST STA LU2 SAVE THE CONFIGURED CONTROL WORD. * JSB XLUEX GO TO RTE DEF *+4 TO REQUEST THAT DEF SD3 'COMMUNICATION DRIVER' SET UP & DEF LU1 ENABLE CONFIGURED LU DEF OPT LISTEN MODE FOR THE LU JMP LUSET,I * RTE-DETECTED ERROR--TRY AGAIN! * * ISZ LUSET ADJUST FOR"GOOD" RETURN RAR ROTATE STATUS SLA WAS THERE AN INITIALIZATION ERROR? JMP *+4 .YES * * SEND "UP" INDICATION TO GRPM IF OLD LINK LDA NRV3 = LU # JSB #RR4 JMP LUSET,I RETURN TO THE CALLER. * LDA NRV3 AND B377 JSB CNVTD CONVERT LU NUMBER TO ASCII DBL CNER. JSB PRINT AND PRINT ERROR DEF CNERR JMP LUSET,I RETURN TO CALLER SKP * SUBROUTINE TO RE-ENABLE HP3000 LU * * TURN OFF QUEX. UPLIN WILL BRING IT BACK UP, AND QUEX WILL * GO THROUGH ITS ABORT CYCLE. EN3K NOP JSB MESSS CALL RTE MESSAGE PROCESSOR. DEF *+3 DEF OFFQX DEF D9 NOP JMP EN3K,I RETURN * OFFQX ASC 5,OF,QUEX,1 SKP * HERE ON ANY ABORT CONDITIONS * WILL CLEAR ALL LU'S, FLAGS, * DE-ALLOCATE CLASS NUMBERS, * AN^D TERMINATE ALL MONITORS. * CALLING SEQUENCE * JMP ABORT * ABORT EQU * JSB PRINT PRINT "DSMOD ABORTED" @ABPR DEF ABRTM LDA @ABPR RETURN ERROR TO 'FATHER' PRGM STA $RTRN * PROGRAM TERMINATION PROCESSOR. * TERM EQU * JSB CHCKN WAS THERE A FILE JMP TERM1 NO...DON'T CLOSE IT LDA CLFLG IS IT A DUMMY DCB? SSA JMP TERM1 YES...DON'T CLOSE IT * JSB CLOSE CLOSE DEF *+3 THE DEF INDCB CONTROL DEF TEMP1 FILE. * TERM1 LDA $RTRN IF PROGRAM IS BEING ABORTED CPA @ABPR THEN IGNORE JMP TERM3 THE END MESSAGE. * JSB PRNTX GO TO PRINT THE @ENMG DEF ENDMG TERMINATION MESSAGE--SANS HEADER. * TERM3 EQU * ISZ $RTRN BUMP POINTER ISZ $RTRN TO ACTUAL MESSAGE JSB PRTN RETURN ERROR INFORMATION DEF *+2 TO THE BATCH PROCESSOR $RTRN NOP (CONTAINS DEF TO ENMSG OR ABRTM) JSB EXEC GO TO THE DEF *+2 RTE EXECUTIVE DEF D6 TO TERMINATE SKP * COMMUNICATION LINE ENABLING ROUTINE. * LUIN NOP JSB READ READ A RECORD DEF UPLUM CPA B1 WAS INPUT BINARY? JMP SAVLU YES. GO TO PROCESS THE LU. CPB /E END OF LIST? JMP LUIN,I YES. RETURN LUERR JSB ERXFR DEF LUERM "LU ERROR" JMP LUIN+3 TRY AGAIN * SAVLU STB NRV3 SAVE TEMPORARILY. CPB #LU3K HP3000 LU? JMP DT005 YES * GO VERIFY THAT LU IS LINKED TO BONA FIDE COMMUNICATION * DRIVER. JSB LUTST JMP LUERR NOT AN LU --- ERROR JMP LUERR NOT A COMM. DRIVER----ERROR JSB LUSET GO TO SET UP & ENABLE THE LU. JMP LUERR * RTE-DETECTED ERROR--TRY AGAIN! * * JMP LUIN+1 GO TO REQUEST ANOTHER LU NUMBER. * DT005 JSB EN3K ENABLE HP3000 LU JMP LUIN+1 Ep GO TO REQUEST ANOTHER LU NUMBER SKP D0 DEC 0 D2 DEC 2 D3 DEC 3 D12 DEC 12 D15 DEC 15 D16 DEC 16 D17 DEC 17 D20 DEC 20 D32 DEC 32 D255 DEC 255 D1275 DEC 1275 D7200 DEC 7200 DM4 DEC -4 DM5 DEC -5 DM16 DEC -16 DM17 DEC -17 DM100 DEC -100 DM256 DEC -256 B17 EQU D15 B65 OCT 65 B66 OCT 66 B77 OCT 77 B377 OCT 377 B400 OCT 400 B7400 OCT 7400 B3000 OCT 3000 B177. OCT 177760 D327. DEC 32767 SD3 OCT 100003 SD13 OCT 100015 M1 EQU CNODE * * NOTE: DO NOT CHANGE ORDER OF RLU & XLU * RLU NOP XLU NOP * TEMP NOP XSBAI XSB A,I DMS: CROSS-STORE VIA ALTERNATE MAP. XLBAI XLA B,I CROSS-LOAD MWII MWI MOVE TO ALTERNATE MAP NOP (THIS 'NOP' REQ'D HERE!) MWFI MWF MOVE FROM ALTERNATE MAP NOP (THIS 'NOP' REQ'D HERE!) * TEMP1 NOP /A ASC 1,/A /E ASC 1,/E "EX" ASC 1,EX /I ASC 1,/I /L ASC 1,/L /N ASC 1,/N /P ASC 1,/P /Q ASC 1,/Q /R ASC 1,/R /S ASC 1,/S /T ASC 1,/T /U ASC 1,/U CN ASC 1,CN TYPEQ NOP CLFLG NOP OPTYP NOP SKP * CLASS NUMBER ALLOCATION SUBROUTINE. * * ENTER: & - DON'T CARE (DESTROYED ON RETURN). * - CLASS NUMBER ADDRESS. * CLSUB NOP ENTRY/EXIT: CLASS SUBROUTINE. LDB CLSUB,I GET THE CLASS NUMBER ADDRESS. ISZ CLSUB SET RETURN TO . LDA B,I GET THE CLASS NUMBER--IF ANY ALR,RAR REMOVE BUFFER-SAVE BIT(#14) SEZ,RSS IF REQUEST TO GET A CLASS, CLA USE ZERO CLASS NUMBER. IOR CLREQ SET NO-WAIT/CLASS-SAVE BITS(15,13). STA B,I SAVE MODIFIED CLASS NO. SPECIFICATION. STB CLSAD CONFIGURE THE CALL WITH CLASS NO. ADDR. SEZ DE-ALLOCATION REQUEST? JMP DEALC YES. * JSB CLRQ ALLOCATE A CLASS NUMBER DEF *+4 DEF CLACD CLASS ALLOCATION CODE CLSAD NOP CLASS NUMBER ADDRESS STORED HERE DEF ZERO DO NOT ASSIGN OWNERSHIP JMP CLERR --ERROR RETURN SSA WAS CLASS NUMBER ALLOCATED? JMP NOCL# NO CLASS NUMBERS AVAILABLE * * LDA CLSAD,I SET PROPER BITS IN CLASS NUMBER ALR,RAR CLEAR "NO WAIT" BIT IOR CBITS SET "SAVE BUFFER" & "NO DE-ALLOCATE" BITS STA CLSAD,I JMP CLSUB,I RETURN TO CALLER * DEALC JSB CLRQ DE-ALLOCATE THE CLASS DEF *+3 DEF CLDAL CLASS NUMBER DE-ALLOCATION CODE DEF CLSAD,I NOP (IGNORE ERRORS) * JMP CLSUB,I RETURN TO CALLER * CLACD OCT 140001 ALLOCATE CLASS, NO-WAIT, NOABORT CLDAL OCT 140002 DE-ALLOCATE CLASS, NO-WAIT, NO ABORT CLS21 OCT 100025 CLREQ OCT 120000 CBITS OCT 60000 * NOCL# EQU * HERE IF NO CLASS NUMBER JSB SYSER CATASTROPHIC ERROR: DEF NOCL. NO CLASS NUMBERS CLERR JSB SYSER GO TO INFORM THE USER OF A DEF CLSER CATASTROPHIC CLASS-PROCESSING ERROR. SKP * DELAY SUBROUTINE: DELAY EXECUTION FOR 1-SECOND. * SET (BEFORE ENTRY) TO NEGATIVE NUMBER OF PASSES * ALLOWED THROUGH , BEFORE RETURN TO P+1 ERROR-RETURN. * NORMAL RETURN IS TO P+2, FOLLOWING DELAY OF 1-SECOND. * DELAY NOP ENTRY/EXIT: DELAY SUBROUTINE. JSB EXEC WAIT DEF *+6 1 SECOND DEF D12 TO ALLOW DEF ZERO SYSTEM DEF B1 CONDITIONS TO DEF ZERO CHANGE DEF DM100 AS REQUIRED. ISZ RETRY IF RETRY COUNT IS NOT EXHAUSTED, ISZ DELAY THEN SET RETURN TO P+2; ELSE, IF JMP DELAY,I EXHAUSTED, RETURN TO P+1--ERROR! * RETRY NOP RE-TRY COUNTER SKP * ROUTINE TO ASK FOR, OBTAIN & VERIFY A SECURITY CODE * SPECIFIED IS IN ASCII. * SCODX NOP LDA SCODX,I LOAD ADDRESS OF "PROMPT" MESSAGE STA SCOD. SAVE IN--LINE ISZ SCODX BUMP RETURN POINTER JSB SWPLU TEMPORARILY SUPPRESS THE "ECHO" BIT * SCOD0 EQU * JSB READ INPUT RESPONSE SCOD. NOP CPA B2 RESPONSE ASCII? RSS YES,... JMP SCOD0 NO, REPEAT QUESTION JSB SWPLU RESTORE "ECHO" BIT LDB PARSB+1 RECOVER SECURITY CODE SPC 1 UNL JSB S LST JMP SCODX,I RETURN. * SPC 1 * SUBROUTINE TO OBTAIN NETWORK MANAGEMENT ACCESS SECURITY CODE NMSCX NOP JSB SCODX DEF SECNM "NETWORK MANAGEMENT SECURITY CODE?" CPB #NMSC CODES MATCH? JMP NMSCX,I YES, RETURN JMP ABORT NO--TOUGH LUCK * * SUBROUTINE TO SWITCH 'RLU' AND 'XLU' (XLU = RLU W/O ECHO BIT) SWPLU NOP DLD RLU SWP DST RLU JMP SWPLU,I RETURN TO CALLER SPC 1 SECNM DEF *+2 DEF D17 ASC 17,NETWORK MANAGEMENT SECURITY CODE?_ * UNL S NOP BLF,BLF CMB JMP S,I LST SKP * SYSTEM QUIESCEING ROUTINE (SUSPEND NETWORK COMMUNICATIONS). * * [ CAUTION: DO NOT MAKE CHANGES TO ,, OR RTNS.] * QUIES JSB PRINT " SYSTEM QUIESCENCE" DEF QHED JSB NMSCX OBTAIN & VERIFY NM SECURITY CODE * (RETURN ONLY IF CODES MATCH) JSB RNRQ GO TO RTE DEF *+4 TO REQUEST DEF B2 A GLOBAL LOCK DEF #QRN UPON THE QUIESCENT DEF TEMP1 RESOURCE NUMBER. * * LOOP TO WAIT FOR TCB TO GO TO ZERO * QLOOP EQU * LDA #BUSY SZA,RSS JMP DISAB JSB EXEC GO TO SLEEP FOR 5 SEC DEF *+6 DEF D12 DEF D0 DEF D2 DEF D0 DEF DM5 JMP QLOOP JSB #MAQS SEE IF MA IS DONE * * LOOP TO DISABLE ALL LINKS IN NRV * DISAB EQU * DLD #NCNT SZA,RSS IS NRV THERE? JMP DISLV .NO, SKIP DISABLE LOOP STA NCNT STB NPNT ADB XMTL. POINT TO LU DSMD1 LDA B,I NOP AND XMASK IOR BIT15 STA LU1 LDA CLSTN STA LU2 STB NPNT JSB XLUEX DEF *+3 DEF SD3 DEF LU1 NOP LDB NPNT ADB NRVS. ISZ NCNT JMP DSMD1 * DISLV EQU * JSB #RR5 DISABLE ALL LUS IN LV TABLE JSB PRINT DEF QEND JMP TERM GO TO TERMINATION. * XMASK EQU B377 CLSTN OCT 3100 XMTL. DEC 2 SKP * RE-START A FORMERLY QUIESCED SYSTEM. * * [ CAUTION: DO NOT MAKE CHANGES TO ,, OR RTNS.] * REQUE JSB PRINT DEF RQHED " QUIESCENT RE-START" JSB NMSCX OBTAIN & VERIFY NM SECURITY CODE * (RETURN ONLY IF CODES MATCH) * * LOOP TO ENABLE LINKS IN NRV * DLD #NCNT STA NCNT STB NPNT ADB XMTL. DSMD2 LDA B,I NOP AND XMASK STA NRV3 STB NPNT JSB LUSET LDB NPNT ADB NRVS. ISZ NCNT JMP DSMD2 JSB #RR6 ENABLE ALL RR LINKS JSB RNRQ GO TO RTE DEF *+4 TO REQUEST DEF B4 AN UNLOCKING OF DEF #QRN THE QUIESCENT DEF TEMP1 RESOURCE NUMBER. JMP OPT20 CHECK FOR OTHER OPTIONS. * SPC 1 QHED DEF *+2 DEF D9 ASC 9,SYSTEM QUIESCENCE QEND DEF *+2 DEF D10 ASC 10,SYSTEM IS QUIESCENT RQHED DEF *+2 DEF D9 ASC 9,QUIESCENT RE-START SKP * DEFINE TOTAL # OF MONITORS * * [ ADD 1 TO THE VALUE FOR EACH NEW MONITOR TO BE ADDED ] * #MON EQU 11 MNMON ABS -#MON DEFINE NEGATIVE NUMBER OF MONITORS. SPC 1 NAMA DEF NAMES SPC 1 NAMES ASC 3,DLIST DIRECTORY LISTING MONITOR. B1 DEC 1 STREAM 1 ZERO OCT 0 NO ABORT! * CNSLM ASC 3,CNSLM HP3000 CONSOLE MONITOR B2 DEC 2 V STREAM 2 OCT 100000 ABORT O.K. * ASC 3,EXECW SCHEDULE-WITH-WAIT MONITOR. B3 DEC 3 STREAM 3 OCT 100000 ABORT O.K. * ASC 3,PTOPM PROGRAM-TO-PROGRAM MONITOR. B4 DEC 4 STREAM 4 OCT 0 NO ABORT! * ASC 3,EXECM REMOTE EXEC-REQUEST MONITOR. B5 DEC 5 STREAM 5 D5 EQU B5 OCT 0 NO ABORT! * RFAM ASC 3,RFAM REMOTE FILE ACCESS MONITOR. D6 DEC 6 STREAM 6 B6 EQU D6 OCT 0 NO ABORT! * ASC 3,OPERM REMOTE OPERATOR-REQUEST MONITOR. B7 DEC 7 STREAM 7 D7 EQU B7 OCT 100000 ABORT O.K. * ASC 3,VCPMN VIRTUAL CONTROL PANEL MONITOR D8 DEC 8 STREAM 8 B10 EQU D8 OCT 0 NOT ABORTABLE! * ASC 3,PROGL ABSOLUTE PROGRAM-LOADING MONITOR. D9 DEC 9 STREAM 9 OCT 0 NO ABORT! * ASC 3,RDBAM REMOTE DATA BASE ACCESS MONITOR D10 DEC 10 STREAM 10 OCT 0 NO ABORT! * ASC 3,APLDX MINI-APLDR D11 DEC 11 STREAM 11 OCT 100000 ABORT OK! SKP * * ROUTINE TO SCHEDULE USER-SPECIFIED SLAVE MONITORS. * MSET NOP ENTRY/EXIT: MONITOR SCHEDULING RTN. MLOOP LDA MNMON INITIALIZE A COUNTER STA MCNT FOR THE NO. OF MONITORS TO SCHEDULE. LDB NAMA INITIALIZE THE STB NAMPT PROGRAM NAME-ARRAY POINTER. * * JSB READ GET THE USER'S RESPONSE. DEF MONMS CPB /E ALL DONE? JMP MSET,I YES. RETURN FOR NEXT OPERATION. CPA B2 IF RESPONSE WAS ASCII-ALPHA. CHARACTERS, RSS THEN SKIP TO CHECK FOR A VALID NAME; JMP NAMER ELSE, INFORM THE USER OF HIS ERROR! * * VERIFY THAT PROGRAM NAMED IS ONE OF THE DS/1000 MONITORS * LDB NAMPT POINT TO FIRST NAME. MCOMP STB NAMPT SAVE THE POINTER. LDA PARS2 ADDRESS OF USER'S MONITOR NAME. JSB {.CMW COMPARE THE THREE WORDS. DEF B3 NOP JMP MFOUN ALL COMPARE--GO TO SCHEDULE. NOP NO COMPARISON. ADB B2 ADD OFFSET FOR NEXT NAME ENTRY. ISZ MCNT HAVE ALL OF THE NAMES BEEN CHECKED? JMP MCOMP NO. GO TO CHECK THE NEXT ONE. * NAMER JSB ERROR INFORM THE USER OF HAVING SUPPLIED AN DEF INVNM " INVALID NAME!" JMP MLOOP GO BACK TO TRY AGAIN. * SKP MFOUN EQU * JSB MSKED GO TO SCHEDULE THE MONITOR. JMP MLOOP GO TO ASK FOR THE NEXT NAME. * PARS2 DEF PARSB+1 CNSDF DEF CNSLM RFMDF DEF RFAM SCHNW OCT 100012 STMPT NOP NAMPT NOP MCNT NOP SPC 1 * DO NOT CHANGE ORDER OF 'MCLAS' & 'IDAD' * SPC 1 MCLAS NOP IDAD NOP * QUES ASC 2,MON? ASTAT ASC 2,STAT SMES DEF *+2 DEF D9 ASC 3,ERROR: ERCOD ASC 3, : SNAM ASC 3,XXXXX MONMS DEF *+2 DEF D7 ASC 7,MONITOR NAME?_ INVNM DEF *+2 DEF B7 ASC 7,INVALID NAME! * NODEF DEF *+2 DEF D15 ASC 15,LU,TIMEOUT,UPGRADE LEVEL[,N]?_ .... * @SNAM DEF SNAM * SKP * SUBROUTINE TO SCHEDULE A MONITOR & INITIALIZE ITS LIST-HEADER ENTRY. * MSKED NOP ENTRY/EXIT: MONITOR SCHEDULER. LDA NAMPT GET THE NAME-ARRAY POINTER. CPA CNSDF ABOUT TO SCHEDULE ? RSS YES. CHECK FURTHER. JMP GETID NO. GO AHEAD AND SCHEDULE LDB #LU3K IS HP3000 CONNECTED? SZB,RSS YES. GO AHEAD AND SCHEDULE. JMP MSKED,I NO. IGNORE SCHEDULING OF * GETID JSB PGMAD GO TO GET MONITOR'S ID SEGMENT ADDRESS. DEF *+2 DEF NAMPT,I ADDRESS OF MONITOR'S NAME. SZA,RSS IS THE MONITOR PRESENT? JMP MON? NO. INFORM THE USER. STA IDAD YES. SAVE I.D. SEGMENT ADDRESS. LDA B GET MONITOR'S STATUS INTO . AND B17 ISOLATE THE MONITOR'S STATUS. SZA IS I T DORMANT? JMP STERR NO. INFORM USER OF ERROR. * JSB CLSUB GET A CLASS NUMBER DEF MCLAS FOR THE MONITOR. LDB NAMPT GET THE NAME-ARRAY POINTER. ADB B3 ADVANCE TO THE STREAM-LIST ENTRY. LDA B,I GET STREAM NUMBER ADA B2 COMPUTE ADA #LDEF LIST HEADER LDA 0,I ADDRESS. INA POINT TO CLASS NUMBER IN HEADER STA STMPT SAVE FOR 'RES' INITIALIZATION. INB ADVANCE TO THE ABORT-FLAG ENTRY. STB PRNTX SAVE ADDRESS * LDA NAMPT GET THE NAME-ARRAY POINTER CPA RFMDF IF 'RFAM' IS BEING SCHEDULED, THEN JSB FILIN GET THE FILE COUNT FOR IT. * LDA MCLAS GET CLASS NO. & STA STMPT,I STORE INTO STREAM LIST-HEADER IN 'RES'. ISZ STMPT BUMP POINTER TO 3RD WORD LDA NAMPT MOVE MONITOR NAME LDB STMPT TO JSB .MVW SLAVE STREAM DEF D3 HEADER NOP * * SET SIGN BIT IN 3RD WORD OF STREAM HEADER IF MONITOR IS * ABORTABLE. * LDA STMPT,I IOR PRNTX,I MERGE ABORTABLE-BIT (IF PRESENT) STA STMPT,I RESTORE IN STREAM HEADER SKP * JSB EXEC GO TO RTE DEF *+5 TO SCHEDULE DEF SCHNW THE MONITOR DEF NAMPT,I WITHOUT WAIT. DEF MCLAS SCHEDULING PARAMETER #1. DEF ERLU SCHEDULING PARAMETER #2. JMP STCOD * ERROR--REPORT TO USER * SZA WAS IT CORRECTLY SCHEDULED? JMP STERR NO--INCORRECT STATUS ERROR. * JMP MSKED,I RETURN TO THE CALLER (=STATUS). * MON? DLD QUES GET THE MONITOR-MISSING INDICATOR. JMP STCOD SAVE FOR THE ERROR MESSAGE. STERR DLD ASTAT GET THE STATUS-PROBLEM INDICATOR. STCOD DST ERCOD SAVE THE ERROR CODE. * LDA NAMPT MOVE THE MONITOR NAME LDB @SNAM FOR USE IN H JSB .MVW ERROR MESSAGE DEF B3 NOP * JSB ERROR GO TO PRINT THE DEF SMES ERROR MESSAGE. JMP MSKED,I RETURN TO THE CALLER. SPC 3 * SUBROUTINE TO GET SIZE OF OVERFLOW FILE FOR USE BY 'RFAM' * FILIN NOP JSB READ GET RESPONSE DEF FILMG CPA B1 INPUT NUMERIC? JMP GFIL2 YES * JSB ERXFR "FILE ERROR" DEF FERMG JMP FILIN+3 RETRY * GFIL2 STB #RFSZ SAVE NUMBER OF FILES JMP FILIN,I AND RETURN TO CALLER. SKP * SUBROUTINE TO PRINT MESSAGES ON INTERACTIVE TERMINALS--ONLY. * * CALLING SEQUENCES: * * JSB PRINT....PRINT:" /DSMOD:" JSB PRNTX....PRINT:"" * DEF MESSAGE DEF MESSAGE * PRNTX NOP ENTRY/EXIT: PRINT W/O HEADER LDA PRNTX GET THE RETURN ADDRESS. STA PRINT SAVE FOR THE RETURN. LDA A,I GET THE MESSAGE ADDRESS, STA OLDAD AND SAVE FOR ERROR-TRANSFER ROUTINE. DLD A,I GET THE MESSAGE SPECIFICATIONS, DST PRNT1 AND CONFIGURE THE CALLING SEQUENCE. JMP PRNT0 GO TO PRINT THE MESSAGE W/O HEADER. * PRINT NOP NORMAL ENTRY/EXIT DLD NORMA RE-ESTABLISH THE DST PRNT1 NORMAL MESSAGE SPECIFICATIONS. LDA MSGAD INITIALIZE THE STA BUFPT MESSAGE BUFFER POINTER. LDB PRINT GET ADDRESS OF MESSAGE INFORMATION. LDB B,I TRACK DOWN RBL,CLE,SLB,ERB A DIRECT JMP *-2 ADDRESS. LDA RDER IF THE ERROR-TRANSFER ROUTINE IS SZA,RSS IN CONTROL, BYPASS 'OLDAD' UPDATING. STB OLDAD SAVE IT FOR THE ERROR-TRANSFER ROUTINE. DLD B,I GET BUFFER ADDRESS AND LENGTH. STA MSPNT SAVE FOR SOURCE POINTER. LDB B,I GET THE MESSAGE LENGTH. STB PRNTL INCLUSION OF THE HEADER. CMB,INB IF THE MESSAGE LENGTH ADB D20  EXCEEDS THE MAXIMUM SSB BUFFER SIZE, THEN JMP PRNTA IGNORE THE REQUEST; ELSE, DLD MSPNT TRANSFER THE MESSAGE JSB .MVW TO THE PRINT BUFFER. DEF PRNTL NOP LDA PRNTL GET THE MESSAGE LENGTH. ADA B5 ADD IN THE HEADER SIZE. STA PRNTL SAVE TOTAL MESSAGE LENGTH. * PRNT0 LDA TYPEQ GET TTY FLAG LDB ERFLG GET ERROR FLAG SZB,RSS ERROR OR SZA,RSS OR INTERACTIVE RSS YES...PRINT MESSAGE JMP PRNTA NO ERROR AND NOT INTERACTIVE LDA RLU GET INTERACTIVE LU SZB ERROR? LDA ERLU YES...ERROR LU STA PRTLU SAVE AS PRINT LU * SKP JSB REIO PRINT MESSAGE DEF *+5 DEF B2 DEF PRTLU PRINT LU PRNT1 DEF HEDMS MESSAGE ADDRESS. DEF PRNTL MESSAGE LENGTH. PRNTA ISZ PRINT POINT TO RETURN ADDRESS JMP PRINT,I RETURN SPC 1 ERLU NOP ERROR LOGICAL UNIT NO. PRTLU NOP PRNTL NOP OLDAD NOP PREVIOUS MESSAGE ADDRESS. BUFPT NOP NORMA DEF HEDMS DEF PRNTL MSPNT NOP MSGAD DEF MSGBF HEDMS OCT 6412 CARRIAGE-RETURN/LINEFEED. ASC 4,/DSMOD: MSGBF BSS 20 * * ROUTINE TO DECIDE WHICH TYPE OF INPUT DEVICE * EITHER FILE OR LU * IF LU, A-REG WILL CONTAIN LU TYPE, B-REG = READ LU, E=0 * CALLING SEQUENCE * JSB CHCKN * * * CHCKN NOP LDB RLU GET READ-DEVICE LU. LDA TYPEQ GET EQUIPMENT TYPE CODE. CLE,SZB,RSS LU OR FILE ISZ CHCKN FILE JMP CHCKN,I AND RETURN * * SUBROUTINE TO PRINT SYSTEM ERROR MESSAGES AND * ABORT * CALLING SEQUENCE * JSB SYSER * DEF ERR MESSAGE * SYSER NOP LDA SYSER,I GET MESSAGE SPECIFICATION ADDRESS. STA SYSAD CONFIGURE CALL TO PRINT ROUTINE. ISZ ERFLG SET ERROR FLAG. JSB APRINT SYSAD NOP JMP ABORT AFTER MESSAGE...ABORT SKP * SUBROUTINE TO READ FROM A SELECTED INPUT DEVICE * WILL PARSE THE INPUT AND PLACE RESULT IN A BUFFER * CALLED PARSB. IF FIRST PARAMETER = '/A' WILL GO TO 'ABORT'. * CALLING SEQUENCE: * * JSB READ * DEF MESSAGE TO BE PROMPTED * UPON RETURN A REG=PARSB, B REG=PARSB+1 * READ NOP LDB READ,I STB .PRAD ISZ READ LDA DM4 ALLOW THREE STA RETRY ERROR-RETRIES. READA EQU * JSB PRINT .PRAD NOP LDA RLU GET READ LU LDB RDER IS THIS AN ERROR READ? SZB LDA ERLU YES...READ FROM ERROR DEVICE. SZA,RSS IF THE SOURCE IS FROM A FILE, JMP READB THEN GO TO FILE READ ROUTINE. STA PRTLU SAVE READ LU JSB REIO ISSUE THE READ DEF *+5 DEF B1 DEF PRTLU DINBF DEF INBUF DEF INBFS SZB EOF HIT? JMP READC NO REDER JSB ERXFR INDICATE ERROR, AND ALLOW RE-TRY. DEF READM JMP READA TRY AGAIN SPC 1 READB EQU * JSB READF READ FROM A FILE DEF *+6 DEF INDCB DEF TEMP1 DEF INBUF DEF INBFS DEF PRNTL LDB PRNTL GET LENGTH SSA,RSS FILE ERROR? SZB,RSS OR ZERO-LENGTH RECORD? JMP REDER YES--PROCESS THE ERROR. * READC EQU * CLE,ELB CONVERT TO BYTE LENGTH STB PRNTL SAVE LENGTH LDA INBUF GET AND =B77400 FIRST CPA ASTSK CHARACTER: ASTERISK(*) ? JMP READA YES, READ ANOTHER ONE JSB PARSE GO PARSE INPUT DEF *+4 DEF INBUF DEF PRNTL DEF PARSB CLA,CLE CLEAR OUT READ-ERROR FLAG STA RDER DLD PARSB LOAD A AND B REG CPB /A IF RECORD'S FIRST 2 CHARS. =/A JMP *+2 SKIP TO CHECK NEXT TWO. JMP READ,I ELSE, RETURN. LDB PARSB+2 GET NEXT TWO CHARACTERS. CPB BLNKS IF THEY ARE BLANKS, JMP ABORT THEN PROCESS THE ABORT REQUEST! LDB PARSB+1 ELSE, RESTORE , JMP READ,I AND RETURN. * RDER NOP ASTSK OCT 25000 ASCII "*" IN HIGH BYTE SPC 2 * ROUTINE TO PRINT ERROR MESSAGE. * * CALLING SEQUENCE: * * JSB ERROR * DEF * * WILL SET ERROR FLAG FOR RETRY * ERROR NOP LDA ERROR,I GET MESSAGE SPECIFICATION ADDRESS. STA ERRAD CONFIGURE CALL TO PRINT ROUTINE. ISZ ERFLG FORCE MESSAGE TO ERROR DEVICE. JSB PRINT PRINT THE ERROR MESSAGE. ERRAD NOP CLA CLEAR THE STA ERFLG ERROR-DEVICE FLAG. ISZ ERROR BYPASS THE MESSAGE-SPECIFICATION. JMP ERROR,I AND RETURN SPC 1 ERFLG NOP SPC 2 * PRINT THE ERROR MESSAGE AND REPEAT THE QUESTION ON THE (ERROR LU) DEVICE. * * CALLING SEQUENCE: * * JSB ERXFR * DEF * ERXFR NOP ENTRY/EXIT: ERROR TRANSFER ROUTINE ISZ RDER SET READ ERROR FLAG. ISZ RETRY ALL RETRIES BEEN EXHAUSTED? JMP *+2 NO. TRY AGAIN. JMP ABORT YES--ABORT THE PROCESS! * LDA ERXFR,I GET MESSAGE ADDRESS. STA ERAD1 ISZ ERFLG FORCE THE USE OF THE (ERROR LU). JSB PRINT GO TO PRINT ERAD1 NOP * CLA CLEAR OUT STA ERFLG THE ERROR FLAG, ISZ ERXFR SET RETURN ADDRESS JMP ERXFR,I AND RETURN. * * * SUBROUTINE TO CHECK DRIVER TYPE * CALLING SEQUENCE: JSB TTY? * DEF * UPON RETURN, A-REG=LU NUMBER, B-REG=0 IF INTERACTIVE, ELSE DRIVER TYPE * TTY? NOP LDA TTY?,I STORE ADDRESS OF STA CHKLU LU IN EXEC CALL. ISZ TTY? SET RETURN ADDRESS. * JSB IFTTY CALL IFTTY TO DETERMINE STATUS. DEF *+2 CHKLU DEF *-* INA CHANGE IFTTY'S -1 TO 0. . SZA,RSS INTERACTIVE? JMP *+4 .YES, SKIP SET UP LDA B ALF,ALF AND B377 MASK ALL BUT DRIVER TYPE * LDB A MOVE TO B-REG. LDA CHKLU,I A-REG := LU NUMBER. JMP TTY?,I RETURN. SKP SKP .NRVS EQU 3 # WORDS PER NRV ENTRY SPC 2 *** THREE SCHEDULING PARAMETERS ARE SET UP BY #PKUP *** * * PARAMETER MASK FOR #PKUP-- PMASK BYT 3,1 3 PARAMETERS, 1ST IS NAMR. * *** NOTE: DO NOT CHANGE ORDER OF NEXT 4 LINES! NAME BSS 10 RTE FILE NAMR PARAMETERS. ITYPE EQU NAME+3 ISEC EQU NAME+4 ICR EQU NAME+5 PRM2 NOP ERROR LU/CLASS NUMBER (2ND PARAM) PRM3 NOP RECORD LEN(3RD PARAM) * DEFLU NOP DEFAULT LU NUMBER. SPC 2 NINIT DEF *+2 "NODE NOT INITIALIZED" DEF D10 ASC 10,NODE NOT INITIALIZED * NCVT. DEF *+2 DEF D7 ASC 7,NO MSG.CNVTRS! * FERMG DEF *+2 DEF D5 ASC 5,FILE ERROR * "N ASC 1,N * LUERM DEF *+2 DEF B5 ASC 5,LU ERROR * TRFM DEF *+2 DEF D7 ASC 7,TR FILE ERROR * FILMG DEF *+2 DEF D6 ASC 6,# OF FILES?_ .... * READM DEF *+2 DEF D5 ASC 5,READ ERROR * ABRTM DEF *+2 DEF D7 ASC 7,DSMOD ABORTED! * NOCL. DEF *+2 DEF D6 ASC 6,NO CLASS #S * CLSER DEF *+2 DEF D8 ASC 8,CLASS I/O ERROR * ENDMG DEF *+2 DEF B5 ASC 5,END DSMOD * UPLUM DEF *+2 DEF B6 ASC 6,ENABLE LU#?_ * NODEX DEF *+2 DEF D9 ASC 9,NODE # TO CHANGE?_ .... * OPMES DEF *+2 DEF D6 ASC 6,OPERATION? _ ... * NOSZR DEF *+2 DEF D9 ASC 9,NODE SPEC. ERROR! * * CNERR DEF *+2 DEF D12 ASC 9,INIT. FAILED ON LU CNER. BSS 3 * EXPMS DEF *+2 DEF EXPML MESSAGE LENGTH OCT 6412 CARRIAGE-RETURN/LINE-FEED ASC 9,??: LIST COMMANDS OCT 6412 ASC 5,/A: KWABORT! OCT 6412 ASC 7,/E: TERMINATE OCT 6412 ASC 11,/I: CHANGE 3000 ID SEQ OCT 6412 ASC 10,/L: RE-ENABLE LINE OCT 6412 ASC 8,/N: DISPLAY NRV OCT 6412 ASC 13,/P: CHANGE NON-SESN PASWD OCT 6412 ASC 9,/Q: QUIESCE NODE OCT 6412 ASC 12,/S: SCHEDULE MONITOR(S) OCT 6412 ASC 9,/T: ADJUST TIMING OCT 6412 ASC 17,/U: CHANGE DEFAULT SESN USR-NAME OCT 6412 ASC 8,CN: CHANGE NRV OCT 6412 OCT 6412 ASC 12,QUIESCENT SYSTEM ONLY: OCT 6412 ASC 9,/R: RE-START NODE OCT 6412 EXPML ABS *-EXPMS-2 MESSAGE LENGTH * IVRES DEF *+2 DEF D9 ASC 9,INVALID RESPONSE! * SPC 3 A EQU 0 B EQU 1 NRVS. ABS .NRVS # WORDS IN EACH TCB ENTRY INBFS EQU D20 INBUF BSS 20 PARSB BSS 34 INDCB BSS 144 USED FOR ANSWER FILES. * * DEFINE ENTRY POINTS FOR ACCESS TO INTERNAL ROUTINES * PRNT# EQU PRINT READ# EQU READ INBF# EQU INBUF PRNL# EQU PRNTL ERFR# EQU ERXFR EXFR# EQU ERXFR ABRT# EQU ABORT SPC 1 BSS 0 << SIZE OF 'DSMOD' >> SPC 1 END DSMOD A #&J 91750-18093 2013 S C0122 &DSMXI              H0101 ASMB,R,L NAM DSMXI,7 91750-1X093 REV 2013 791129 MEF * * * SOURCE: 91750-18093 * RELOC.: 91750-1X093 * PRGMR: LYLE WEIMAN, JUNE 1979 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * DS/1000 EIG INSTRUCTION REPLACEMENT LIBRARY ROUTINE * * EXTENDED INSTRUCTION GROUP REPLACEMENTS ARE DEFINED HERE, * PROVIDING DS/1000 WITH COMPATIBILITY WITH 21LC, AND GIVING * THE SPEED ADVANTAGE POSSIBLE WITH MICROCODE ROUTINES WHEN * 21MX M-, E- OR F-SERIES COMPUTERS ARE USED. * * THIS LIBRARY MAY BE USED ONLY WITH 21MX M- OR E-SERIES * COMPUTERS. * SPC 2 ENT .ADX ENT .ADY ENT .CAX ENT .CAY ENT .CBX ENT .CBY ENT .CXA ENT .CXB ENT .CYA ENT .CYB ENT .DSX ENT .DSY ENT .ISX ENT .ISY ENT .LAX ENT .LAY ENT .LBX ENT .LBY ENT .LDX ENT .LDY ENT .SAX ENT .SAY ENT .SBX ENT .SBY ENT .STX ENT .STY ENT .XAX ENT .XAY ENT .XBX ENT .XBY ENT .JLY ENT .JPY ENT .CBT ENT .MBT ENT .SFB ENT .CBS ENT .SBS ENT .TBS ENT .CMW SKP .ADX RPL 105746B .ADY RPL 105756B .CAX RPL 101741B .CAY RPL 101751B .CBX RPL 105741B .CBY RPL 105751B .CXA RPL 101744B .CXB RPL 105744B .CYA RPL 101754B .CYB RPL 105754B .DSX RPL 105761B .DSY RPL 105771B .ISX RPL 105760B .ISY RPL 105770B .LAX RPL 101742B .LAY RPL 101752B .LBX RPL 105742B .LBY RPL 105752B .LDX RPL 105745B .LDY RPL 105755B .SAX RPL 101740B .SAY RPL 101750B .SBX RPL 105740B   .SBY RPL 105750B .STX RPL 105743B .STY RPL 105753B .XAX RPL 101747B .XAY RPL 101757B .XBX RPL 105747B .XBY RPL 105757B .JLY RPL 105762B .JPY RPL 105772B .CBT RPL 105766B .MBT RPL 105765B .SFB RPL 105767B .CBS RPL 105774B .SBS RPL 105773B .TBS RPL 105775B .CMW RPL 105776B END  $+ 91750-18094 2013 S C0122 &DSMXL              H0101 ASMB,R,L NAM DSMXL,0 91750-1X094 REV 2013 791026 MEF * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * DS/1000 LIBRARY FOR 21MX-M, -E AND -F SERIES COMPUTERS END # %+ 91750-18095 2013 S C0122 &DSNMA              H0101 |ASMB,L NAM DSNMA,0 91750-1X095 REV 2013 791026 ALL, NON M.A. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END b &, 91750-18096 2013 S C0122 &DSNRR +              H0101 ASMB,R,L NAM DSNRR,30 91750-1X096 REV 2013 791026 ALL W/O RR * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END G '- 91750-18097 2013 S C0122 &DSNSM +              H0101 ASMB,R,L NAM DSNSM,0 91750-1X097 REV.2013 800509 ALL, W/O S.M. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: DSNSM * SOURCE: 91750-18097 * RELOC: PART OF 91750-12012 * PRGMR: JIM HARTSELL * * END  (. 91750-18098 2013 S C0122 &DSRR +              H0101 jASMB,R,L NAM DSRR,0 91750-1X098 REV 2013 791026 ALL W/RR * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END  )/ 91750-18099 2013 S C0122 &DSSM +              H0101 kASMB,R,L NAM DSSM,0 91750-1X099 REV.2013 800509 RTE-IVB W/S.M. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: DSSM * SOURCE: 91750-18099 * RELOC: PART OF 91750-12014 * PRGMR: JIM HARTSELL * * END  *0 91750-18100 2013 S C0122 &DSTES              H0101 {ASMB,Q,C NAM DSTES,19,110 91750-16100 REV.2013 790425 MEF * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * PROGRAM TO PERFORM THE P-TO-P SLAVE FUNCTIONS OF THE DS/3000 * TEST PROGRAM "DSTEST". ONLY ONE MASTER CAN BE HANDLED AT A * TIME. SEE DOCUMENTATION IN THE DS/3000 MANUAL REGARDING THE * RUNNING OF "DSTEST". * * * NAME: DSTES * SOURCE: 91750-18100 * RELOC: 91750-16100 * PGMR: DMT * * DATE WRITTEN: FEBRUARY 22, 1978 * CHANGED FROM FORTRAN TO ASSEMBLER: APRIL 25, 1980 SPC 2 EXT RMPAR,GET,ACEPT,REJCT,FINIS,EXEC EXT D$MAX,D$TST SPC 2 * INTEGER TAG(20),CLASS(5) TAG BSS 20 CLASS BSS 5 *+ INTEGER ERROR,FUNCT,LEN ERROR BSS 1 + FUNCT BSS 1 + LEN BSS 1 + * * GET CLASS NUMBER AND ACCEPT POPEN DSTES EQU * *+ CALL RMPAR(CLASS) JSB RMPAR + DEF *+02 + DEF CLASS + *+ CALL GET(CLASS,ERROR,FUNCT,TAG,LEN) JSB GET + DEF *+06 + DEF CLASS + DEF ERROR + DEF FUNCT + DEF TAG + DEF LEN + LDA ERROR IF ERROR < 0 SSA JMP L900 LDA FUNCT OR FUNCT <>1 CPA =D1 RSS JMP L900 GO TO L900. SPC 1 ** MAIN LOOP...ACCEPT PREVIOUS FUNCTION AND WAIT FOR PWRITE * (DSTES WILL TERMINATE WHEN MASTER SENDS A PCLOSE) L10 EQU * *+ CALL ACEPT(TAG,ERROR,BUFFER) JSB ACEPT + DEF *+04 + DEF TAG + DEF ERROR + DEF D$TST + L20 EQU * LDA ERROR IF ERROR < 0, SSA JMP L950 GO TO L950. *+ CALL GET(V  CLASS,ERROR,FUNCT,TAG,LEN) JSB GET + DEF *+06 + DEF CLASS + DEF ERROR + DEF FUNCT + DEF TAG + DEF LEN + * IF(ERROR .LT. 0 .OR. LEN .GT. D$MAX)GO TO 900 LDA ERROR SSA JMP L900 LDA D$MAX + CMA,INA + ADA LEN + CMA,SSA,INA,SZA + JMP L900 LDA FUNCT IF FUNCT <> 3 CPA D3 GO TO L800. JMP L10 OTHERWISE, STAY IN LOOP. SPC 1 * BAD FUNCTION CALL RECEIVED. REJECT IT AND JUMP BACK INTO LOOP. L800 EQU * *+ CALL REJCT(TAG,ERROR) JSB REJCT + DEF *+03 + DEF TAG + DEF ERROR + JMP L20 SPC 2 * *** ERROR *** REJECT CALL, THEN ABORT L900 EQU * *+ CALL REJCT(TAG,ERROR) JSB REJCT + DEF *+03 + DEF TAG + DEF ERROR + L950 EQU * *+ CALL FINIS JSB FINIS + DEF *+01 + *+ CALL EXEC(D6,D0,D3) JSB EXEC + DEF *+04 + DEF D6 + DEF D0 + DEF D3 + SPC 2 D0 DEC 0 D3 DEC 3 D6 DEC 6 END DSTES  +2 91750-18101 2013 S C0122 &DSTIO              H0101 ASMB,R,Q,C HED DSTIO: DS/1000 REMOTE EXEC ROUTINE *(C) HEWLETT-PACKARD CO.1980* NAM DSTIO,7 91750-1X101 REV 2013 800506 ALL SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 1 * NAME: DSTIO * SOURCE: 91750-18101 * RELOC: 91750-1X101 * PGMR: LYLE WEIMAN [3-26-79] * (CODE IS A MODIFIED FORM OF 'DEXEC' FOR I/O CALLS ONLY) SPC 1 * (DISTRIBUTED EXECUTIVE) IS THE DS/1000 USER INTERFACE FOR * 'TRANSPORTABLE' CALLS TO EITHER THE LOCAL, OR REMOTE-NODE RTE SYSTEM * 'EXEC' I-O CALLS ONLY. ITS PURPOSE IS TO BE A SMALL ROUTINE WHICH * CAN BE CALLED FOR DISTRIBUTED-I/O, SO MUCH OF 'DEXEC' HAS BEEN * LEFT OUT, IN PARTICULAR, THE SPECIAL CODE TO HANDLE * LOCAL CALLS LOCALLY. ALL REQUESTS ARE BUILT * AS 'DEXEC' I/O REQUESTS, AND SENT TO 'EXECM', VIA THE USUAL * COMMUNICATIONS MANAGEMENT PATHS, IN THE DESTINATION NODE. * THEREFORE, THE FOLLOWING REQUIREMENTS EXIST FOR I/O TO THE * LOCAL NODE WHEN 'DSTIO' IS USED, WHICH ARE NOT TRUE OF 'DEXEC' : * * 1) NODE MUST BE INITIALIZED * 2) 'EXECM' MUST EXIST AND IT MUST BE AN ACTIVE (SCHEDULED) MONITOR * 3) I/O BUFFER SIZE LIMITED TO 512 WORDS * 4) NO 'Z' BUFFER ALLOWED * * * WILL ACCEPT ONLY REQUEST CODES 1, 2, 3 OR 13. * * ** UNACCEPTABLE REQUESTS WILL BE REJECTED WITH A "DS06" ERROR! * * ** "IO01" IS RETURNED UPON DETECTION OF INCORRECT, MISSING, OR * TOO MANY (>7) PARAMETERS. THIS INCLUDES LUS > 63 TO OLD NODES. * * ** "IO04" WILL BE RETURNED FOR BUFFER-ERROR SPECIFICATIONS: * 'Z-BIT(#12)' SET IN CONWD, REMOTE READ/WRITE BUFFER LENGTH * GREATER THAN 512 WORDS, INTERACTIVE WRITE LENGTH > READ LENGTH. * * ALL ACCEPTABLE REQUEST CODES WILL BE TRANSMITTED TO THE REMOTE * NODE, VIA STREAM #5, TO BE PROCESSED BY . MASTER (THIS NODE), * AND SLAVE (REMOTE NODE) TIMEOUTS, ESTABLISHED WITH , WILL BE * USED TO PROCESS THESE REQUESTS. * * CALLING SEQUENCE: * REQUEST CODES 1 & 2: * CALL DSTIO(NODE,RCODE,CONWD,BUFR,BUFL[,IPRM1[,IPRM2]]) * * REQUEST CODE 3: * CALL DSTIO(NODE,3,CONWD[,OPTIONAL PARAMETER]) SKP * REQUEST CODE 13: * * CALL DSTIO(NODE,13,LU,IEQT5[,IEQT4[,LUSTAT]]) * * NOTE: "CONWD" IS A DOUBLE-WORD INTEGER, DEFINED AS FOLLOWS: * * 15 8 7 0 * +----------------------------------------------+ * WORD 1 !S! RESERVED ! LOGICAL UNIT NUMBER ! * +---------------------+------------------------+ * 2 ! RESERVED !I!SUB-FUNCTION! RESERVED ! * +------------+------------+--------------------+ * 15 11 10 6 5 0 * * S = 0 IF SESSION MAPPING IS TO BE PERFORMED, * 1 IF NO SESSION MAPPING IS TO BE PERFORMED (I.E., "TRUE" * LU IS PROVIDED) * I = 1 IF INTERACTIVE WRITE-READ IS TO BE PERFORMED, ELSE 0 * * RETURN : - NORMAL COMPLETION, IF REQUEST CODE SIGN =0 * CONTAIN 'EXEC' RETURN INFORMATION * * : ERROR DETECTED: ABORT & PRINT MESSAGE, IF RC#15 =0 * * : - FOR DETECTED ERRORS, IF RC#15 =1 * CONTAIN ASCII ERROR CODES * * : - FOR NORMAL COMPLETION, IF RC#15 =1 * CONTAIN 'EXEC' RETURN INFORMATION * * NODE - SPECIFIES CALL-EXECUTION LOCATION: LOCAL=-1, REMOTE= 0 TO 32767 * * * WILL ALLOW THE USER TO PEvRFORM A COMBINED, INTERACTIVE, * WRITE-READ OPERATION IN A SINGLE CALLING SEQUENCE. SUCH A REQUEST * WILL BE MOST USEFUL FOR EFFICIENTLY COMMUNICATING WITH A REMOTE * OPERATOR. TO SPECIFY AN INTERACTIVE WRITE-READ: REQUEST CODE =1, * CONWORD BIT#11 =1, P8 = WRITE BUFFER ADDRESS, AND P9 = WRITE * BUFFER LENGTH (<=READ BUFFER LENGTH). * * IF THE LOGICAL UNIT NUMBER FIELD IS < 64, THEN THE "DEXEC" REQUEST * CAN BE MADE TO EITHER OLD OR NEW NODES. LUS > 63 ARE ACCEPTABLE * FOR NEW NODES ONLY. AUTOMATICALLY ADJUSTS THE REQUEST * LENGTH FOR 2-WORD LUS TO NEW NODES AND 1-WORD LUS TO OLD NODES. * FOR INCREASED EFFICIENCY, LUS < 64 GOING TO NEW NODES ARE * IN A 'SPECIAL 1-WORD FORMAT' MEANING THAT ALL INFORMATION IS * ACTUALLY IN THE FIRST OF THE TWO WORDS AND BIT 12 OF THE ICODE * WORD IS RESET AS AN INDICATOR. THIS BIT IS SET FOR STANDARD * 2-WORD LUS > 63. * * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OFn MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(io1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L]. #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP * * LENGTH DEFINITIONS FOR REQUEST BUFFERS. * L#I/O ABS #KEY+1 REQ LEN FOR DSTIO(1),(2),(3),(13) SPC 2 * * > > > > > C A U T I O N < < < < < < < < < < * SPC 2 * USE CAUTION IF THE PARAMETER PORTION CHANGES FOR THE VARIOUS * REQUESTS. THE LENGTH IS COMPUTED ON-THE-FLY AS PARAMETERS * ARE MOVED TO THE REQUEST BUFFER. * * ADJUSTMENTS ARE AUTOMATIC IF ONLY THE REQUEST HEADER CHANGES. * ENT DSTIO * EXT #TILT,#NODE,#MAST,.ENTR,#MSTC,#RQB EXT .LDX,.SAX,.DSX,.MVW SKP * SUP DSTIO NOP LDA DSTIO GET THE RETURN POINTER. STA EXIT SAVE FOR '.ENTR' PROCESSING. JSB .LDX DEF N#PRM # PARAMETERS CLA JSB .SAX INITIALIZE PARAMETER AREA DEF PRAMS-1 JSB .DSX JMP *-3 * JMP GETPR GO TO OBTAIN PARAMETER ADDRESSES. SPC 1 JSB RQLEN,I LOCAL-EXECUTION CALL TO 'EXEC'/'REIO' PRAMS EQU * PARAMETER ADDRESSES AREA NODE NOP NODE NUMBER RCODE NOP REQUEST CODE IOCNW NOP I/O CONTROL WORD IOBUF NOP USER BUFFER ADDRESS IOBFL NOP USER BUFFER LENGTH IPRM1 NOP USER'S 1ST OPTIONAL PARAMETER IPRM2 NOP USER'S 2ND OPTIONAL PARAMETER SPC 1 EXIT NOP SPC 2 .NPRM EQU EXIT-PRAMS NUMBER OF PARAMETERS ALLOWED GETPR JSB .ENTR GET DIRECT ADDRESSES DEF PRAMS FOR THE USER-SPECIFIED PARAMETERS. * LDA RCODE GET THE ADDRESS OF THE REQUEST CODE. SZA,RSS WAS THE PARAMETER PROVIDED? JMP ERR NOT PROVIDED, ERROR! * * JSB .LDX DEF C#DLW CLA,CCE =0: BUFFER INIT; =1: CONWORD PREP. JSB .SAX INITIALIZE REQUEST BUFFER DEF #RQB-1 JSB .DSX JMP *-3 * STA WRLEN SET THE 'NO DATA' STA RDLEN DEFAULT CONDITIONS. * ERA SET THE 'ERROR-RETURN' FLAG FOR *  THE <#MAST> CALLING SEQUENCE STA CONWD * LDA #NODE SET LOCAL NODE ADDRESS, IN CASE WE STA #RQB+#ENO REJECT BECAUSE OF AN ERROR. LDA B20 SET ERROR CODE QUALIFIER = 1 STA #RQB+#ECQ LDA NODE,I GET THE DESTINATION STA #RQB+#DST SAVE IT IN THE REQUEST * LDA STDEX GET THE STREAM TYPE STA #RQB+#STR SET IT IN THE REQUEST * DLD IOCNW,I GET LOGICAL UNIT # STA #RQB+#CNW SAVE THE DOUBLE- STB #RQB+#CWX WORD LU LDA PRAMS+2 WAS A THIRD SZA,RSS PARAMETER SPECIFIED? JMP ERIO1 NO, ERROR! LDA RCODE,I GET THE REQUEST CODE. RAL,CLE,ERA REMOVE THE NO-ABORT BIT, AND SAVE IN STA #RQB+#ICD SAVE IN REQUEST BUFFER AND B77 MASK REQUEST CODE ONLY STA ICODE & ICODE FOR MAPPING & POST-PROCESSING CPA D13 REQUEST CODE 13? JMP ICD13 JUMP TO PRE-PROCESSOR SZA REQUEST CODE =0? ADA UPLIM NO. SEE IF IT'S WITHIN SSA,RSS THE RANGE: 0 < RC < 4 ? JMP ERR ERROR, OUT OF RANGE: RC=0, OR RC>3! * * SELECT THE PRE-PROCESSOR ROUTINE, VIA MAPPED REQUEST CODE. * LDB ICODE ADB SUBAD MAP ICODE IN PRE-PROCESS MENU JMP B,I GO DO IT * SKP * PRE-PROCESSOR JUMP TABLE * SUBAD DEF SUBS-1,I SUBS DEF IC1/2 READ RC=01 DEF IC1/2 WRITE RC=02 DEF ICOD3 CONTROL RC=03 * UPLIM ABS SUBAD-* REQUEST CODE LIMIT-VALUE:-(MAX.RCODE +1) HED DSTIO: PRE-PROCESSORS * (C) HEWLETT-PACKARD CO. 1979 * IC1/2 EQU * REQUEST CODES 1 & 2 DLD IOCNW,I LOAD (DOUBLE) CONTROL/LU WORD BLF,SLB DOUBLE-BUFFER REQUEST (BIT#12 =1)? JMP ERIO4 YES--ERROR FOR REMOTE REQUESTS! * LDA IOBUF GET BUFFER ADDRESS  SZA,RSS WAS IT SUPPLIED? JMP ERIO1 NO BUFFER, ERROR! STA BUFA SET IT IN CALL TO #MAST * LDB IOBFL GET THE BUFFER-LENGTH ADDRESS. SZB,RSS WAS IT SUPPLIED? JMP ERIO1 NO BUFFER LENGTH PROVIDED, ERROR! JSB LENCK GO VERIFY & GET BUFFER WORD COUNT. LDB ICODE GET THE REQUEST CODE. SLB IF THIS IS A READ(1) REQUEST, STA RDLEN THEN CONFIGURE READ LENGTH FOR <#MAST>; SLB,RSS ELSE, IF THIS IS A WRITE(2) REQUEST, STA WRLEN THEN CONFIGURE 'WRLEN' FOR <#MAST>. * LDA IOBFL,I GET LENGTH AGAIN STA #RQB+#BFL SAVE IN REQUEST * LDB IPRM1 GET ADDR OF 1ST OPT. PARAM SZB,RSS SPECIFIED ? JMP SRQLN NO, SHORT REQUEST * LDA IPRM1,I GET FIRST OPTIONAL PARAMETER STA #RQB+#PM1 CLA PREPARE FOR MISSING PARAMETER. LDA IPRM2,I GET SECOND OPTIONAL PARAMETER STA #RQB+#PM2 * LDB #RQB+#CWX GET THE USER'S CONTROL WORD. BLF POSITION WRITE-READ BIT(#11) TO SIGN. SSB,RSS IF THIS IS A WRITE-READ REQUEST: SKIP; JMP SRQLN * LDA RDLEN FORCE ADEQUATE S.A.M TO BE # STA WRLEN ALLOCATED AT RECEIVING NODE. # * LDB IPRM2 GET ADDRESS FOR WRITE-BUFFER LENGTH. JSB LENCK GO VERIFY & GET 'WRITE' WORD COUNT. STA LENCK SAVE THE WORD-MOVE LENGTH, TEMPORARILY. CMA,INA,SZA,RSS NEGATE THE COUNT, & IF =0, JMP LONGT NO NEED TO MOVE THE 'WRITE' BUFFER. * ADA RDLEN IF THE WRITE LENGTH SSA IS GREATER THAN THE 'READ' LENGTH, JMP ERIO4 THEN THE REQUEST IS INVALID! * LDA IPRM1 GET THE 'WRITE' BUFFER ADDRESS LDB IOBUF AND THE 'READ' BUFFER ADDRESS. CPA B IF THEY ARE THE SAME, THEN THE JMP LONGT 'WRITE' DATA NEED NOT BE MOVED; ELSE, JSB .MVW MOVE 'WReITE' DATA TO 'READ' BUFFER. DEF LENCK NOP * LONGT EQU * LDA CONWD GET THE <#MAST> CONTROL WORD. ARS SET THE LONG TIMEOUT BIT(#14). STA CONWD RESTORE CONWD [140000B]. JMP SRQLN SPC 3 ICOD3 EQU * RC=03 CLA LDA IOBUF,I GET OPTIONAL PARAMETER STA #RQB+#PRM SET IT IN THE REQUEST JMP SRQLN GO TO ESTABLISH REQUEST LENGTH. SPC 2 ICD13 EQU * RC = 13 LDA IEQT5 DID CALLER SPECIFY AT LEAST ONE SZA,RSS RETURN PARAMETER? JMP ERIO1 NO, GET OUT! SRQLN LDA L#I/O SET THE LENGTH OF THE REQUEST/REPLY JMP SETLN SKP * COMMON PRE-PROCESSING SUBROUTINES * LENCK NOP BUFFER LENGTH PROCESSING. LDB B,I GET THE BUFFER LENGTH. SSB,RSS WORDS OR -BYTES? JMP WORDS POSITIVE WORDS. BRS NEGATIVE BYTES--CONVERT TO -WORDS. CMB,INB MAKE THAT +WORDS WORDS LDA B SAVE +WORDS IN FOR RETURN. ADB DM513 CHECK FOR VALIDITY OF LENGTH SSB,RSS JMP ERIO4 >512, TOO MUCH * JMP LENCK,I RETURN. SKP * SEND THE REMOTE EXEC REQUEST VIA "#MAST" AND AWAIT REPLY * SETLN STA RQLEN ESTABLISH REQUEST LENGTH FOR <#MAST>. LDA #RQB+#CNW GET LU AND B300 CHECK FOR LU > 63 SZA,RSS JMP LU1WD USE ONE-WORD LU FORMAT * * USE DOUBLE-WORD LU FORMAT. THIS IS FLAGGED BY SETTING * BIT 12 IN THE CONTROL WORD OF THE REQUEST. * LDA #RQB+#ICD IOR BIT12 STA #RQB+#ICD JMP SETX * * USE SINGLE-WORD LU FORMAT. MERGE THE SUB-FUNCTION WITH THE * LU WORD. * LU1WD EQU * LDA #RQB+#CNW ELA,CLE,ERA CLEAR "SIGN" BIT, IF SET STA B LDA #RQB+#CWX LOAD SUB-FUNCTION AND B7700 MASK IOR B INCLUDE LU 6 CLB AND DUMMY PARAMETER STA #RQB+#CNW AND CONFIGURE STB #RQB+#CWX THE REQUEST. * SETX EQU * RESUME MAIN FLOW * JSB #MAST CALL MASTER REQUEST INTERFACE ROUTINE DEF *+7 DEF CONWD CONTROL WORD DEF RQLEN REQUEST LENGTH BUFA DEF * CONFIGURED DATA BUFFER ADDRESS--IF ANY. DEF WRLEN WRITE DATA LENGTH -- IF ANY DEF RDLEN READ DATA LENGTH -- IF ANY DEF C#DLW MAXIMUM REPLY LENGTH EXPECTED =15 WORDS. JMP ERROR * ERROR DETECTED BY "#MAST"--REPORT IT STA LENCK SAVE TRANSACTION SEQ. # LDA #MSTC DID <#MAST> WAIT SZA AROUND FOR THE REPLY? JMP RTSQ NO---RETURN TO CALLER * LDB ICODE IF THE REQUEST CODE WAS FOR A: CPB D13 - DEVICE-STATUS REQUEST, THEN THE DEVICE JMP IPD13 PARAMETERS NEED POST-PROCESSING * * DSTIO POST-PROCESSING: MOVE DATA TO REPLY BUFFER & CHECK FOR ERRORS. * IPOST LDA #RQB+#ENO SSA ANY ERROR ? JMP ERROR YES * XIT EQU * LDA RCODE,I GET ICODE SSA WAS THE NO ABORT BIT SET ? ISZ EXIT YES PUSH RETURN ADDRESS * ATEND LDB #RQB+#EC2 GET FROM THE REPLY BUFFER. LDA #RQB+#EC1 GET FROM THE REPLY BUFFER. JMP EXIT,I RETURN TO CALLER * RTSQ EQU * HERE ON NO-WAIT CALLS LDA LENCK RETURN THE TRANSACTION SEQUENCE STA #RQB+#EC1 NUMBER TO CALLER JMP XIT SKP SPC 1 IPD13 LDA #RQB+#ST1 GET THE FIRST RETURN-PARAMETER. STA IEQT5,I PASS: EQT5 * LDB #RQB+#ST2 GET THE NEXT RETURN-PARAMETER. STB IEQT4,I OPTIONAL EQT4 LDB #RQB+#ST3 RC=13: OPTIONAL LU STATUS & SUB. CHAN; STB LUST,I JMP IPOST GO FINISH SPC 2 * DSTIO ERROR ROUTINES. * ERIO1 LDB "01" INCORRECT,MISSING,OR TOO MANY PARAMETERS JMP GETIO ERIO4 LDB "04"GOB@< IMPROPER BUFFER SPECIFICATION. GETIO LDA "IO" JMP ERRS ERROR: "IO0X". SPC 2 ERR LDB "06" IMPROPER REQUEST: "DS06". RSS LDB "04" ILLEGAL NODE: "DS04" LDA "DS" ERRS DST #RQB+#EC1 ERROR CODE INTO REQ.BUFR ERRA EQU *-1 ERROR MESSAGE ADDRESS [DEF #RQB+#EC1] SPC 2 ERROR LDA RCODE,I GET ICODE SSA NO ABORT BIT SET ? JMP ATEND YES, IT IS * CCA ADA DSTIO WE HAVE THE ADDRESS OF THE JSB LDB ERRA GET ADDRESS OF THE ERROR MESSAGE JSB #TILT WE DO NOT COME BACK FROM THIS CALL * SKP * DATA AREA * "01" ASC 1,01 "04" ASC 1,04 "06" ASC 1,06 "IO" ASC 1,IO "DS" ASC 1,DS N#PRM ABS .NPRM * * EQUATES IEQT5 EQU IOCNW DEFINE RETURN OF EQT WORD 5 INFO (RC=13) IEQT4 EQU IOBUF " " " " " 4 " " " LUST EQU IOBFL " " " LU STATUS " " " A EQU 0 B EQU 1 * * * C#DLW ABS #DLW MAX. REQUEST/REPLY LENGTH. DM513 DEC -513 D5 DEC 5 STDEX EQU D5 STREAM TYPE FOR "DEXEC" CALLS D13 DEC 13 RQLEN NOP ICODE NOP WRLEN NOP RDLEN NOP CONWD NOP BIT12 OCT 10000 BIT 12 B77 OCT 77 B20 OCT 20 B300 OCT 300 B7700 OCT 7700 * END ѪB ,< 91750-18102 2013 S C0122 &DSVCP +              H0101 {ASMB,R,L,C * * NAME: DSVCP * SOURCE: 91750-18102 * RELOC: 91750-16102 * PGRMR: D. L. M. * * **************************************************************** * COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS RESERVED * * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * * TRANSLATED INTO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR * * WRITTEN CONSENT OF HEWLETT-PACKARD CO. * **************************************************************** * HED DS/1000 L SERIES VCP MASTER PROGRAM *************************************** * * * DSVCP: THE DS/L SERIES VCP INTERFACE* * * *************************************** * * NAM DSVCP,19,90 91750-16102 REV.2013 800610 M,4B,L ENT DSVCP EXT RMPAR,#NRVS,LOGLU,EXEC,IFBRK,REIO,#NMSC,PARSE EXT KCVT,NAMR,CREAT,WRITF,FTIME,CLOSE,CNUMD,.CBT EXT REIO,XLUEX ************************************ * * * PROGRAM INITIALIZATION * * * ************************************ A EQU 0 B EQU 1 SUP PRESS LISTING DSVCP JSB RMPAR GET PARAMETERS DEF DSVP1 RETURN DEF NODE ADDRESS OF PARAMETER ARRAY DSVP1 EQU * * * FUTURE ACCESS TO REMOTE NODES SHOULD BE INSERTED HERE * * CCB STORE A MINUS ONE STB HSTND SAVE HOST NODE JSB LOGLU GET TERMINAL LU DEF LLU RETURN DEF SCR SCRATCH AREA LLU EQU * * SZA,RSS IS IT ZERO ?? INA YES SO PUT A ONE AND . . . STA #TLU SAVE TERMINAL LU IN AREA ADA =B400 MAKE THE ECHO CNTRL WORD STA TRMIS AND SAVE ADA =B1400 MAKE THE OUTPUT CNTRL WORD STA TRMOC AND SAVE * LDA NODE+1 GET DU FLAG STA DUFL AND SAVE * * * VERIFY THAT DS NODE IS LEGAL * * .FNDDS JSB #NRVS CHECK FOR LEGAL NETWORK LU DEF #N1 DEF NODE NODE NUMBER ENTERED DEF SCR SCRATCH AREA DEF SCR+1 FOR UNNEEDED INFORMATION DEF NBR NEIGHBOR FLAG DEF #NLU LU NUMBER OF NODE #N1 EQU * * JMP NONDE ERROR - POSSIBLE NO NODE * * VERIFY THE LU * LDB NODE GET THE ORIGINAL PARM CMB,INB CONVERT IT SSB IS IT POSITIVE? JMP #NDE NO - NODE NUMBER CPA B ARE THE TWO LU'S THE SAME? JMP FOUND YES - CONTINUE LDA B NO - SAVE ORIGINAL LU JMP NNDE1 AND INDICATE FOUND #NDE LDB NODE GET THE NODE NUMBER STB #NWLU AND SAVE CMA,INA NEGATE THE LU STA NODE AND RESTORE * JSB #NRVS CHECK IF LU RETURNS SAME NODE DEF #N2 RETURN DEF NODE NODE NUMBER DEF SCR SCRATCH AREAS DEF SCR+1 DEF NBR NEIGHBOR FLAG DEF #NLU NODE NUMBER * #N2 JMP ERR NOT FOUND LDB #NWLU GET THE NODE # CPB #NLU IS IT CORRECT? RSS JMP ERR NO - BAD * SKP * * LU FOUND. GENERATE CONTROL WORDS AND CHECK DRIVER * FOUND LDB NBR GET NEIGHBOR FLAG SZB,RSS IS IT A NEIGHBOR (ADJACENT?) JMP ERR NO - ERROR STA #NWLU SAVE NETWORK LU NUMBER IOR =B100000 SET SYSTEM BIT FOR XLUEX CALLS STA SNDSC STORE STA SBRFC CONTROL STA SVCPM WORDS STA SDSMC FOR CALLS STA STAT INA MAKE THE READ CONTROL WORD STA RVCPM AND SAVE * * CHECK FOR CORRECT DRIVER TYPE (66) * JSB XLUEX CHECK FOR CORRECT DVR TYPE DEF *+4 DEF .13 STATUS DEF STAT DEF SCR FIRST WORD * LDA SCR GET STATUS ALF,ALF MOVE TO UPPER BYTE AND =B77 GET DRIVER TYPE )) CPA =B66 IS DS DVR? RSS JMP ERR NO - ILLEGAL LU * JSB KCVT LU NUMBER TO ASCII DEF *+2 DEF #NWLU LU NUMBER STA LU# LDA #NLU GET LU NUMBER CPA =A?? IS IT KNOWN?? JMP ZZ NO JSB CNUMD YES - CONVERT IT TO ASCII DEF *+3 DEF #NLU NODE NUMBER DEF NODE# JMP START START ZZ STA NODE# STA NODE#+1 STA NODE#+2 SKP * * PRINT START MESSAGE * START JSB EXEC WRITE PROMPT TO TERMINAL DEF *+5 DEF NAB2 WRITE DEF TRMOC TERMINAL OUTPUT CONTROL DEF PRMSG PROMPT DEF PRMSL AND LENGTH NOP * JSB EXEC NOW WRITE LU AND NODE NUMBER DEF *+5 DEF NAB2 WRITE DEF #TLU TERMINAL DEF ND&LU MESSAGE DEF N&LLN AND LENGTH NOP ** JSB XLUEX SET NON DS MODE DEF RDS RETURN DEF NAB3 NO-ABORT CONTROL DEF SNDSC SET FRONT PANEL WAIT DEF SECUR SECURITY CODE RDS EQU * * JMP RTEER RTE ERROR JSB CKNST GO CHECK NETWORK STATUS * LDA DUFL GET FLAG AGAIN CPA =ADU IS IT A DUMP? JMP DUMP YES GO DO DUMP SKP **************************************************** * * * MAIN BODY OF PROGRAM * * * **************************************************** * PRMPT JSB EXEC SEND PROMPT TO SCREEN DEF PR1 RETURN DEF NAB2 DEF TRMOC TERMINAL OUTPUT CONTROL DEF PRMSG ADDRESS OF PROMPT DEF PRMSL LENGTH OF PROMPT PR1 NOP NO - ABORT * * NOW READ A STRING FROM THE TERMINAL * CMMD JSB RDSTR READ AN ASCII STRING FROM TERMINAL LDA INBUF GET FIRST WORD CPA BRADR,I IS IT A BREA K?? JMP BREAK YES GO DO IT CPA EXADR,I ALL DONE?? JMP EXIT YES - CLEAN UP OUR ACT CPA RDADR,I IS IT A READ? JMP READ1 YES CPA WTADR,I IS IT A WAIT FOR INPUT?? JMP WAIT YES AND =B177400 NOT RECOGNIZED - IS IT A COMMAND? CPA .\ FIRST CHR A \?? JMP BDCMD YES - BAD COMMAND SKP * * MUST BE A MESSAGE FOR VCP. SEND IT!! * * SDBUF STB MLEN SAVE CHARACTER COUNT CLE,SLB,ERB DIVIDE BY TWO WHILE CHECKING IF EVEN JMP ODD MUST BE ODD ADB ADBUF ADD THE BUFFER ADDRESS TO GET LAST WORD LDA =B6400 PUT A CR-NU INTO LAST WORD JMP SB1 AND GO STORE IT * ODD ADB ADBUF ADD BUFFER ADDRESS LDA B,I GET LAST WORD AND =B177400 CLEAR LOWER BYTE IOR =B15 LOAD CR INTO IT SB1 STA B,I RESTORE TO BUFFER LDA MLEN GET LENGTH AGAIN CLE,ERA DIVIDE BY TWO AND CHECK EVEN/ODD INA INCREMENT IF ODD STA MLEN STORE IN LENGTH AREA * JSB XLUEX SEND THE BUFFER DEF SB2 RETURN DEF NAB2 WRITE DEF SVCPM DRIVER CONTROL DEF INBUF BUFFER ADDRESS DEF MLEN AND LENGTH SB2 EQU * JMP RTEER RTE ERROR JSB CKNST CHECK NETWORK STATUS * JMP READ GO READ DS SKP * * IF THIS IS A POSSIBLE COMMAND, * CHECK THE FULL BUFFER OF CHARACTERS FOR CORRECTNESS * CHR2 NOP CPB B2 IS IT ONLY TWO CHARACTERS?? JMP CHR2,I YES - ALL DONE RRR 16 SWAP A & B AND =B7 LOOK AT MAX SEVEN CHR RRR 16 SWAP A & B AGAIN STB CNTR STORE LDB ADBUF GET ADDRESS OF BUFFER RRL 1 MAKE A & B BYTE ADDRESSES JSB .CBT COMPARE FULL BUFFER DEF CNTR NUMBER OF BYTES/CHR NOP FOR USE BY MICROCODE JMP CHR2,I YES - CORRECT COMMAND NOP NO - INCORRECT COMMAND RETURN * * BAD COMMAND - PRINT ERROR AND READ ANOTHER COMMAND * BDCMD JSB EXEC PRINT ERROR MESSAGE DEF BC1 RETURN DEF NAB2 WRITE DEF #TLU TERMINAL OUTPUT CONTROL DEF BDCMM MESSAGE DEF BMLEN LENGTH BC1 NOP * JMP PRMPT GO READ TERMINAL AGAIN SKP ******************************* * * * COMMANDS TO READ THE DS LU * * * ******************************* * * READ1 DOES ONLY ONE READ OF THE DS LU AND THEN RETURNS TO USER. * READ1 LDA RDADR GET ADDRESS JSB CHR2 CHECK FOR CORRECTNESS JSB READS CORRECT SO DO READ JMP PRMPT TIMEOUT SO ALL DONE JMP PRDSM MESSAGE RECEIVED SO PRINT * * WAIT CONTINUES READS FROM DS UNTIL MESSAGE COMES IN * WAIT LDA WTADR GET THE ADDRESS JSB CHR2 AND CHECK FOR COMPLETION JMP READ2 START READING DS FOR MESSAGES * * CHECK FOR BREAK FROM USER * READ JSB IFBRK CHECK FOR BREAK DEF *+1 * SZA WAS THERE A BREAK? JMP PRMPT YES - GO READ TERMINAL READ2 JSB READS NO - READ LU JMP READ TIME-OUT SO READ DS AGAIN * * * MESSAGE RECEIVED FROM DS - PRINT IT * PRDSM LDA B PUT B IN A ALS MULTIPLY LENGTH *2 CMA,INA NEGATE ADA B2 AND DECREASE BY TWO STA BFLN SAVE LENGTH ADB M1 ADD -1 ADB ADMSG ADD FIRST ADDRESS LDA B,I GET LAST WORD AND =B377 LOOK AT LOWER BYTE ONLY CPA =B377 IS THIS THE FLAG? JMP UPPER ISZ BFLN DECREASE COUNT BY ONE MORE ADB M1 LOOK AT PREVIOUS WORD LDA B,I GET IT PDM1 AND =B377 STA RTFLG SAVE FLAG CPA B1 IS THIS A DUMP?? JMP DUMP YES - INITIATE PROCEEDINGS LDA BFLN GET LENGTH AGAIN h SZA,RSS IS THIS A ZERO LENGTH REQUEST?? JMP PDM2 YES - DON'T PRINT IT SKP * * PRINTING RECEIVED MESSAGE (CON'T) * JSB EXEC WRITE TO TERMINAL DEF PDM2 RETURN DEF NAB2 WRITE DEF TRMOC TERMINAL OUTPUT CONTROL DEF MSGBF MESSAGE BUFFER DEF BFLN MESSAGE LENGTH PDM2 NOP * LDA RTFLG GET FLAG AGAIN SZA,RSS REQUESTING INPUT?? JMP PRMPT YES - GO READ COMMAND JMP READ NO - GO READ DS * UPPER LDA B,I GET THE WORD AGAIN ALF,ALF AND MOVE FLAG TO LOWER BYTE JMP PDM1 BACK TO CODE SKP * * THE SLAVE L IS REQUESTING A DUMP. ASK THE USER FOR A FILENAME * AND CREATE IT ON THE DISC. THEN REQUEST 128 WORDS BLOCKS FROM * THE SLAVE AND WRITE TO THE DISC. AT THE END OF THE FILE, ASK * FOR A FILE TAG AND POST THE TIME. ALSO ALLOW USER TO APPEND HIS * OWN COMMENTS AT THE END. * DUMP JSB EXEC WRITE TO TERMINAL DUMP REQUEST MESSAGE DEF *+5 DEF NAB2 WRITE DEF TRMOC OUTPUT CONTROL DEF DPMSG BUFFER MESSAGE DEF DPMLN AND LENGTH NOP * RDFIL JSB RDSTR READ THE STRING FROM THE TERMINAL STB SCR SAVE LENGTH LDA B1 GET STARTING LOCATION STA SCR+1 AND SAVE * SZB,RSS IS IT ZERO (DON'T DUMP) JMP NODMP YES - NO DUMP!!!!!! * JSB NAMR PARSE THE NAME STRING DEF *+5 DEF FILNM FILENAME STRING DEF INBUF BUFFER NAME DEF SCR AND LENGTH DEF SCR+1 STARTING LOCATION * * JSB CREAT CREATE THE FILE DEF *+8 DEF DCB DATA CONTROL BLOCK DEF FERR ERROR LOCATION DEF FILNM FILENAME DEF .257 FILE SIZE IN BLOCKS DEF B1 TYPE ONE DEF FILNM+4 SECURITY CODE DEF FILNM+5 CARTRIDGE * SSA WAS THERE AN ERROR? % JMP FMPER YES - FMP ERROR CCA SET THE CLOSE FLAG STA CLSFL SKP * * THIS LOOP IS EXECUTED 256 TIMES FOR THE DUMP * LDA =D-256 STA DPCNT STORE DUMP COUNT IN REGISTER DMLOP LDA =D128 GET A COUNT OF 128 ALF,ALF MOVE TO UPPER BYTE STA MSGBF STORE IN MESSAGE BUFFER JSB XLUEX WRITE COUNT TO SLAVE DEF *+5 DEF NAB2 NO-ABORT WRITE DEF SVCPM CONTROL DEF MSGBF MESSAGE BUFFER DEF B1 AND LENGTH * JMP RTEER RTE ERROR JSB READS GET A BUFFER FROM DS JMP DPTMO TIME-OUT ON LINK CMA ADD -1 ADA ADMSG TO ADDRESS OF BUFFER ADB A ADD LENGTH LDA B,I GET LAST WORD ALF,ALF SWAP BYTES AND =B377 CPA B1 IS IT STILL DUMPING? JMP DPTMO NO - DUMP TIMEOUT JSB WRITF WRITE THE BUFFER TO THE FILE DEF *+4 DEF DCB DATA CONTROL BLOCK DEF FERR ERROR DEF MSGBF MESSAGE BUFFER * SSA WAS THERE AN ERROR? JMP FMPER YES - REPORT IT ISZ DPCNT INCREMENT DUMP COUNT JMP DMLOP DO IT AGAIN * * DUMP IS FINISHED. TELL SLAVE * CLA STA MSGBF STORE A ZERO IN BUFFER JSB XLUEX AND TRANSMIT IT DEF *+5 DEF NAB2 NO-ABORT WRITE DEF SVCPM CONTROL DEF MSGBF DEF B1 AND LENGTH * JMP RTEER ERROR LDB ADMSG GET ADDRESS OF MESSAGE BUFFER LDA =D-129 NUMBER OF WORDS JSB CLRBF CLEAR BUFFER JSB FTIME GET TIME IN A STRING DEF *+2 DEF MSGBF ADDRESS OF BUFFER * * NOW ASK FOR INPUT OF A STRING FROM THE TERMINAL FOR THE COMMENT * JSB EXEC WRITE QUESTION DEF *+5 DEF NAB2 WRITE DEF #TLU TO TERMINAL DEF ASKMS ASK MESSAGE DEF ASKML AND LEsNGTH NOP IGNORE RETURN JSB REIO GET THE STRING DEF *+5 DEF NAB1 INPUT DEF TRMIS CONTROL DEF MSGBF+16 MESSAGE BUFFER DEF ILEN AND LENGTH NOP * JSB WRITF WRITE LAST FILE DEF *+4 DEF DCB DATA CONTROL BLOCK DEF FERR ERROR MESSAGE DEF MSGBF MESSAGE BUFFER * CLA CLEAR THE CLOSE FLAG STA CLSFL JSB CLOSE ALL DONE SO CLOSE THE FILE DEF *+3 RETURN DEF DCB DATA CONTROL BLOCK DEF FERR ERROR MESSAGE * LDA DUFL GET FLAG CPA =ADU WAS THIS A DIRECT DUMP JMP PRMPT YES - READ COMMAND JMP READ NO - GO BACK AND READ SLAVE * * THIS ROUTINE HANDLES ANY FMP ERRORS * FMPER LDA FERR GET NUMBER OF ERROR CMA,INA MAKE POSITIVE STA FERR RESTORE JSB CNUMD CONVERT IT TO AN ASCII NUMBER DEF *+3 DEF FERR DEF #FMP AND STORE IT IN STRING JSB EXEC PRINT THE ERROR MESSAGE DEF *+5 DEF NAB2 WRITE DEF #TLU CONTROL DEF FMPMS MESSAGE DEF FMPEL AND LENGTH NOP * LDA CLSFL GET THE CLOSE FLAG CMA,SZA WAS IT SET?? JMP FPER2 NO - JUST GET NAME AGAIN JSB CLOSE CLOSE THE FILE DEF *+3 DEF DCB DATA CONTROL BLOCK DEF FERR ERROR CODE * FPER2 JMP DUMP START REQUEST AGAIN * * THE USER INDICATES HE DOESN'T WANT TO DUMP! * LET'S GO TELL THE SLAVE ABOUT IT * NODMP LDA =B177400 SEND THE NO DUMP COMMAND STA MSGBF IN THE MESSAGE BUFFER JSB XLUEX SEND TO VCP DEF *+5 DEF B2 WRITE DEF SVCPM TRANSMIT DEF MSGBF MESSAGE BUFFER DEF B1 AND LENGTH * JMP READ READ FAILURE INDICATION * * THE LINK TIMED OUT DURING A DUMP. LETS CLEAN UP OUR ACOT!! * DPTMO JSB CLOSE JUST CLOSE THE FILE DEF *+3 DEF DCB DATA CONTROL BLOCK DEF FERR ERROR CODE * LDA M1 SEND ALL ONE'S TO SLAVE STA MSGBF JSB XLUEX CALL EXEC DEF *+5 DEF NAB2 NO ABORT WRITE DEF SVCPM SEND VCP DEF MSGBF MESSAGE BUFFER DEF B1 ONE WORD * JMP RTEER RTE ERROR JSB CKNST CHECK NETWORK STATUS * JSB EXEC NOW TELL USER DEF *+5 DEF NAB2 WRITE DEF #TLU TO TERMINAL DEF ABDSD ABORT DUMP MESSAGE DEF ABDSL AND LENGTH NOP * JMP PRMPT DO A PROMPT SKP * * BREAK SENDS A BREAK FRAME TO THE SLAVE * BREAK LDA BRADR GET ADDRESS OF STRING JSB CHR2 AND CHECK COMMAND BRK1 LDA BRPSW GET PASSWORD FLAG CMA,SZA,RSS IS IT SET? JMP BR2 YES - SEND BREAK * * PASSWORD NOT DETECTED - READ PASSWORD * JSB EXEC SEND PASSWORD PROMPT DEF BR1 RETURN ADDRESS DEF NAB2 WRITE DEF TRMOC TERMINAL CONTROL DEF PSMSG PASSWORD MESSAGE DEF PSMLN PASSWORD LENGTH BR1 NOP * LDA =D-40 LDB ADBUF GET ADDRESS OF INPUT BUFFER JSB CLRBF AND CLEAR IT JSB REIO READ PASSWORD DEF PSW RETURN DEF NAB1 READ DEF #TLU NO ECHO DEF INBUF INPUT BUFFER DEF ILEN PSW NOP * CPB B2 ONLY TWO CHARCTERS? RSS JMP BDCMD NO - BAD COMMAND LDA INBUF GET FIRST WORD ALF,ALF SWAP BYTES CMA AND COMPLEMENT CPA #NMSC IS IT CORRECT PASSWORD? RSS JMP BDCMD NO - BAD COMMAND BR2 CCA YES - SET FLAG STA BRPSW LDA #NWLU GET NETWORK LU CCE SET E ALF,ELA MULTIPLY BY 32 AND ADD 1 STA SCR SKP * * GO SEND BREAK * JSB XLUEX SEND THE BREAK DEF BR3 RETURN DEF NAB2 WRITE DEF SBRFC SEND BREAK FRAME DEF PSMSG IRRELEVANT BUFFER DEF PSMLN AND LENGTH DEF SECUR SECURITY CODE DEF SCR LU*32+1 BR3 EQU * JMP RTEER * * GO BACK TO READING DS * JMP READ NO - NORMAL TIMEOUT SKP * * EXIT - PROGRAM ALL DONE !! * EXIT LDA EXADR GET EXIT ADDRESS JSB CHR2 AND CHECK FOR CORRECTNESS EXIT1 CLA STA BRPSW CLEAR BREAK FLAG LDA CLSFL HAS THE FILE BEEN CLOSED?? CMA,SZA JMP CLOS JSB CLOSE NO - CLOSE IT DEF *+3 DEF DCB DEF FERR * CLOS JSB XLUEX SET DRIVER INTO DS MODE DEF EX1 RETURN DEF B3 CONTROL DEF SDSMC SET DS MODE DEF SECUR SECURITY CODE EX1 EQU * * JSB EXEC PRINT ALL DONE MESSAGE DEF EX2 RETURN DEF NAB2 WRITE DEF #TLU TERMINAL OUTPUT CONTROL DEF ENMSG DEF ENMLN EX2 NOP * JSB EXEC ALL DONE!!! DEF EX3 DEF B6 EX3 NOP SKP * * ERROR ROUTINE FOR ILLEGAL DS NODES OR USER ERRORS * * ERR JSB EXEC SEND ERROR MESSAGE TO TERMINAL DEF ERR1 DEF NAB2 DEF TRMOC DEF ERMSG DEF ERRLN ERR1 NOP * JSB RDSTR READ A NEW COMMAND STRING! * SZB,RSS IF ZERO LENGTH TERMINATE PROGRAM JMP EX1 ALL DONE FOR NOW STB SCR STORE LENGTH IN SCRATCH AREA JSB PARSE PARSE THE INPUT STRING DEF PRS1 RETURN DEF INBUF INPUT BUFFER DEF SCR LENGTH DEF NODE TARGET BUFFER PRS1 EQU * * LDA NODE GET FIRST CHARACTER CPA B1 IS IT A NUMBER?? RSS YES JMP ERR NO - REPRINT ERROR MESSAGE LDA NODE+1 GET NODE INPUT STA NODE AND STXORE IN PROPER POSITION JMP FNDDS GO FIND DS LU SKP **************************************************** * * * SUBROUTINES * * * **************************************************** * RDSTR NOP LDA =D-40 LDB ADBUF GET ADDRESS OF BUFFER JSB CLRBF CLEAR THE INPUT BUFFER JSB REIO MAKE THE CALL DEF RDST1 RETURN DEF NAB1 READ DEF TRMIS INPUT AN ASCII STRING DEF INBUF INPUT BUFFER DEF ILEN INPUT LENGTH RDST1 NOP * JMP RDSTR,I BACK WE GO! * * THIS SUBROUTINE READS THE DS LU * READS NOP LDA =D-129 CLEAR 129 LOCATIONS LDB ADMSG STARTING AT THIS ADDRESS JSB CLRBF CLEAR IT JSB XLUEX NOW DO READ OF DS DEF RDS1 RETURN DEF NAB1 NO ABORT READ DEF RVCPM CONTROL WORD DEF MSGBF BUFFER DEF MSGLN AND LENGTH RDS1 EQU * JMP RTEER RTE ERROR RETURN STB SCR SAVE LENGTH JSB CKNST CHECK NETWORK STATUS LDB SCR GET LENGTH AGAIN CPA B2 WAS IT A TIMEOUT?? RSS ISZ READS NO - RETURN + 1 JMP READS,I RETURN SKP * * THIS SUBROUTINE CLEARS ALL MESSAGE BUFFERS * CLRBF NOP STA CNTR IN THE WORD COUNT CLA CLEAR A CLR1 STA B,I STORE IN BUFFER INB INCREMENT ADDRESS ISZ CNTR AND COUNT JMP CLR1 DO IT AGAIN JMP CLRBF,I ALL DONE * * * NONDE LDA NODE GET ORIGINAL NUMBER SSA,RSS WAS IT NEGATIVE? JMP ERR NO - DOESN'T EXIST CMA,INA YES - CONVERT TO LU NNDE1 LDB =A?? DON'T KNOW WHAT IT IS STB #NLU SO INDICATE JMP FOUND AND INDICATE FOUND * SKP * * ERROR ROUTINE FOR ABORTED +DEXEC CALLS BY SYSTEM * RTEER STA IOER STORE TYPE OF ERROR LDA IOERA GET ERROR MESSAGE STA NERMS AND PUT IN PROPER LOCATION JMP PRNER GO DO IT * * THIS SUBROTINE CHECKS DS STATUS. IF THERE IS A TIME-OUT OR NO ERROR * SUBROUTINE RETURNS, IF THERE IS, PROGRAM PRINTS ERROR MESSAGE AND * RETURNS TO PROGRAM PROMPT. * CKNST NOP CLB CLEAR B ARS,SLA WAS THERE AN ERROR?? RSS JMP CKNST,I NO - RETURN RAR,RAR MOVE A REGISTER RAR TO LOOK AT ERROR CODE AND =B17 GET ERROR CODE CPA B1 IS IT 1? LDB LNFLA YES- LINE FAILURE CPA B2 IS IT 2? JMP CKNST,I YES IT'S LEGAL CPA B11 IS IT DRIVER ERROR?? JMP SUSP YES - SUSPEND FOR A FEW CPA =B5 IS IT 5? LDB BSYA YES - LINE BUSY CPA B10 IS IT 10B? LDB NINTA YES - NO INTERRUPT CPA =B13 IS IT 13B? LDB CDFLA YES - CARD FAILURE CPA =B17 IS IT 17B? LDB BDINA YES - BAD INTERRUPT SZB,RSS ANY OTHER CODE? LDB IOERA GETS THIS MESSAGE STB NERMS SAVE IT STA IOER AND STORE IN STRING JSB KCVT CHANGE TO ASCII DEF *+2 DEF IOER STA IOER STORE CONVERSION AGAIN * * NOW PRINT DS ERROR MESSAGE * PRNER JSB EXEC PRINT DSVCP PREFIX DEF *+5 DEF NAB2 DEF TRMOC DEF PRMSG BUFFER MESSAGE AND LENGTH DEF PRMSL NOP JSB EXEC NOW PRINT MESSAGE DEF *+5 DEF NAB2 DEF #TLU NERMS BSS 1 DEF B10 NOP JMP PRMPT ALL DONE * SUSP JSB EXEC SUSPEND THE PROGRAM FOR FIVE SECONDS DEF *+6 DEF .12 DEF B0 DEF B2 DEF B0 DEF M5 LDA B2 JMP CKNST,I JUMP BACK SKP *********************************************** * H * * CONTROL WORD AREA * * * *********************************************** * * NETWORK CONTROL WORDS WITH LU: THESE ARE DOUBLE WORD * FIRST WORD IS THE LU WITH BIT 15 SET FOR SYSTEM LU * SECOND WORD IS DS CONTROL * STAT BSS 1 OCT 0 STATUS OF DRIVER SNDSC BSS 1 OCT 23500 SET FRONT PANEL WAIT SBRFC BSS 1 OCT 20700 SEND BREAK SVCPM BSS 1 OCT 20500 SEND VCP MESSAGE SDSMC BSS 1 OCT 23400 CLEAR FRONT PANEL WAIT RVCPM BSS 1 OCT 60400 RECEIVE VCP MESSAGE * * TERMINAL CONTROL WORDS WITH LU * TRMIS BSS 1 TRMOC BSS 1 SKP ************************************ * * * STRING AREA * * * ************************************ PRMSG ASC 5,/DSVCP: PRMSL ABS *-PRMSG BDCMM ASC 12,/DSVCP: ILLEGAL COMMAND BMLEN DEF *-BDCMM PSMSG ASC 6,PASSWORD?: PSMLN DEF *-PSMSG ERMSG ASC 10,/DSVCP: ILLEGAL NODE CRLF OCT 6412 CARRIAGE RETURN-LINE FEED ASC 18,INPUT DS NODE (CR TERMINATES DSVCP) ERRLN DEF *-ERMSG ENMSG ASC 6,/DSVCP: END ENMLN DEF *-ENMSG DPMSG ASC 18,DUMP REQUEST, ENTER NEW FILENAME: DPMLN DEF *-DPMSG FMPMS ASC 10,/DSVCP: FMP ERROR - #FMP BSS 3 ASC 7, ON DUMP FILE FMPEL DEF *-FMPMS ABDSD ASC 18,/DSVCP: LINE TIMEOUT - DUMP ABORTED ABDSL DEF *-ABDSD ASKMS ASC 10,TYPE COMMENTS BELOW ASKML DEF *-ASKMS LNFLA DEF LNFLR BSYA DEF BUSY NINTA DEF NOINT CDFLA DEF CRDFL BDINA DEF BDINT IOERA DEF IOERM BRADR DEF *+1 ASC 3,\BREAK EXADR DEF *+1 ASC 2,\END RDADR DEF *+1 ASC 3,\READ WTADR DEF *+1 ASC 3,\WAIT LNFLR ASC 8,LINE FAILURE BUSY ASC 8,LINE BUSY NOINT ASC 8,NOT INITIALIZED CRDFL ASC 8,CARD FAILURE BDINT ASC 8,BAD INTERRUPT IOERM ASC 7,DRIVER ERROR IOER BSS 1 ND&LU ASC 3, NODE NODE# BSS 3 hTRNASC 4, AND LU LU# BSS 1 N&LLN DEF *-ND&LU SKP ******************************* * * * CONSTANT AREA * * * ******************************* * NBR BSS 1 NEIGHBOR FLAG #NWLU BSS 1 NETWORK WRITE LU #NRLU BSS 1 NETWORK READ LU #NLU BSS 1 NETWORK #TLU BSS 1 TERMINAL LU NUMBER HSTND NOP HOST NODE OF SYSTEM FILNM BSS 10 FILE PARAMETERS SECUR DEC 29150 NETWORK SECURITY CODE NODE NOP NODE FOR PARSE NOP NOP BSS 30 CNTR BSS 2 SCR BSS 2 BRPSW NOP PASSWORD FLAG CLSFL NOP CLOSE FLAG RTFLG NOP READ TERMINAL FLAG DPCNT BSS 1 .\ OCT 56000 DUFL NOP DUMP FLAG B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B6 OCT 6 B10 OCT 10 B11 OCT 11 .12 DEC 12 M5 DEC -5 .13 DEC 13 .257 DEC 257 M1 DEC -1 NAB1 OCT 100001 NAB2 OCT 100002 NAB3 OCT 100003 ADMSG DEF *+1 MSGBF BSS 129 MSGLN DEC 129 BFLN BSS 1 ADBUF DEF *+1 INBUF BSS 40 ILEN DEC -78 MLEN BSS 1 DCB BSS 144 DATA CONTROL BSS 10 FERR BSS 1 SKP UNS END DSVCP }T -@ 91750-18103 2013 S C0122 &DUMFM +              H0101 ASMB,C,Q HED DUMFM: 91750-1X103 (C) HEWLETT-PACKARD CO. 1980 NAM DUMFM,7 91750-1X103 REV 2013 791119 M SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: DUMFM * SOURCE: 91750-18103 * RELOC: 91750-1X103 * PGMR: DAN GIBBONS * *************************************************************** SPC 3 ENT APOSN,CLOSE,CREAT,FCONT,LOCF,NAMF ENT OPEN,POSNT,POST,PURGE,READF,RWNDF,WRITF * EXT .ENTR * PRAMS REP 8 PARAMETER ADDRESSES NOP * DUMFM NOP JSB .ENTR PICK-UP PARAMETERS DEF PRAMS CCA INDICATE A DISC ERROR STA PRAMS+1,I SINCE NO FMP PRESENT JMP DUMFM,I RETURN * APOSN EQU DUMFM CLOSE EQU DUMFM CREAT EQU DUMFM FCONT EQU DUMFM LOCF EQU DUMFM NAMF EQU DUMFM OPEN EQU DUMFM POSNT EQU DUMFM POST EQU DUMFM PURGE EQU DUMFM READF EQU DUMFM RWNDF EQU DUMFM WRITF EQU DUMFM * SIZE EQU * * END m .4 91750-18105 2013 S C0122 &DVA65              H0101 tZASMB,Q,N,C * N-ASSEMBLY OPTION: STANDARD VERSION * IFZ HED DVA65 P/N NOT ASSIGNED REV.2013 (C) HEWLETT-PACKARD CO. 1980 @ NAM DVA65 P/N NOT ASSIGNED REV.2013 800516 MEF W/TRACE XIF IFN HED DVA65 91750-16105 REV.2013 (C) HEWLETT-PACKARD CO. 1980 NAM DVA65 91750-16105 REV.2013 800516 MEF XIF * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * *DVA65 COMMUNICATIONS DRIVER FOR DS/1000 * ALL LINE INTERRUPTS HANDLED BY MICROCODE * EXCEPT PROTOCOL FOR LINES ABOVE PRIVILEGED SLOT * *SOURCE PART # 91750-18105 * *REL PART # 91750-16105 * *WRITTEN BY: L. SCHOOF, L. POMATTO, R. SHATZER, C. WHELAN * *MODIFIED BY: LYLE WEIMAN, AUG. '78, TO ADD TRACE CAPABILITY * (# AT RIGHT OF COMMENTS MARKS CHANGES) * *MODIFIED BY: CRAIG HAMILTON 09/07/78 TO IMPROVE ERROR RECOVERY. # * (# IN COLUMN 80 DENOTES CHANGES) # * *MODIFIED BY: PETER BRICKEY, MAY 1979, STANDARDIZED CALLS, NEW @ * ERROR CODES, GENERAL CLEAN-UP. @ * (@ IN RIGHT HAND COLUMN INDICATES CHANGES) @ * @ *MODIFIED BY: CRAIG HAMILTON 05/80 FOR 91750 RELEASE # * FIX SIMULTANEOUS REQUEST RESOLUTION & RQST. # * (# IN COLUMN 80 DENOTES CHANGES) # * USE "Z" OPTION TO INCLUDE "TRACE" OPERATION # * USE "N" OPTION TO EXCLUDE v"TRACE" OPERATION # * *************************************************************** * * DEFINE ENTRY POINTS * ENT IA65,CA65 ENT MIC$X * * DEFINE EXTERNALS * EXT $LIST,$OPSY IFZ EXT $TIME,$CGRN # XIF * * CALLING SEQUENCES * SPC 2 * SEND DS/NON-DS MESSAGE @ SPC 1 * JSB EXEC * DEF *+8 @ * DEF RCODE DEC 20 CLASS WRITE/READ @ * DEF CONWD 10100B+LU TO SEND DS MESSAGE @ * 12100B+LU TO SEND ONLY THE REQUEST BUFFER (DS MODE) @ * 10300B+LU TO SEND NON-DS (RPL) MESSAGE @ * DEF DBUF DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH * DEF RBUF REQUEST BUFFER ADDRESS/LU NUMBER (NON-DS MODE) * DEF RBUFL REQUEST BUFFER LENGTH/MODE (NON-DS MODE) * DEF CLASS @ SPC 2 * INITIALIZE LINK (ENABLE LISTEN MODE) @ SPC 1 * JSB EXEC * DEF *+4 @ * DEF RCODE OCT 3 @ * DEF CONWD 3000B+LU @ * DEF LUWRD LU NUMBER OF CARD @ * SPC 2 * CLEAR LINK (REVERSES INITIALIZE LINK REQUEST) @ SPC 1 @ * JSB EXEC @ * DEF *+3 @ * DEF RCODE OCT 3 @ * DEF CONWD 3100B+LU m @ * @ SKP * SET DRIVER TO DS MODE - @ * - @ * JSB EXEC - @ * DEF *+4 - @ * DEF RCODE OCT 3 - @ * DEF CONWD 3200B+LU - @ * DEF SCODE SECURITY CODE - @ * - @ * - MODE IS IGNORED @ * - WHEN RECEIVING @ * SET DRIVER TO NON-DS MODE - @ * - @ * JSB EXEC - @ * DEF *+4 - @ * DEF RCODE OCT 3 - @ * DEF CONWD 3300B+LU - @ * DEF SCODE SECURITY CODE - @ * - @ SPC 2 * INTERNAL CALLING SEQUENCES USED BY QUEUE @ SPC 2 * READ MESSAGE @ SPC 1 @ * JSB EXEC @ * DEF *+8 @ * DEF RCODE OCT 100021 CLASS READ, NO ABORT @ * DEF CONWD 1000~0B+LU TO READ DS MESSAGE @ * 200B+LU TO READ RPL MESSAGE @ * DEF ZERO =0 @ * DEF DBUFL DATA BUFFER LENGTH @ * DEF ZERO =0/LU FOR NON-DS REQUEST @ * DEF RBUFL REQUEST BUFFER LENGTH/MODE FOR NON-DS REQUEST @ * DEF CLASS @ * SPC 1 * INFORM DRIVER THAT NO SAM IS AVAILBLE (IE SEND STOP) @ SPC 1 * JSB EXEC @ * DEF *+5 @ * DEF RCODE OCT 1 (READ) @ * DEF CONWD 600B+LU @ * DEF ZERO =0 @ * DEF ZERO =0 @ SKP * SET UP TRACE BUFFER AND ENABLE TRACE MODE REQUEST # * # * JSB EXEC # * DEF *+5 # * DEF RCODE OCT 20 (CLASS WRITE-READ) # * DEF CONWD OCT 700B + LU # * DEF BUFR TRACE BUFFER # * DEF TRBFL TRACE BUFFER LENGTH-- MUST BE 4N + 3 # * WHERE N = # ENTRIES DESIRED IN TABLE. # * DEF RN# RN# = SYNCHRONIZING RESOURCE NUMBER # * (MUST BE ALLOCATED GLOBALLY AND LOCKED PRIOR TO # * CALL). THIS RN IS CLEARED EACH TIME DRIVER FILLS# * BUFFER, THUS PROVIDING SYNCHRONIZATION WITH TRoACE# * PRINTOUT PROGRAM. # * DEF OPTN TRACE SELECTION OPTION # * DEF CLASS CLASS NUMBER (SET TO ZERO BEFORE CALL). # * # * THEREAFTER, WHENEVER A COPY OF THE CURRENT CONTENTS OF THE # * TRACE TABLE ARE DESIRED, THEY MAY BE OBTAINED WITH A CLASS I/O # * "GET" CALL, USING THE CLASS NUMBER RETURNED FROM THE PREVIOUS # * SET-UP CALL. BE SURE TO SET THE "DO NOT DE-ALLOCATE BUFFER" # * BIT, OR DISASTROUS THINGS WILL HAPPEN!!!!!!!!!!! # * # * TRACE SELECTION SPECIFIER: # * 0 = TRACE ALL DVA65 ACTIVITY # * #0 = TRACE ONLY ACTIVITY FOR LU USED IN SET-UP CALL. # * # * "TRACE" BUFFER FORMAT: # * WORD 1 -- CONTAINS PASS NUMBER (INCREMENTED EACH TIME THE # * TRACE BUFFER IS RESET). USEFUL IN DETERMINING IF # * TRACE DATA HAS BEEN MISSED. # * WORD 2 -- CONTAINS ADDRESS OF NEXT ENTRY TO BE MADE IN TABLE # * ("OLDEST" ENTRY IN TABLE). # * WORD 3 -- BEGINS TRACE ENTRIES, FOUR WORDS PER ENTRY. # * ENTRY WORD 1 -- DATA WORD AS READ OR WRITTEN # * 2 -- R/X(BIT 15), STATE/EVENT, TIME-OUT INDICATION # * (BIT 0). BIT 15 IS SET IF WORD WAS RECEIVED, # * ELSE 0. BIT 0 IS SET IF A TIME-OUT OCCURRED,# * ELSE 0. # * DATA WORD NOT VALID IF TIME-OUT OCCURRED. # * 3 -- EQT ADDRESS # * 4 X?-- TIME-OF-DAY (LOW 16 BITS OF SYSTEM TIME WORD) # * # * ENABLE TRACE MODE REQUEST # * NOTE: YOU MUST HAVE MADE A SET-UP CALL PREVIOUSLY)# * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 1700B+ANY COMMUNICATION LU LINKED TO DVA65 # * # * DISABLE TRACE MODE REQUEST # * JSB EXEC # * DEF *+3 # * DEF D3 # * DEF 700B+ANY COMMUNICATION LU LINKED TO DVA65 # SKP * ERROR CODES (IN A REGISTER AFTER ANY CONTROL CALL OR CLASS GET) @ * * A = EQT WORD#5, OF WHICH BITS 7-0 INDICATE STATUS: @ * BIT 0 = 0 @ * BIT 1 = ANY ERROR (BITS 4-7 INDICATE TYPE) @ * BIT 2 = WRITE REQUEST @ * BIT 3 = NON-DS REQUEST @ * BITS 4 @ * THRU 7 = ERROR TYPE(OCTAL) @ * @ * RECOVERABLE ERRORS @ * @ * 0 = NO ERROR @ * 1 = LINE FAILURE, A PARITY OR PROTOCOL ERROR WAS @ *  DETECTED AND COULD NOT BE RESOLVED. @ * 2 = TIMEOUT, REMOTE DID NOT RESPOND TO A PROTOCOL @ * CHARACTER WITHIN A LINE TIMEOUT. @ * 3 = LOCAL BUSY, DRIVER IS CURRENTLY PROCESSING A @ * MESSAGE GOING IN THE OPPOSITE DIRECTION, OR @ * BOTH SIDES OF THE LINK ATTEMPTED TO SEND @ * MESSAGES AT THE SAME TIME. @ * 4 = MESSAGE ABORTED, A STOP WAS RECIEVED. @ * 5 = REMOTE BUSY, REMOTE SIDE WAS UNABLE TO @ * SCHEDULE QUEUE OR TO ALLOCATE SAM. @ * @ * FATAL ERRORS @ * @ * 10 = NOT INITIALIZED, AN INITIALIZE LINK COMMAND @ * HAS NOT BEEN RECEIVED YET. IF IN RESPONSE TO @ * AN INITIALIZE COMMAND, INDICATES THAT SYSTEM @ * TABLES WERE NOT CONFIGURED CORRECTLY. @ * 11 = WRONG MODE, WRONG TYPE OF TRAFFIC, (IE, TRYING @ * TO DO A DOWNLOAD WHEN DRIVER IS IN DS MODE. @ * 12 = ILLEGAL REQUEST, COMMAND IS NOT SUPPORTED BY @ * DVA65 (DVA65 WILL GIVE THIS IN RESPONSE TO A @ * FPL SEND/RECEIVE, BREAK, SET MODE REQUEST WITH @ * THE WRONG SECURITY CODE). @ * 17 = UNKNOWN INTERRUPT RECEIVED @ * BITS 8 @ * THRU 13 = INDICATE DRIVER, IN THIS CASE = 65 @ SKP * EQT WORD USAGE BREAKSDOWN * * EQT # USE * 1 DEFINED * 2 DEFINED * 3 DEFINED * 4 DEFINED * 5 DEFINED * 6 DEFINED * 7 ADDRESS OF DATA BUFFER * 8 LENGTH OF DATA BUFFER * 9 ADDRESS OF REQUEST BUFFER/LU FOR INITIALIZE CALL @ * 10 LENGTH OF REQUEST BUFFER (BIT 15 SET = CLOSED LOOP) @ * 11 CO-ROUTINE ADDRESS * 12 CURRENT STATUS TABLE (SEE BREAKDOWN) * 13 ADDRESS OF EQT EXTENSION * 14 DEFINED...USED FOR SINGLE WORD TURN-AROUND TIMEOUT * 15 DEFINED...MICROCODE ALSO SETS TIME-OUTS * EXT(0) COUNTER FOR DATA TRANSFER * EXT(1) LAST WORD RECEIVED OVER COMM LINE * EXT(2) VERTICAL PARITY WORD # * EXT(3) DIAGONAL PARITY WORD # * EXT(4) COUNT OF TOTAL # BLOCKS TRANSMITTED * EXT(5) COUNT OF TOTAL TRANSMIT-PARITY-ERROR RETRIES # * EXT(6) LU NUMBER @ * * BREAKDOWN OF EQT WORD 12 * * BIT USAGE * 0-2 RETRY COUNTER OR * 0-5 BROKEN LINE COUNTER * 6 BROKEN LINE FLAG * 7 NON-DS MODE @ * 8 NOT USED @ * 9 REQUEST PENDING * 10 DRIVER INITIALIZED (LISTEN MODE ENABLED) @ * 11 RESERVED (USED BY SPECIAL FORCED-COLD-LOAD # * DRIVER, NOT PART OF DS/1000) # * 12 LAST SUCCESSFUL OPERATION (1=WRITE) * 13 FLAG FOR WRITE RETRY IN PROGRESS * 14 MICROCODE READ/WRITE FLAG * 15 POWER-FAIL RECOVERY IN PROGRESS  # SKP * * DRIVER INITIALIZATION SECTION * IA65 NOP LDA EQT14 INA STA EQT15 REESTABLISH EQT15 ADDR JSB SETIO CONFIGURE I/O INSTRUCTIONS SERET LDB EQT13,I EXTENSION ADDRESS ADB B6 LDA B,I GET 7TH EXT. WORD SZA IS THIS THE FIRST ENTRY FOR EQT? JMP NFIR NO * * THIS CODE IS EXECUTED ONLY ON FIRST TIME THROUGH FOR EQT * STA EQT12,I YES, INITIALIZE EQT12 STATUS STB B,I AND INDICATE DRIVER ENTRY JSB RDD.C CLEAR CARD * MODIFY CODE IF A DMS SYSTEM LDB $OPSY SYSTEM TYPE CLA,CCE RBR,SLB DMS SYSTEM? STA MOD1 YES, MODIFY INSTRUCTIONS ERA CCB SET REGISTERS FOR CPU TYPE CHECK OCT 100060 THIS SETS B TO 0 IFF XE NOP LDA XEMIC MICROCODE CALL FOR XE SZB SKIP IF XE LDA MXMIC ELSE USE 21MX MICROCODE CALL STA MIC$X SAVE LOCALLY * LDA EQT4,I TELL RTE TO RETURN CONTROL ON TIME OUT, IOR .300 AND FOR POWER-FAIL RECOVERY. # STA EQT4,I * GET QUEUE'S ID SEGMENT ADDRESS @ JSB $LIST @ OCT 217 @ DEF QUEUE @ SZA WAS ATTEMPT SUCCESSFUL? @ CCB NO, SET ADDRESS = -1 @ STB PROG IN ANY CASE, SAVE IT @ * SKP NFIR LDA EQT6,I GET THE REQUEST CODE @ AND B3703 AND ISOLATE IT @ STA B THEN SAVE IT IN B @ ALF,ALF SAVE READ/ @ RAL,ELA WRITE FLAG @ LDA EQT5,I NOW GET THE STATUS @ AND B1774 RESET THE STATUS @ a SEZ COULD THIS BE A WRITE REQUEST? @ IOR B4 YES, SET WRITE FLAG IN STATUS @ STA EQT5,I THEN REPLACE THE UP-DATED STATUS @ CCE,SSA IS THIS A POWER-FAIL RECOVERY @ JMP PFAIL YES, ABORT CURRENT OPERATION @ * CPB B3103 NOW, IS THIS A CLEAR REQUEST? @ JMP CLREQ YES, DO IT @ CPB B3003 NO, IS IT AN INITIALIZE REQUEST? @ JMP LCREQ YES, DO IT @ IFZ CPB B703 DISABLE TRACE MODE? # JMP DTRAC YES. # CPB B1703 RE-ENABLE TRACE MODE? # JMP ETRAC YES. # XIF LDA B GET THE OPERATION REQUEST @ AND B3 MASK OFF CODE CPA B1 IS IT A READ? JMP REQ YES...READ OR WRITE/READ CALCK JSB CHKIN NO, IS DRIVER INITIALIZED? # * @ * REQUEST MUST EITHER BE ILLEGAL OR A SET MODE REQUEST @ * @ LDA EQT7,I MUST HAVE PROPER SECURITY CODE @ CPA SCODE IF THIS IS A SET MODE REQUEST @ JMP *+2 OK, SECURITY CODE CHECKS @ JMP REJCT NOT CORRECT, REJECT REQUEST @ LDA EQT12,I NOW, SET-UP FOR SET MODE REQUEST @ CPB B3203 IS IT A SET DS MODE REQUEST? @ JMP DS YES, CLEAR NON-DS BIT @ CPB B3303 OR IS IT A SET NON-DS MODE REQUEST @ JMP NONDS IT IS, SET NON-DS BIT @ REJCT LDB #ILRQ MUST BE AN ILLEGAL REQUEST @ IAER JSB STAT ERROR DETECTED LET CALLER KNOW IT! @ LDA B2 IT WAS A CONTROL REQUEST ERROR @ JMP IA65,I RETURN TO CALLER  @ * DS AND CLR7 CLEAR @ JMP *+2 AND EXIT @ NONDS IOR B200 SET @ STA EQT12,I RESTORE EQT12 @ LSR 4 NOW MUST SET MOOD FLAG @ AND B10 SO THAT DS/NON-DS BIT MAY BE @ STA MOOD SET IN EQT5, WHEN STATUS IS UPDATED @ JMP IDON SET-UP GOOD RETURN @ * @ SKP CHKIN NOP @ LDA EQT12,I HAS THE DRIVER BEEN @ CHKN0 ALF,RAL INITIALIZED FOR THIS EQT ENTRY? # SSA CHECK BIT #10 (LSTEN MODE) @ JMP CHKIN,I ALL OK, RETURN @ LDA EQT11,I NOT INITIALIZED, IS THE REASON DUE @ CPA TMAD TO A BROKEN LINE? @ JMP BDLNE YES, MORE INVESTIGATION IS NEEDED @ LDB #NOIN NO, SET STATUS TO NOT INITIALIZED @ JMP IAER AND REJECT THIS REQUEST @ * CKRTN DEF CALCK+1 CONSTANT FOR 'BDLNE' BRANCHING CHECK. # * * INITIALIZE DRIVER @ * LCREQ LDA EQT7,I GET THE LU NUMBER @ AND B377 AND ONLY THE LU NUMBER @ LDB EQTX COMPUTE EQTX(6) ADDRESS @ ADB B6 @ STA B,I @ LDA MIC$X INITIALIZE TO USE OPEN LOOP MICROCODE MOD1 JMP LCR2 NOP IF DMS SYSTEM CELL EQU *+1 XSA * DO CROSS-MAP STORE RSS LCR2 STA CELL,I NON-DMS, MODIFY TRAP CELL JSB RDD.C READ CARD TO CLEAR IT LISTI STC 0,C SET RECEIVE INTERRUPT MODE LDA .020 SET INITIALIZED AND DS MODE BITS @ STA EQT12,I IN CURpRENT EQT STATUS @ CLA,INA ENABLE MICROCODE TO READ 1 WORD @ LDB LSTNI AND ENABLE LISTEN MODE @ IDON0 STA EQTX,I MICROCODE READ COUNT @ STB EQT11,I CO-ROUTINE ADDRESS @ IDON CLB INDICATE A GOOD COMPLETION @ JSB STAT IN THE STATUS @ LDA B4 SET FOR IMMEDIATE COMPLETION EXIT # JMP IA65,I AND DO IT @ * CLREQ JSB RDD.C READ DATA & STATUS FROM CARD TO CLEAR@ STA EQT12,I UPDATE EQT STATUS =0 # CLB SET CO-ROUTINE ADDRESS TO 0 @ JMP IDON0 AND DISABLE LISTEN MODE @ SKP * COME HERE ON A READ OR WRITE * REQ EQU * IFZ LDA EQT6,I GET REQUEST # AND B1700 MASK SUBFUNCTION # CPA B700 ENABLE TRACE MODE CALL? # JMP TRAC. YES # XIF LDB EQT6,I GET THE REQUEST CODE @ BLF,RBL AND ISOLATE THE 'NO DATA' BIT (10) @ SSB,RSS CHECK IT @ JMP WDATA NOT SET, CONTINUE @ * CLA SET, SO DATA LENGTH = 0 @ STA EQT8,I @ LDA EQT9,I AND BUFFER ADDRESS TO POINT @ STA EQT7,I TO THE SECOND (REQUEST) BUFFER @ WDATA LDA EQT12,I NOW GET THIS EQT'S STATUS @ AND NMSK CLEAR THE UNNECESSARY FLAGS @ STA EQT12,I KEEPING BITS 6,7,9,10,12 @ BLF NOW ISOLATE WRITE & MODE BITS (7,6) @ SLB IS THIS A NON-DS REQUEST? @ JMP REQ0 YES, SKIP THE DS STUFF @ * LDA EQT10,I FOR DS MODE THE REQUEST @ ADA N2 BUFFER LENGTH MUST BE REDUCED BY 2 @ SSA IS THE REDUCED BUFFER SIZE OK? @ JMP REJCT NO, REJECT THIS REQUEST @ * STA EQT10,I OK, SAVE NEW REQUEST SIZE @ LDA EQT8,I NOW SAVE THE DATA LENGTH @ STA EQT6,I IN EQT6 @ ADA EQT10,I THEN GET THE TOTAL OF BOTH BUFFER @ STA EQT8,I LENGTHS FOR THE TRANSMISSION LENGTH @ STB TEMP SAVE READ/WRITE, MODE FLAGS FOR NOW @ ELB REMEMBER READ/WRITE IN E @ LDB EQT9,I ALSO FOR A DS REQUEST THE @ ADB EQT10,I LOGICAL UNIT NUMBER MUST BE @ ADB B1 (CORRECT BUFFER POINTER) @ LDA B,I PLACED IN THE LAST BYTE, ALONG @ AND B1770 WITH CLEARING BIT 8, @ SEZ,RSS BUT FOR READS, CLEAR @ CLA TOP 8 BITS @ IOR LU OF THE REQUEST BUFFER @ STA B,I IT IS @ LDB TEMP THEN RESTORE READ/WRITE, MODE FLAGS @ * REQ0 JSB CHKIN IS THE DRIVER INITIALIZED? @ RAL,ELA YES, (A)=EQT12 AFTER A ALF,RAL @ RAL,RAL SO SHIFT MODE TO BIT 0, RP TO E REG @ SSB,RSS NOW IS THIS A WRITE REQUEST? @ JMP REQ1+1 NO, DRIVERS MOOD IS OF NO CONCERN @ XOR B YES, IS THE DRIVER IN THE MOOD TO @ SLA,RSS ACCEPT THIS REQUEST? @ JMP REQ1 YES, CONTINUE @ LDB #WRMD NO, DRIVER HAS A HEADACHE @ JMP IMXIT SO, REJECT THIS REQUEST # * REQ1 CME SINCE THIS IS A WRITE REVERSE RP FLAG@ SEZ,RSS SKIP IF (WRITE&NOT RP) OR (READ&RP) @ JMP BUSY OTHERWISE BUSY OR INVALID REQUEST SSB SKIP IF A READ JMP WREQ DO A WRITE SKP * READ REQUEST *  RBR,SLB IS THIS A REQUEST TO SEND A STOP? @ JMP STPRQ YES, DO IT @ LDA EQT12,I OTHERWISE GET THIS EQT'S STATUS @ AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I * REQ2 LDB EQT10,I GET RECEIVED RQST LENGTH. @ CPB B1 IF REQUEST LENGTH =1, # JMP PROGL THEN THIS IS A REQUEST. # JMP CKLSB NOT --SKIP ADJUSTMENTS. # * PROGL STB EQT6,I SET TRANSMISSION LOG # STB EQT8,I AND DATA LENGTH EQUAL TO 1. # CLB ECHO A REQUEST LENGTH EQUAL TO 0 # CKLSB LDA EQT4,I IN ANY CASE # ALF,ALF GET LSB OF SUBCHANNEL RAL,ELA AND STORE IT IN E REG RBL,ERB ECHO WD WITH BIT15=1 IF CLOSED LOOP REQ3 EQU * @ IFZ LDA B23 STATE 19: READ RQST, ECHOING RQST LNTH# XIF JSB TALK SEND REQUEST LENGTH & AWAIT RESPONSE # IFZ LDA B24 STATE 20: READ RQST, CHECKING RESPONSE# XIF JSB CHECK CHECK RCVD WORD JMP REQ4 MUST RETRY ON TIMEOUT @ JMP ERR.4 STOP RECEIVED JMP ERR.9 RC RCVD, PROTOCOL FAILURE @ CPB TNW JMP RDBLK "TNW" RCVD, OK TO READ-IN REQUEST @ CPB RLW RLW RECEIVED? JMP REQ2 YES, RE-ECHO REQUEST LENGTH @ * REQ4 JSB RETRY UNRECOGNIZED WORD RECEIVED @ LDB RLW SEND RLW AND JMP REQ3 TRY AGAIN @ * * THIS SECTION INITIATES ALL MICROCODE BLOCK READS * RDBLK LDB EQT4,I LSL 9 SIGN = SUBCHANNEL LSB LDA MIC$X GET MICROCODE MACRO INSTRUCTION SSB SKIP IF SUBCHANNEL EVEN (XMIT MODE) INA ODD SUBCHANNEL, RUN CARD IN RCV MODE STA CELL,I STORE COMM.LINxES TRAP CELL LDB TNW SEND TNW IFZ CLA STATE 0: INITIATING READ, SENDING TNW# XIF JSB OUTPB LDB EQT14,I & SET COMM LINE TIMEOUT STB EQT15,I LDA EQT8,I GET SUM OF DATA & REQ LENGTHS CMA -# OF WORDS -1 STA EQTX,I SET MICROCODE'S COUNTER JSB CEXIT NOW DO IT! * * BLOCK HAS BEEN READ, CHECK TRANSMISSION LDA COUNT MICROCODE COUNT ADA EQT8,I SSA SKIP IF XFER GOT STARTED JMP RDB4 ELSE RETRY, TNW MAY HAVE BEEN LOST # IFZ LDA B25 STATE 21: BLOCK HAS BEEN READ, # * WAITING FOR TNW# XIF JSB CHECK CHECK XMISSION JMP RDTO TIMEOUT, EXAMINE THE REASON. # JMP ERR.4 STOP RECEIVED @ JMP ERR.9 REQUEST COMING: PROTOCOL FAILURE! @ RDB2 CPB TNW WAS LAST A "TNW"? # JMP ENDIT YES, SUCCESSFUL READ. # RDTO CPB RLM REQUEST TO TRY AGAIN? # JMP RDB4 YES, SEE IF ALLOWED. # LDB COUNT IF THE MICROCODE COUNT HAS # CPB B100 BEEN SET =100B, THEN # JMP ER6WT A PROTOCOL FAILURE HAS BEEN DETECTED!# CPA .040 ACTUAL TIMEOUT? # JMP ERR.3 YES, PROCESS THE ERROR. # * * LAST CONTROL UNRECOGNIZED * RDB3 EQU * # IFZ LDA B26 STATE 22:BLOCK READ BUT LAST CTRL UNREC# XIF LDB RLW SEND "RETRANSMIT LAST WORD # JSB TALK & READ RESPONSE IFZ LDA B27 STATE 23:CHECKING RESPONSE TO RLW # XIF JSB CHECK SEE WHAT WE GOT JMP RDB5 NO RESPONSE, TRY AGAIN, IF ALLOWED. # JMP ERR.4 STOP RECEIVED O@ JMP ERR.9 REQUEST COMING: PROTOCOL FAILURE! @ JSB RETRY RETRY OUR RETRY JMP RDB2 * RDB4 JSB RETRY GIVE IT 8 TRIES JMP RDBLK * RDB5 JSB RETRY IF RETRIES ARE ALLOWABLE, # JMP RDB3 SEND RLW, AND AWAIT ACKNOWLEDGMENT. # * SKP * * HERE ON RECEIVE PROTOCOL ERRORS--DELAY TO FORCE XMIT TIMEOUT # * ER6WT EQU * # LDA N100 ALLOW A 1 SECOND DELAY # STA EQT15,I TO FORCE A TRANSMITTER TIMEOUT. # CLA DISABLE # STA EQTX,I MICROCODE. # JSB CEXIT AWAIT THE TIMEOUT RETURN. # LDB #LFAL INDICATE PROTOCOL FAILURE IN EQT5. @ JMP CEND GO TO TERMINATE THE CURRENT OPERATION. # * SKP * * WRITE REQUEST * WREQ SLB,RSS IS THIS A NON-DS REQUEST? @ JMP WRTRY NO, CONTINUE @ LDA EQT7,I YES, GET THE PROGL DOWNLOAD ADDRESS @ INA WHICH IS IN WORD 2 OF THE @ LDB A,I DATA BUFFER AND USE IT AS @ STB EQT10,I THE REQUEST LENGTH @ INA ALSO START TRANSMISSION WITH @ STA EQT7,I THE THIRD WORD OF THE DATA BUFFER @ LDA EQT8,I FINALLY, THE DATA LENGTH @ ADA N3 MUST BE REDUCED BY 3 @ STA EQT6,I AS WELL AS @ STA EQT8,I THE TRANSMISSION LOG @ * WRTRY EQU * # IFZ CLA,INA STATE 1:WRITING, SENDING RC # XIF LDB RC GET RC (REQUEST COMING) # JSB TALK SEND RC & READ RESPONSE IFZ LDA B2 STATE 2:WRITING, SENT RC, EXPECT TNW# XIF JSB CHECK CHECK WHATư WE GOT JMP WRTR1 TRY AGAIN IF TIMEOUT JMP WRTRY STOP, RETRY IMMEDIATELY JMP SIMRQ RC, SIMULTANEOUS REQUEST CPB RLW RLW RECEIVED? JMP WRTRY YES, OTHER SIDE SAYS RETRY CPB TNW RSS SKIP IF "TNW" RECEIVED JMP WRTR1 UNRECOGNIZED, RETRY * SEND DATA LENGTH LDB EQT6,I DATA LENGTH IFZ LDA B3 STATE 3:WRITING, SENDING DATA LENGTH# XIF JSB TALK SEND DATA LENGTH, GET ECHO IFZ LDA B4 STATE 4:WRITING, SENT DATA LNTH, # * EXPECT ECHO # XIF JSB CHECK CHECK RESPONSE JMP ERR.3 TIMEOUT JMP TSDLN 'STOP' CODE MAY BE A VALID DATA LENGTH # JMP SIMRQ SIMULTANEOUS REQUEST TSDLN CPB EQT6,I ECHO OK? JMP SRQLN YES # CPB STOP LEGITIMATE 'STOP'? # JMP ERR.4 YES, PROCESS IT. # JMP WRTR1 NO, RETRY * SKP * SEND REQUEST LENGTH * SRQLN LDB EQT10,I REQUEST LENGTH # IFZ LDA B5 STATE 5:WRITING, SENDING REQUEST LENGTH# XIF JSB OUTPB SEND IT LDA B1776 STA EQT15,I APPROXIMATELY 1 SEC TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT READ NEXT WORD WREQ2 EQU * IFZ LDA B6 STATE 6:WRITING, SENT REQ. LNTH, EXPECT ECHO# XIF JSB CHECK CHECK RESPONSE JMP WRTR1 TIMEOUT, RETRY JMP ERR.5 REMOTE IS BUSY JMP SIMRQ RC * * CONFIGURE FOR EITHER CLOSED OR OPEN LOOP MICROCODE PROCESSING * LDA EQT10,I ELA SAVE EQT10 SIGN LDA MIC$X MICROCODE CALL RBL,SLB,ERB IF BIT 15=1, RCVR WANTS CLOSED LOOP INA SET TO CALL CLOSED LOOP PROCESSOR STA CELL,I SET TRAP CELL CPB uEQT10,I CHECK ECHOED RQST LENGTH JMP WRBLK LENGTH ECHO IS OK SKP * JSB RETRY NOT VALID ECHO, BUMP RETRY COUNT CPB RLW WAS IT AN RLW? (CBL RETRY) JMP WRTRY YES, DO IMMEDIATE RC RETRY LDB RLW IFZ LDA B7 STATE 7:WRITE RETRY # XIF JSB TALK SEND RLW JMP WREQ2 * * REQUEST PREAMBLE WRITE FAILURE - WAIT 1 I/O T.O. AND RETRY THE RC# * WRTR1 JSB RETRY CHECK RETRY COUNT LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAP CELL FOR 1 WORD READ JSB CEXIT DO READ IFZ LDA B10 STATE 8: REQUEST PREAMBLE WRITE FAILURE--RETRY# XIF JSB CHECK SEE WHAT WE GOT JMP WRTRY TIMED-OUT, RESEND RC JMP ERR.4 STOP RCVD, EXIT JMP SIMRQ RC, SIMULTANEOUS REQUEST # JMP WRTRY UNRECOGNIZED, DO RC ANYWAY * * SIMULTANEOUS REQUEST OCCURRED, RESOLVE BASED ON LAST OPERATION * SIMRQ JSB RETRY DON'T TRY FOREVER LDA EQT12,I ALF,SLA TEST LAST SUCCESSFUL OPERATION (BIT 12) RSS LAST WAS WRITE, WE MUST WAIT JMP WRTR1+1 LAST WAS READ, WE GET PRIORITY * LDB RLW IFZ LDA B11 STATE 9:YIELD FOR SIMULTANEOUS REQUEST.# XIF JSB XMITX SEND RLW IN XMIT MODE LDA EQT12,I SET THE 'REQUEST PENDING' BIT (#9) # IOR .010 IN THE EXTENDED STATUS WORD # STA EQT12,I TO PREVENT ACCEPTING A NEW REQUEST. # LDA EQT14,I SET A PROTECTIVE TIMEOUT # STA EQT15,I IN CASE THE REMOTE EXPIRES. # * LDB #LBUS INDICATE LOCAL BUSY, IE @ JMP CEND GIVE SIMULTANEOUS REQUEST STATUS SKP * ENTER HERE TO DO ALL BLOCK WRITES WRBLK LDB TNW THIS TNW WILL INITIATE MICROCODE IFZ LDA B12 STATE 10:WRITING, SENDING TNW, EXPIECT TNW# XIF WXFER EQU * JSB OUTPB SEND IT LDB EQT14,I STB EQT15,I SET LINE TIMEOUT LDA EQT12,I IOR .400 SET MICROCODE WRITE BIT(#14) # STA EQT12,I UPDATE EQT STATUS LDA EQT8,I LENGTH FOR XFER CCE,SZA,RSS # JMP ENDIT ZERO LENGTH DATA, GET OUT NOW CMA -LENGTH-1 STA EQTX,I SET MICROCODE COUNTER JSB CEXIT LET MICROCODE DO ITS THING * * BLOCK HAS BEEN WRITTEN, CHECK TRANSMISSION LDA COUNT GET MICROCODE XFER COUNT, # LDB EQTX AND EQT EXTENSION ADDRESS. # CCE,SZA,RSS IF THE TRANSFER WAS SUCCESSFUL, THEN # JMP WRTOK COMPLETE THE HOUSEKEEPING. # * # CPA B77 IF PARITY FAILED # JMP WRTR2 GO TO RETRY THE TRANSFER. # CPA B100 IF PROTOCOL FAILED, # INB,RSS THEN SKIP TO DETERMINE THE REASON; # JMP ERR.3 ELSE, GIVE A TIMEOUT ERROR. # LDA B,I GET THE RECEIVED WORD. # CPA STOP IF A "STOP" WAS RECEIVED, # JMP ERRW4 THEN ABORT, AND INFORM THE CALLER. # CPA RC IF AN "RC" WAS RECEIVED, THEN THE RCVR # JMP SIMRQ IS OUT OF SYNC--RESOLVE THE CONFLICT. # JMP ERR.9 UN-RECOGNIZEABLE: PROTOCOL FAILURE! # * # WRTOK ADB B4 POINT TO DATA BLOCK XFER COUNTER. # ISZ B,I BUMP THE TOTAL SUCCESSFUL BLOCK COUNT. # NOP # JMP ENDIT COMPLETE THIS OPERATION. # * * PARITY FAILURE: PERFORM A WRITE RETRY # WRTR2 JSB RETRY CHECK RETRY COUNT  # ADB B5 POINT TO THE BLOCK RETRY COUNTER # ISZ B,I BUMP WRITE RETRY COUNTER NOP LDA EQT12,I IOR .200 SET "WRITE RETRY" FLAG (BIT 13) STA EQT12,I LDB RLM "RETRANSMIT LAST MESSAGE" IFZ LDA B13 STATE 11: PERFORMING WRITE RETRY # XIF JMP WXFER PERFORM RE-WRITE SKP * LOCAL BUSY OR READ REJECT FOR NO R.P. BUSY CCB LDA EQT15,I IS THERE A TIMEOUT PENDING IOR EQTX,I OR IS MICROCODE ENABLED? SZA,RSS SKIP IF YES TO EITHER STB EQT15,I ELSE SYSTEM WIPED OUR TIMEOUT LDB #LBUS @ IMXIT JSB STAT SET LOCAL BUSY FLAG # LDA B4 IMMEDIATE COMPLETION LDB EQT6,I RETURN DATA LENGTH IN B JMP IA65,I RETURN * * HERE FOR REMOTE BUSY ERR.5 LDB #RBUS @ JMP CEND * * POWER FAIL: SEND 'STOP' & REPORT PROTOCOL ERROR; HIGHER LEVELS MAY RETRY # * # PFAIL LDA EQT12,I SET POWER-FAIL RECOVERY IN PROGRESS # RAL,ERA (EQT12: BIT#15) # STA EQT12,I INTO THE EXTENDED STATUS WORD. # IFZ LDA B34 STATE 28: POWER FAILURE # JMP PSTAT GO TO SET PARITY/PROTOCOL ERROR STATUS.# XIF * * HERE FOR PARITY ERROR ERR.6 EQU * # IFZ LDA B31 STATE 25: PARITY ERROR # JMP PSTAT GO TO SET PARITY ERROR STATUS. # XIF * HERE ON ALL PROTOCOL FAILURES (WRITING & READING) * ERR.9 EQU * IFZ LDA B32 STATE 26:PROTOCOL FAILURE # XIF * PSTAT LDB #LFAL GET PARITY/PROTOCOL ERROR STATUS. # * * HERE TO SET ERROR, SEND STOP, & TERMINATE * ERSET EQU * IFZ STA STATE < SAVE DRIVER STATE # XIF JSB STAT PUT STATUS INTO EQT 5 LDB STOP IFZ LDA STATE LOAD STATE #(DEPENDS ON ERROR) # XIF JSB XMITX SEND STOP & AWAIT INTERRUPT JSB RDD.C CLEAR CARD BY READING IT JMP CEND+1 AND RETURN ERROR CODE. # SKP * * THIS SUBROUTINE INITIALIZES THE EQT TIMEOUT FLAG, SETS THE * COMM LINE TRAP CELL TO A "JSB CIC" IF IT IS ABOVE THE * PRIVILEGED CARD AND SETS THE MICROCODE COUNTER TO 1. * TRAPR NOP LDA EQT4,I AND CLR11 CLEAR THE EQT4 TIMEOUT FLAG STA EQT4,I LDB CELL THIS LINE'S SELECT CODE CMB,INB ADB DUMMY TEST AGAINST PRIVILEGED CARD'S SC LDA MIC$X MICROCODE CALL MACRO SSB ARE WE ABOVE THE PRIVILEGED CARD? LDA TBG,I YES, GET A "JSB CIC" STA CELL,I SETUP TRAP CELL CLA,INA STA EQTX,I SET MICROCODE COUNT = 1 JMP TRAPR,I RETURN SPC 1 * * SEND WORD, SET TIMEOUT, & AWAIT RESPONSE * TALK NOP JSB OUTPB SEND WORD IN B REG LDB EQT14,I SET COMMUNICATIONS STB EQT15,I LINE TIMEOUT JSB TRAPR SETUP TRAPCELL FOR 1 WORD READ LDA TALK COROUTINE RETURN ADDRESS JMP CEXT1 SPC 1 * * IF ALREADY 7 RETRIES, GIVE PARITY ERROR ELSE BUMP COUNT & RETURN * RETRY NOP LDA EQT12,I AND B7 ISOLATE RETRY COUNTER CPA B7 IS THIS THE 8TH RETRY? JMP FAIL YES, RETURN ERROR ISZ EQT12,I BUMP COUNT JMP RETRY,I & TRY AGAIN * FAIL LDB COUNT SZB WAS WORD COUNT ZERO? CPB B77 NO, WAS IT BLOCK PARITY? JMP ERR.6 RETURN A PARITY ERROR * * HERE FOR TIMEOUT ERR.3 LDB #TMOT TIMEOUT BIT FOR EQT5 @ IFZ LDA B33 STATE 27: TIMEOUT @ END OF REQUEST # XIF JMP ERSET EXIT WITH LINE T.O. ERROR - # * SKP * * CONTINUATION SECTION * CA65 NOP JSB SETIO CONFIGURE I/O INSTRUCTIONS LDB EQT11,I GET COROUTINE ADDR SZB,RSS IT IT SET-UP? JMP IUNKN GO TO UNKNOWN INTERRUPT PROCESSOR LDA EQTX,I STA COUNT SAVE MICROCODE COUNT CLA STA EQTX,I DISABLE MICROCODE CPB TMAD WAS THIS A BROKEN LINE TIMEOUT? @ JMP B,I YES, GO TO RESET THE DRIVER @ LDA EQT12,I AND .020 ISOLATE "LISTEN ENABLED" BIT IOR EQT1,I ALSO TEST FOR DRIVER BUSY SZA IS EITHER CONDITION TRUE? JMP B,I YES, GO TO COROUTINE ADDR ISZ CA65 NO. IGNORE THE INTERRUPT. * CLCRD JSB RDD.C CLEAR THE CARD JMP CEXT3 & GET OUT * * * * UNKNOWN INTERRUPTS COME HERE * WE'RE IN TROUBLE IF WE EVER GET HERE!!!!! * IUNKN STB EQT12,I CLEAR ALL CARD STATI LDB #BDIN SET ALL STATUS ERROR BITS @ JMP CEND GET OUT...NOW!!! * SKP * HERE FOR FIRST INTERRUPT WHEN CARD IN LISTEN MODE * ILSTN LDA EQT12,I AND B1776 INITIALIZE BROKEN LINE COUNT STA EQT12,I ILSN0 EQU * IFZ LDA B14 STATE 12: FIRST INTERRUPT IN LSTEN MODE, EXP.RC # XIF JSB CHECK FIND OUT WHAT THEY SENT US JMP ILSN4 TIME OUT...IGNORE JMP ILSN4 STOP...IGNORE JMP ILSN1 REQUEST COMING * * ENTER HERE WHEN UNRECOGNIZED WORD RECEIVED WHILE "LISTENING" JSB RDD.C CLEAR COMMUNICATIONS CARD LDA EQT12,I ISZ EQT12,I BUMP BROKEN LINE COUNT AND B77 CPA B77 64 JUNK WORDS IN A ROW = BROKEN LINE JMP DEXIT IT IS, LEAVE CARD DISABLED & EXIT @ JSB TRAPR SETUP FOR 1 WORD READ JSB CEXIT EXIT IN RCV MODE JMP ILSN0 GOT ANOTHER WORD, GO CHECK IT * ILSN1 LDA EQT12,I EQT STATUS IOR .010 SET REQUEST PENDING FLAG (BIT 9)  STA EQT12,I SAVE IT * ILSN2 EQU * RESPOND TO 'RC' BY SENDING A 'TNW'. # IFZ LDA B15 STATE 13:SENDING TNW, NEED DATA LENGTH # XIF LDB TNW SEND A TNW (TRANSMIT NEXT WORD) # JSB TALK & WAIT FOR DATA LENGTH IFZ LDA B16 STATE 14: RECEIVING, NEED DATA LENGTH # XIF JSB PRECK DO PREAMBLE CHECKING STB LEN1 SAVE DATA LENGTH FOR PROGRAM @ IFZ LDA B17 STATE 15: ECHO DATA LEN., NEED REQ.LEN.# XIF JSB TALK ECHO IT & GET REQUEST LENGTH IFZ LDA B20 STATE 16: RECEIVING, NEED REQ. LNTH # XIF JSB PRECK DO PREAMBLE CHECKING STB LEN2 SAVE RQST LENGTH FOR PROGRAM @ LDA LEN1 NOW DETERMINE IF REQUEST IS @ CPA B2 FOR A DOWNLOAD, FOR QUEUE @ SZB MUST KNOW WHETHER TO SCHEDULE @ CLA,RSS GRPM @ CLA,INA PROGL @ STA TYPE INDICATES ACTION QUEUE IS TO TAKE @ LDA PROG WAS QUEUE'S ID SEGMENT ADDRESS @ SSA FOUND? @ JMP ILSN3 NO, SEND A 'STOP' @ JSB $LIST YES, SCHEDULE QUEUE @ OCT 1 @ DEF *+7 @ PROG NOP ADDRESS OF PROGRAM HERE @ DEF SCODE SECURITY CODE @ DEF LU LOGICAL UNIT NUMBER @ DEF LEN1 DATA LENGTH @ DEF LEN2 REQUEST LENGTH @ DEF TYPE IF TYPE=0, REQUEST IS FOR GRPM @ * =1, REQUEST IS FOR PROGL @ SZA WAS SCHEDULE SUCCESSFUL? @ JMP ILSN3 9 NO, QUEUE WAS BUSY @ ILSN4 JSB RDD.C OK, CLEAR CARD BY READING IT JSB TRAPR SETUP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI SET FOR LISTEN MODE INTERRUPT JMP CEXT1 AND EXIT * * HERE IF WE GOT A "BUSY" CONDITION * ILSN3 EQU * # IFZ LDA B21 STATE 17: QUEUE BUSY, SENDING 'STOP' # XIF LDB STOP SEND 'STOP' TO INDICATE NODE IS BUSY. # JSB OUTPB SEND IT * * HERE ON STOP...CLEAR REQUEST PENDING STATUS * ILSN5 LDA EQT12,I AND CLR9 CLEAR REQUEST PENDING FLAG STA EQT12,I JMP ILSN4 TERMINATE * * SUBROUTINE TO CHECK RCVD PREAMBLE WORD & RETRY IF RC * PRECK NOP JSB CHECK CHECK RCVD WORD JMP ILSN5 TIME-OUT, CLEAR RP CONDITION RSS 7760B IS POSSIBLE DATA LEN JMP ILSN2 RC, RESTART PREAMBLE LDA EQTX PASS EXT AREA ADDR BACK JMP PRECK,I * SKP * * HERE FOR SEND STOP REQUEST * STPRQ LDB STOP SEND STOP CLA DON'T ALTER STA CELL TRAP CELL. IFZ LDA B22 STATE 18: REQUEST TO SEND 'STOP' # # XIF JSB XMITX IN XMIT MODE JSB RDD.C READ CARD TO CLEAR IT STA CELL LDA EQT12,I SAVE LAST OPERATION, LISTEN, MODE @ AND BSTMK AND BROKEN LINE BITS @ JMP ENDOK * * NOW SET FLAG TO SHOW WHETHER THE LAST SUCCESSFUL OPERATION WAS A * READ OR WRITE. THIS IS USED TO RESOLVE SIMULTANEOUS LINE CONTENTION. ENDIT LDA EQT12,I AND .022 SAVE INIT. & DS MODE FLAG (BITS 7,10) @ SEZ,CLE SKIP IF READ; ELSE, # IOR .100 SET LAST OPERATION AS WRITE. * ENDOK STA EQT12,I SET STATUS CLB SET GOOD STATUS # JMP CEND # * * 'STOP' RECE1FIVED SOMETIME DURING TRANSMISSION ERRW4 EQU * IFZ CH.01 NOP 'RSS' HERE WHEN TRACE MODE ENABLED # JMP ERR.4 SKIP 'TRACE' STUFF WHEN DISABLED # JSB CKTRC CHECK IF WE'RE TO TRACE THIS ONE # JMP ERR.4 NO, CONTINUE LDB B30 STATE 24:'STOP' RC'D DURING XMIT-ABORT# JSB TRACE # LDB STOP # IOR SBIT SET 'RECEIVE' INDICATOR JSB TRACE # LDB EQT1 # JSB TRACE # LDB $TIME # JSB TRACE # XIF # * * 'STOP' RECEIVED EXIT * ERR.4 EQU * LDB #MEAB INDICATE MESSAGE ABORTED @ SKP * * HERE TO TERMINATE * CEND JSB STAT UPDATE EQT 5 STATUS LDA EQT12,I GET CARD STATUS WORD AND .020 IS IT LISTEN MODE? SZA,RSS JMP CLCRD NO, CLEAR CARD & EXIT JSB TRAPR SET UP TRAP CELL & ENABLE 1 WORD READ LDA LSTNI GET LISTEN INTERRUPT JMP CEXT2 AND LEAVE * * HERE TO DO CONTINUATION RETURN * CEXIT NOP LDA CEXIT GET NEXT INTERRUPT ADDRESS CEXT1 ISZ CA65 BUMP CONTINUATOR RETURN CEXT2 STC 0,C SET FOR RECEIVE MODE CEXT3 STA EQT11,I SAVE NEW INTERRUPT LOCATION CLA # LDB SETIO CPB I65AD WAS THIS ENTRY VIA INITIATOR? JMP IATST YES, MUST CHECK FURTHER @ LDB EQT6,I GET DATA LENGTH IN CASE IT'S COMPLETION JMP CA65,I RETURN * I65AD DEF SERET * IATST LDA EQT5,I WAS THIS ENTRY DUE TO THE SIXTH @ AND B362 REQUEST ENTRY WHEN THERE @ CPA #LFAL WAS A BAD LINE? > @ JMP IMXIT+1 YES, EXIT # CLA NO, INDICATE OPERATION STARTED @ JMP IA65,I AND EXIT @ * * * SUBROUTINE TO PUT NEW STATUS INTO EQT WORD 5 * STAT NOP LDA EQT10 STA EQT15 FOOL RTE SO IT LEAVES TIMEOUT ALONE LDA EQT5,I GET OLD STATUS AND CLRST KEEP WRITE BIT(#12) & BITS 15-8 @ IOR B STUFF IN NEW STATUS @ IOR MOOD MUST INDICATE DRIVER'S MOOD (BIT#3) @ STA EQT5,I STATUS IS COMPLETE! @ JMP STAT,I RETURN SKP * * ROUTINE TO DO CHECKING OF INPUT DATA * * CALLING SEQUENCE: * * IF 'TRACE' MODE, LOAD (A) WITH DRIVER STATE NUMBER * JSB CHECK * WILL RETURN P+1 TIME OUT * P+2 STOP RECEIVED * P+3 REQUEST COMING RECEIVED * P+4 NORMAL RETURN...B REG= LAST DATA WORD * CHECK NOP LDB EQTX EQT EXTENSION ADDRESS INB LDB B,I LOAD LAST WORD RECEIVED IFZ STA STATE SAVE (TRACE VERSION ONLY) # XIF LDA EQT4,I WAS THIS ENTRY # AND .040 VIA # SZA TIME-OUT? # JMP LIAC1 YES, DATA IN (B) # * * THERE WAS NO TIMEOUT. CLEAR 'COUNT' WORD * SO WE DON'T THINK THERE WAS A TIME-OUT, * DISABLE CARD, AND PICK UP DATA DIRECTLY FROM * INTERFACE CARD. * STA COUNT CLCC1 CLC 0,C LIB1 LIB 0 LIAC1 LIA 0,C CLEAR CARD STATUS. # IFZ # CH.00 NOP CHANGED TO 'RSS' WHEN TRACING IS ENABLED # JMP CHEC0 SKIP OVER 'TRACE' CODE WHEN NOT ENABLED # * STB RDD.C SAVE FOR JUST A SECOND # JSB CKTRC SHOULD WE TRACE THIS ONE? & # JMP CHEC. NO, DON'T TRACE THIS ONE. # * LDB RDD.C RECOVER RECEIVED WORD # JSB TRACE STORE IN TRACE TABLE # LDB STATE RECOVER DRIVER STATE # RBL MOVE TO 'STATE' FIELD # LDA COUNT WAS THERE A # CCE,SZA A TIME-OUT? # INB # RBL,ERB AND SET 'RECEIVE' INDICATOR BIT # JSB TRACE STORE TRACE/EVENT # LDB EQT1 STORE EQT ADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # * # CHEC. LDB RDD.C RECOVER RECEIVED DATA WORD # CHEC0 EQU * # XIF LDA COUNT MICROCODE COUNT # CLE,SZA,RSS DID MICROCODE FINISH? # JMP CHEC1 YES. # LDA EQT4,I NO. CHECK FOR POSSIBLE RTE TIME-OUT # AND .040 ISOLATE T.O. BIT # SZA TIME-OUT? # JMP CHECK,I YES, TAKE TIME-OUT RETURN # SPC 2 * * CHEC1 ISZ CHECK SET FOR 'STOP' RETURN # CPB STOP 'STOP'? # JMP CHECK,I YES...TAKE 'STOP' RETURN # ISZ CHECK # CPB RC REQUEST COMING? # JMP CHECK,I YES # ISZ CHECK SET "NONE OF THE ABOVE" RETURN # JMP CHECK,I RETURN # SKP * ROUTINE TO CLEAR CARD RDD.C NOP CLCC2 CLC 0,C LIAC2 LIA 0,C CLEAR STATUS LIA2 LIA 0 READ DATA WORD CLA JMP RDD.C,I * * HERE TO SEND WORD AND EXIT IN TRANSMIT MODE XMITX NOP JSB OUTPB SEND WORD JSB TRAPR SETUP TRAP CELL STC0 STC 0 SET TRANSMIT MODE LDA XMITX COROUTINE UPON RETURN ISZ CA65 BUMP CONTINUATION RETURN JMP CEXT3 @ * @ * BAD LINE, SET A 5 SECOND TIMEOUT IN HOPES THAT IT WILL BE FIXED @ DEXIT LDA EQT12,I NOW DISABLE @ AND CLR10 LISTEN @ STA EQT12,I MODE @ LDA N500 THEN GIVE THE LINE @ STA EQT15,I 5 SECONDS TO CLEAR UP @ LDB #LFAL FINALLY SET THE STATUS @ JSB STAT TO REFLECT A BAD LINE @ ISZ CA65 SET UP @ LDA TMAD EXIT VARIABLES @ JMP CEXT3 THEN WAIT FOR 5 SECONDS @ * TMUP LDA EQT12,I 5 SECONDS IS UP @ IOR .020 RESET LISTEN MODE @ AND B1776 CLEAR BROKEN LINE COUNTER/FLAG @ STA EQT12,I AND SET THE STATUS @ LDA EQT5,I TO REFLECT A GOOD (?) @ AND CLR41 LINE CONDITION @ STA EQT5,I THEN CONTINUE AS IF @ JMP ILSN4 NOTHING HAD HAPPENED @ * @ * SOMEBODY IS ATTEMPTING A NEW REQUEST WHILE A BAD LINE IS INDICATED. # BDLNE LDA N100 MUST RESET THE TIMEOUT TO 1 SEC @ STA EQT15,I THEN A COUNTER CAN BE CHECKED AND IF @ LDA EQT12,I THE THIS CODE HAS BEEN EXECUTED @ INA 5 TIMES THE LINE CAN BE RE-ENABLED @ STA EQT12,I  @ AND B7 WANT ONLY BITS 2-0 @ CPA B6 FIFTH TIME (5X1 SEC = 5 SEC) @ JMP LNUP YES, RE-ENABLE THE LINE @ * CLB # LDA CHKIN IF THE ENTRY TO 'BDLNE' WAS # CPA CKRTN FROM CONTROL REQUEST PROCESSING PATH, # STB EQT6,I THEN FORCE RETURN OF 0 TRANS. LOG. # LDB #LFAL SET STATUS AND TAKE THE # JMP IMXIT INITIATOR ERROR EXIT. # * LNUP JSB RDD.C CLEAR THE I/O CARD. # JSB TRAPR SET UP TRAP CELL & ENABLE 1 WORD READ. # LDA LSTNI ESTABLISH THE VECTOR # STA EQT11,I FOR LISTEN MODE INTERRUPTS. # LDA EQT5,I CLEAR THE ERROR STATUS BITS # AND CLRST TO ALLOW PROPER RETURN # STA EQT5,I AT 'IATST' (INITIATOR EXIT). # * LDA EQT12,I RESTORE # IOR .020 LISTEN MODE # AND B1776 AND CLEAR BROKEN LINE COUNTER # STA EQT12,I IN THE EXTENDED STATUS WORD. # JMP CHKN0 CONTINUE CURRENT REQUEST (A=EQT12). # * SPC 5 OUTPB NOP SEND WORD IN TO I/O XMIT REGISTER. # IFZ OTB2 NOP 'RSS' WHEN TRACE MODE IS ENABLED # JMP OTB1 RETURN IMMEDIATELY IF TRACE DISABLED. # STB RDD.C SAVE (B) FOR A FEW LINES.... # JSB CKTRC SHOULD WE BE TRACING THIS ONE? # JMP OTB3 NO, DON'T TRACE THIS ONE. # LDB RDD.C RECOVER (B) REGISTER # JSB TRACE STORE OUTPUT WORD # RAL MOVE TO 'STATE' FIELD # LDB A LOAD EVENT # JSB TRACE STORE EVENT IN TRACE TABLE # LDB EQT1 STORE EQT LADDRESS # JSB TRACE # LDB $TIME STORE TIME # JSB TRACE # OTB3 EQU * # LDB RDD.C RECOVER DATA TO BE TRANSMITTED # XIF OTB1 OTB 0 JMP OUTPB,I RETURN SKP *############################################################################ * * TRACE SECTION * * TRAC.-- SECTION TO SET UP TRACE BUFFER. * IFZ TRAC. EQU * LDA EQT7,I GET TRACE BUFFER ADDRESS STA NPASS SAVE ADDRESS OF PASS COUNT STA B COMPUTE ADDRESS ADB EQT8,I OF END OF BUFFER + 1 STB TRACL SAVE ADDRESS OF END OF BUFFER INA GET ADDRESS OF 2ND WORD OF TRACE BUFFER STA TRPTR STORE POINTER TO NEXT AVAILABLE LOCN INA BUMP TO START OF TRACE BUFFER STA TRACB SAVE TRACE BUFFER LDB EQT9,I GET TRACE SELECTION SZB TRACE ALL? LDB EQT1 NO, TRACE ONLY THIS LU STB TREQT SAVE TRACE EQT, OR ZERO FOR ALL LDB EQT10,I LOAD RESOURCE NUMBER STB RN# SAVE IT. SPC 2 * ENABLE TRACE MODE. * ETRAC EQU * CHECK THAT BUFFER HAS BEEN DEFINED CLB,INB LDA TRACB LOAD BUFFER ADDRESS SZA,RSS WAS ONE DEFINED? JMP REJCT NO, THIS IS AN ERROR STA TRACN YES, INITIALIZE "NEXT" TRACE ENTRY PNTR LDA RSS STORE 'RSS' INSTRUCTION IN ALL TRA.3 EQU * "BYPASS TRACE CODE" PLACES. STA OTB2 STA CH.00 STA CH.01 * * "IMMEDIATE COMPLETION" RETURN TO RTIOC * LDA B4 CLB # JMP IA65,I RETURN TO RTE SPC 2 * DISABLE TRACE MODE * DTRAC EQU * CLA STORE 'NOP' INSTRUCTION IN ALL "BYPASS TRACE JMP TRA.3 CODE" PLACES. ^ * * SUBROUTINE TO CHECK WHETHER WE SHOULD BE * TRACING THIS ENTRY OR NOT. * CKTRC NOP LDB TREQT LOAD THE 'TRACE' EQT SZB TRACE ALL? CPB EQT1 NO, COMPARE TO THIS EQT ISZ CKTRC WE'RE TRACING THIS ONE! JMP CKTRC,I RETURN TO CALLER SKP * * TRACE -- SUBROUTINE TO MAKE AN ENTRY IN THE TRACE TABLE * * CALLING SEQUENCE: * LDB * JSB TRACE * * TRACE NOP ENTRY/EXIT STB TRACN,I STORE DATA IN TRACE BUFFER LDB TRACN ADVANCE TO NEXT ENTRY, OR INB CPB TRACL END? JMP TRAND YES, RESET TO START & UNLOCK RN TRA.1 EQU * STB TRACN STORE "NEXT" ENTRY POINTER CMB,INB COMPUTE RELATIVE OFFSET ADB TRACB SO BACKGROUND PROGRAM CMB,INB STB TRPTR,I KNOWS WHERE WE ARE. JMP TRACE,I RETURN TO CALLER SPC 2 TRAND EQU * LDA RN# LOAD RESOURCE NUMBER JSB $CGRN UNLOCK RESOURCE NUMBER ISZ NPASS,I BUMP PASS NUMBER NOP PROTECT AGAINST ROLLOVER. LDB TRACB JMP TRA.1 RETURN TO MAIN FLOW * * STORAGE FOR 'TRACE' * STATE NOP STORAGE FOR DRIVER STATE TREQT NOP EQT ADDRESS TO BE TRACED, OR 0 FOR ALL OF THEM TRPTR NOP STORAGE FOR ADDRESS OF "NEXT" ENTRY IN BUFFER NPASS NOP ADDRESS OF NUMBER OF PASSES COUNTER RN# NOP RESOURCE NUMBER TRACB NOP POINTER TO START OF TRACE BUFFER TRACN NOP POINTER TO NEXT TRACE TABLE ENTRY TRACL NOP POINTER TO END OF TABLE + 1 B11 OCT 11 B13 OCT 13 B14 OCT 14 B15 OCT 15 B16 OCT 16 B21 OCT 21 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 B27 OCT 27 B30 OCT 30 B31 OCT 31 B32 OCT 32 B33 OCT 33 B34 OCT 34 # B700 OCT 700 B703 OCT 703 B1700 OCT 1700 B1703 OCT 1703 RSS RS<S 'RSS' INSTRUCTION SBIT OCT 100000 SIGN BIT XIF *######################################################################## SKP SETIO NOP LDA EQT12,I EQT STATUS AND MICFG CLEAR MICROCODE R/W & RETRY FLAGS STA EQT12,I UPDATED EQT LSR 4 SINCE EQT12 CONTAINS THE MODE @ AND B10 BIT, ISOLATE IT AND PUT IT IN @ STA MOOD BIT 3 FOR THE STATUS @ LDB EQT2,I GET WORD #2 OF EQT ENTRY. # CLA SSB SYSTEM TRYING TO INITIATE NEW REQUEST? # CCA YES, SET A TICK. # STA EQT15,I SET TIMEOUT LDB EQT13,I STB EQTX SAVE ADDRESS OF EQT EXTENSION ADB B6 POINT TO EXT(6) @ LDA B,I GET THE LU NUMBER @ STA LU AND SAVE IT FOR LATER USE @ LDA EQT4,I AND B77 ISOLATE SELECT CODE STA CELL SAVE FOR TRAP CELL ADDR IOR CLCC CLC0,C COMMAND STA CLCC1 STA CLCC2 XOR .040 CONVERT TO STC 0,C COMMAND STA LISTI STA CEXT2 XOR .010 CONVERT TO STC 0 COMMAND STA STC0 XOR B200 CONVERT TO LIA COMMAND STA LIA2 XOR .010 CONVERT TO LIA 0,C COMMAND STA LIAC1 # STA LIAC2 XOR .050 CONVERT TO LIB COMMAND STA LIB1 XOR B300 CONVERT TO OTB 0 COMMAND STA OTB1 JMP SETIO,I RETURN SKP @ * @ * CONSTANTS AND OTHER IMPORTANT THINGS @ * @ B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B10 OCT 10 B12 OCT 12  T B17 OCT 17 B20 OCT 20 B22 OCT 22 @ B42 OCT 42 @ B62 OCT 62 @ B77 OCT 77 B100 OCT 100 B102 OCT 102 @ B122 OCT 122 @ B200 OCT 200 B202 OCT 202 @ B222 OCT 222 B242 OCT 242 B300 OCT 300 B362 OCT 362 @ B377 OCT 377 @ B1770 OCT 177000 @ B1774 OCT 177410 B1776 OCT 177600 * @ B3003 OCT 3003 INITIALIZE @ B3103 OCT 3103 CLEAR REQUEST @ B3203 OCT 3203 DS MODE @ B3303 OCT 3303 NON-DS MODE @ B3703 OCT 3703 REQUEST CODE MASK @ * BSTMK OCT 12300 @ CLR7 OCT 177577 @ CLR9 OCT 176777 CLR10 OCT 175777 @ CLR11 OCT 173777 CLR41 OCT 177755 @ CLRST OCT 177404 CLEAR STATUS BITS AND KEEP BIT#2(WRITE)# MICFG OCT 117777 NMSK OCT 13300 @ SCODE OCT 70736 @ * RC OCT 170017 REQUEST COMING TNW OCT 170360 TRANSMIT NEXT WORD STOP OCT 7760 SEND STOP RLW OCT 7417 RETRANSMIT LAST WORD RLM OCT 170377 RETRANSMIT LAST MESSAGE SKP .010 OCT 1000 .020 OCT 2000 @ .022 OCT 2200 .040 OCT 4000 .050 OCT 5000 .100 OCT 10000 .200 OCT 20000 .300 OCT 30000 .400 OCT 40000 * N2 DEC -2 ф @ N3 DEC -3 @ N100 DEC -100 @ N500 DEC -500 @ * @ QUEUE ASC 3,QUEUE @ * LU NOP LOGICAL UNIT NUMBER @ LEN1 NOP DATA LENGTH @ LEN2 NOP REQUEST LENGTH @ MOOD NOP MODE INDICATOR (IF DS THEN MOOD=0) @ TEMP NOP TYPE NOP INDICATES ACTION TO BE TAKEN BY QUEUE@ MIC$X NOP OPEN LOOP MICRO-PROGRAM CALL COUNT NOP EQTX NOP * CLCC CLC 0,C MXMIC OCT 105520 FOR MX FIRMWARE XEMIC OCT 105300 FOR ME FIRMWARE * LSTNI DEF ILSTN TMAD DEF TMUP @ * @ *ERROR CODES @ * MNEMONIC REASON SETS BITS @ * @ #LFAL EQU B22 LINE FAILURE 4,1 @ #TMOT EQU B42 TIME OUT 5,1 @ #LBUS EQU B62 LOCAL BUSY 5,4,1 @ #MEAB EQU B102 MESSAGE ABORTED 6,1 @ #RBUS EQU B122 REMOTE BUSY 6,4,1 @ #NOIN EQU B202 DVA65 NOT INITIALIZED 7,1 @ #WRMD EQU B222 WRONG MODE 7,4,1 @ #ILRQ EQU B242 ILLEGAL REQUEST 7,5,1 @ #BDIN EQU B362 UNKNOWN INTERRUPT 7,6,5,4,1 @ * * BSS 0 SEE HOW BIG IT IS SKP * * DEFINE BASE PAGE LOCATIONS NEEDED * * * . EQU 1650B EQT1 EQU .+8 EQT2 EQU .+9 # EQT4 EQU .+11 EQT5 EQU .+12 EQT6 EQU .+13 EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 DUMMY EQU 1737B TBG EQU 1674B * A EQU 0 B EQU 1 END z /'W 91750-18107 2013 S C0122 &DVA66              H0101 v[ASMB,Q,R,C HED * DVA66 91750-18107 REV.2013 NAM DVA66 91750-16107 REV.2013 800724 (IV, M) EXT $LIST ENT IA66,CA66 SPC 2 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: DVA66 * SOURCE: 91750-18107 * RELOC: 91750-16107 * PGMR: JOHN LAMPING * * WRITTEN BY JOHN LAMPING [FEBRUARY 1979] * * 21MX PSI DS/1000 DRIVER * * NOTE: WHENEVER KNOWLEDGE OF THE BIT POSITION OF A FLAG IS USED * BUT NO REFERENCE TO THE FLAG WOULD OTHERWISE BE GENERATED, * THE LABEL OF THE FLAG IS DOUBLE REFERENCED. ( +FL-FL ) SPC 2 ************************************************** * * * SYSTEM SECTION * * * ************************************************** SPC 2 **** **** * *** ENTRY PART: HANDLE DRIVER ENTRY *** * **** **** SPC 1 * * DO CONFIGURATION OF DRIVER * IA66 NOP CLB GET INITIATE FLAG JMP S1A CA66 NOP CCB GET NO INITIATE FLAG S1A STB ENTRY RECORD WHERE WE CAME FROM LDB SCTPT CONFIGURE CARD I/O JSB IOCON INSTRUCTIONS LDA EQT2,I IS A CCB DEFFERRED ENTRY SSA PENDING? STB EQT15,I YES, RESTORE TIMEOUT LDA EQT13,I GET EQT EXTENSION ADDRESS CPA XTBEG ALREADY POINTING THERE? JMP S1A2 YES, BE LAZY LDB MXTLN _ NO, GET NUMBER OF WORDS STB TEMP1 WE MUST SET LDB XTPTR GET POINTER TO FIRST S1A1 STA B,I CONFIGURE WORD INA ADVANCE INB POINTERS ISZ TEMP1 DONE? JMP S1A1 NO, WORK SOME MORE S1A2 CLA CLEAR STA SSERV DRIVER STA ACTIV STATUS STA TGONE TEMPORARY STA RENTR VARIABLES STA SCCLF STA SRVOK LDB INTBA FIND INB WHICH STB TEMP1 DCPC LDB EQT1 CHANNEL CPB INTBA,I WE LDA .6 HAVE CPB TEMP1,I IF LDA .7 ANY LDB EQT12,I CHECKING CPB INTBA,I BOTH LDA .6 EQT'S CPB TEMP1,I LDA .7 STA DCHAN RECORD IT LDB DCTPT GET DCPC INSTRUCTIONS POINTER SZA DO WE HAVE DCPC? JSB IOCON YES, CONFIGURE DCPC INSTRUCTIONS * * HANDLE FIRST DRIVER ENTRY * LDA EQT4,I HAVE WE BEEN ON THIS EQT BEFORE ALF,SLA (DRIVER PROCESSES TIMEOUT BIT SET)? JMP S1C YES LDA EQT12,I NO, IS THE EQT EXTENSION ADA MXTLN OF THE RIGHT SIZE? CCE,SZA,RSS JMP S1B YES, PROCEED LDA .3 NO, DO ERROR ISZ CA66 OR CONTIUNE JMP EXIT7 RETURN S1B STA FBITS,I CLEAR ALL FLAGS LDA EQT4,I TELL SYSTEM THAT IOR B30K WE CAN HANDLE STA EQT4,I TIMEOUT AND POWER-FAIL LDA RINIA SET STA RCONT,I PROCESS LDA WINIA RESTART STA WCONT,I ADDRESSES LDB EQT1 PUT IN OUR ADB .15 LINK TO THE STB EQT12,I OTHER EQT ADB .3 SET DRIVER LDA B,I PROCESSES TIMEOUT IOR B30K AND POWERFAIL STA B,I l IN OTHER EQT ADB .8 MAKE OTHER LDA EQT1 EQT POINT STA B,I TO US INB MAKE HIM LDA EQT13,I HAVE OUR STA B,I EXTENSION * * DETERMINE TYPE OF ENTRY, HANDLE IT * S1C LDA ENTRY ENTRY THROUGH SZA,RSS IA66? JMP S1C2 YES LDA EQT4,I NO, DID AND MB4K1 TIMEOUT CPA EQT4,I OCCUR JMP S1C1 NO * * HANDLE TIMEOUT * STA EQT4,I YES, CLEAR TIMEOUT FLAG LDA FBITS,I MEDIUM ALF,ALF LENGTH RAL,SLA TIMEOUT? ISZ TGONE+MT-MT YES, FLAG IT CMA,SSA,SLA MEDIUM OR SHORT TIMEOUT? RAR,SLA NO, LONG TIMEOUT CLEAR? JMP INIT YES, HANDLE NORMALLY JMP SICK+ST-ST+LT-LT NO, BAD TROUBLES MB4K1 ABS -4000B-1 MB36 OCT -36 * * HANDLE CONTINUE ENTRY * S1C1 LDA FBITS,I HAS THE LINE BEEN AND BUSYB CONNECTED SZA,RSS OR ARE WE TRYING? JMP EXIT NO, IGNORE INTERRUPT SC101 STF SCODE PUT BACK FLAG JMP CONTN PROCESS THIS INTERRUPT S1C2 LDA EQT5,I WAS INITIATE ENTRY SSA REALLY POWER-FAIL? JMP PFAIL YES, THE CARD WILL INFORM US SPC 1 **** **** * *** COMMAND PART: IDENTIFY AND VERIFY COMMAND *** * **** **** LDA EQT6,I GET REQUEST AND B7703 ISOLATE FUNCTION/SUBFUNCTION CPA .3 CLEAR REQUEST? JMP S2B YES LDB EQT11,I ALREADY DOING A SZB COMMAND ON THIS EQT? JMP S2A14 YES, RTE IS GIVING US DCPC RRR 6 ISOLATE FUNCTION CODE BLF,RBL IS REQUEST TYPE SSB,SLB,RSS CONTROL REQUEST? JMP S2A1 NO, READ OR WRITE ADA MB36 YES, IS FUNCTION CODE SSA,RSS UNDER 36B? JMP S2A9 8NO, INDICATE IF LINK IS UP ADA .6 YES, IS IT SSA UNDER 30B? JMP S2A6 YES, ILLEGAL LDB EQT7,I GET OPTIONAL PARAMETER ARS IS REQUEST SET DS/NON-DS MODE? SZA OR SET/CLEAR FRONT PANEL WAIT CPB FNMBR YES, IS SECURITY CODE WRONG? CCB,RSS NO, ALL IS COOL, GET PHONY MESSAGE TYPE JMP S2A6 YES, DUMP THIS DUDE S2A13 LDA .2 JMP S2A4 SET WRITE FLAG S2A1 AND B77 GET MESSAGE TYPE AND DIRECTION LDB A SAVE IT ARS GET JUST TYPE CPA B17 READ/WRITE SPECIAL DATA? JMP S2A13 YES CPA .3 BREAK FRAME SLB,RSS DATA TYPE WRITE? JMP S2A11 NO LDA FNMBR YES, CHECK FIRST CPA EQT9,I PARAMETER FOR SECURITY CODE CCE,RSS RIGHT JMP S2A6 WRONG! LDA FMISC,I GET OUR AND LUB LU TIMES 32 ALF,ELA PLUS 1 CPA EQT10,I EQUAL TO SECOND PARAMETER? JMP S2A12 YES, PROCEED JMP S2A6 NO, NO FOOLING US S2A11 SZA DS 1 CPA B10 MESSAGE RSS TYPE? JMP S2A10 NO LDA EQT6,I YES, ELA,ALF CLASS I/O ERA AND DOUBLE SSA,SLA,RSS BUFFERED? JMP S2A6 NO, ERROR LDA EQT10,I YES, SECOND BUFFER ADA M2 AT LEAST SSA TWO WORDS? JMP S2A6 NO, ERROR CCA YES, ADA EQT10,I POINT TO ADA EQT9,I LAST WORD STA TEMP1 SAVE POINTER LDA FMISC,I GET AND LUB LU XOR TEMP1,I MERGE INTO SLB LAST WORD OF BUFFER AND B777 UNLESS IT IS A READ XOR TEMP1,I IN WHICH CASE JUST STORE STA TEMP1,I STUFF IT CLA RESTORE TYPE S2A10 ADA M5 IS TYPE SSA,RSS TOO BIG? ǧJMP S2A6 YES, ERROR S2A12 CLA,INA SLB,RSS IS REQUEST A READ? JMP S2A4 YES LDA FBITS+ND-ND,I NO, WRITE, ALF GET NON DS ALLOWED IOR FBITS+FW-FW,I IN SIGN BIT RBR,RBR DS 1 OR DS 2 CMB,SSB,SLB MESSAGE TYPE? CMA YES SSA,RSS MODES MATCH? JMP S2A5 NO, ERROR LDA .2 GET WRITE FLAG LDB FBITS+AC-AC,I ARE WE BLF,SLB INITIALIZED? JMP S2A4 YES LDA #NOIN NO, STOP THIS JMP S2A7 IMPOSTOR S2A4 STA EQT11,I INDICATE WHO DOES THIS COMMAND RAL,RAL POSITION FLAG IOR FBITS+WP-WP,I SET COMMAND PENDING FLAG CPA FBITS,I REQUEST ALREADY PENDING? JMP S2A8 YES, REJECT THIS ONE STA FBITS,I SET PENDING FLAG S2A14 LDA EQT11,I INDICATE ONLY COMPLETIONS STA SRVOK ON THIS EQT ARE ALLOWED JMP INIT ENTER MAIN CODE S2A8 LDA #LBUS LOCAL BUSY ERROR SAYS JMP S2A7 TOO MUCH TO HANDLE S2A9 LDA FBITS,I DETERMINE WHTEHER WE AND M4B ARE READY FOR A DS 1 MESSAGE LDB WBUFS,I HAVE WE GIVEN UP CPB M1 ON GETTING A BUFFER? CLA YES, NOT READY CPA LCRCB OTHERWISE READY? CLA,RSS YES, GOOD STATUS S2A5 LDA #WRMD WRONG MODE ERROR RSS S2A6 LDA #ILRQ GET ILLEGAL REQUEST STATUS S2A7 CLB SAY CURRENT STB ACTIV EQT JSB STAT SET STATUS CCA SET COMPLETION STA SSERV FLAG JMP EXIT GO RESTORE TIMEOUTS .15 DEC 15 B17 EQU .15 B7703 OCT 7703 B777 OCT 777 * * HANDLE CLEAR (ABORT) REQUESTS * S2B LDA FBITS,I GET FLAGS WORD LDB EQT11,I SET PROPER IOR B+WA-WA REQUEST ABORTED BIT CMB REQUEST STB SSERV COMPLETION RBL,RBL CLEAR PROPER AND B+WP-WP REQUEST PENDING BIT STA FBITS,I SAVE NѽEW FLAGS JMP INIT ENTER MAIN CODE * * PUT INFORMATION ON COMMAND FOR ACTIVE PROCESS IN TEMP1 : TEMP4 * NO SKIP RETURN IF REQUEST HAS BEEN ABORTED * SKIP RETURN WITH TEMPS VALID IF REQUEST STILL PENDING * CMDAT NOP LDA ACTIV HAS AND FBITS+WA-WA,I REQUEST BEEN SZA ABORTED? JMP CMDAT,I YES, NO SKIP RETURN ISZ CMDAT NO, PREPARE SKIP RETURN LDA ACTIV MAKE SURE WE HAVE JSB EQTST THE CORRECT COMMAND LDB EQT8,I GET LENGTH STB TEMP3 OF FIRST BUFFER LDB EQT7,I GET POINTER STB TEMP2 TO BUFFER LDA EQT6,I GET REQUEST ALF,ALF ARE BITS RAR,RAR NINE AND TEN SSA,SLA,RSS SET? JMP CMDA1 NO, MUST BE READ OR WRITE ALF ISOLATE OPTION PART AND .7 OF FUNCTION CODE CMA MAKE NEGATIVE FOR COMMAND TYPE LDB EQT9,I GET OPTIONAL PARAMETER JMP CMDA2 CMDA1 SLA,RSS ARE WE TO IGNORE FIRST BUFFER? JMP CMDA3 NO CLB YES, SET LENGTH STB TEMP3 TO ZERO LDB EQT9,I SET POINTER STB TEMP2 TO SECOND BUFFER CMDA3 ALF,RAR GET BITS 9, 8, AND 7 OF FUNCTION CODE AND .7 WHICH ARE MESSAGE TYPE LDB EQT10,I GET LENGTH OF SECOND BUFFER ADB M2 WITHOUT LU WORD SZA DS 1 MESSAGE TYPE? CLB NO, IGNORE SECOND BUFFER CMDA2 STB TEMP4 STORE SECOND LENGTH / OPTIONAL PARAMETER STA TEMP1 STORE MESSAGE TYPE / COMMAND JMP CMDAT,I THAT'S ALL FOLKS SPC 1 **** **** * *** EXIT PART: LEAVE DRIVER, REQUEST / RELEASE RESOURCES *** * **** **** EXIT LDA EQT12,I SEE IF INA RTE IS ABOUT LDA A,I TO ENTER US IOR EQT2,I WITHo A DEFFERRED SSA,RSS ENTRY JMP EXIT1 NO LDA FBITS,I YES, CLEAR ALL AND XTNB TIMEOUTS STA FBITS,I CCB SAY DON'T SET TIMEOUTS JMP EXIT2 EXIT1 LDA FBITS,I GET TIMEOUT FLAGS CLB RAL,RAL RECONNECT AFTER SLA,ALF POWER FAIL? LDB VLONG+RC-RC YES SET A TIMEOUT RAL,RAL LONG SLA TIMEOUT? LDB LONG+LT-LT YES RAL,SLA MEDIUM TIMEOUT? LDB MDIUM+MT-MT YES RAL,SLA SHORT TIMEOUT? LDB SHORT+ST-ST YES EXIT2 STB TEMP1 SAVE TIMEOUT VALUE LDA SSERV DO WE NEED TO ASK FOR SZA SYSTEM SERVICE? JMP EXIT8 YES LDA SRVOK NO, MAKE SURE THE EQT JSB EQTST IS SET BACK UP IF ENTERED AT I.66 CLA DO CONTINUE RETURN JMP EXIT4 EXIT8 SSA,RSS DO WE ASK FOR DCPC? JMP EXIT3 YES CMA NO, SET UP JSB EQTST RIGHT EQT QUEUE LDB EQT5,I GET STATUS LDA EQT6,I IS REQUEST IOR B100 A WRITE CPA EQT6,I REQUEST? ADB .4 YES, SET NOT READ BIT AND B600 IS REQUEST SZA NON-DS? ADB .8 YES, SET NON-DS BIT STB EQT5,I SET STATUS CLB CLEAR SERVER PROCESS FLAG STB EQT11,I IN EQT LDA .4 GET COMPLETION RETURN CODE JMP EXIT5 GO DO COMPLETION RETURN EXIT3 CPA .8 RETURN DCPC? JMP EXIT9 YES JSB EQTST GET CORRECT EQT LDA .5 ASK FOR DCPC RSS EXIT9 LDA .6 RELEASE DCPC ISZ CA66 DCPC EXIT EXIT4 ISZ CA66 CONTINUE EXIT EXIT5 LDB EQT12,I POINT TO TIMER WORD ADB .14 OF OTHER EQT STB TEMP2 LDB TEMP1 GET TIMEOUT VALUE CMB,SSB,INB,RSS MAKE NEGATIVE JMP EXIT0 NOT SUPPOSSED TO SET TIMEOUT STB TEMP2,I SET TIMEOU T CLB SAY NO TIMEOUT ON STB EQT15,I CURRENT EQT EXIT0 LDB EQT5,I RECORD IF THIS RBR,RBR IS A ERB READ LDB RLEN1,I GET POSSIBLE TRANSMISSION LOG SEZ,RSS WRITE OR SZB,RSS DS 1 READ? LDB EQT8,I YES, USE REQUEST LENGTH EXIT7 ISZ ENTRY GO OUT THE WAY JMP IA66,I WE CAME IN CPA .4 TRANSFORM COMPLETION CLA REQUEST JMP CA66,I .14 DEC 14 SPC 1 * * SET UP EQT SERVED BY PROCESS INDICATED BY A * EQTST NOP SZA DO WE WANT THE CURRENT EQT? CPA EQT11,I OR DO WE HAVE THE RIGHT EQT? JMP EQTST,I YES, NOTHING TO DO LDA EQT12,I SET UP POINTERS LDB M15 TO OTHER EQT STB TEMP2 LDB EQT1A EQTS1 STA B,I INA INB CPB EQ111 LDB EQ12A ISZ TEMP2 JMP EQTS1 JMP EQTST,I WE ARE DONE * M15 DEC -15 EQT1A DEF EQT1 EQ111 DEF EQT11+1 EQ12A DEF EQT12 * * CONFIGURE I/O INSTRUCTIONS * IOCON NOP XOR B,I COMPUTE DIFFERENCE WITH OLD CODE SZA,RSS ARE WE ALREADY CONFIGURED RIGHT? JMP IOCON,I YES, NOTHING TO DO STA TEMP1 NO, SAVE DIFFERENCE IOCO1 LDA B,I GET WORD TO CONFIGURE CPA M1 END OF LIST? JMP IOCON,I YES, DONE XOR TEMP1 NO, SET NEW VALUE STA B,I OF WORD INB MOVE TO NEXT WORD JMP IOCO1 * * SET STATUS OF REQUEST ON ACTIVE PROCESS * STAT NOP ALF SET STATUS IN SZA PROPER ADA .2 FORM STA IOCON SAVE IT LDA ACTIV HAS REQUEST AND FBITS+WA-WA,I BEEN SZA ABORTED? JMP STAT,I YES, DO NOTHING LDA ACTIV GET RIGHT JSB EQTST EQT LDA EQT5,I UPDATE AND MB400 STATUS IOR IOCON STA EQT5,I  JMP STAT,I ALL DONE SKP ************************************************** * * * READ SECTION * * * ************************************************** SPC 2 **** **** * *** PART -1: SEVERE ERROR RECOVERY *** * **** **** RSER EQU * LDA FBITS,I IS A AND RPB READ REQUEST SZA,RSS PENDING? JMP RINI NO JSB COMPL YES, COMPLETE IT LDA #SERR DECLARE A SEVERE JSB STAT ERROR SPC 1 **** **** * *** PART 0: INITIALIZE FOR READING *** * **** **** RINI CLA SAY NO FRAME STA RDSIZ,I PENDING SPC 1 **** **** * *** PART 1: WAIT FOR FRAME *** * **** **** R1 LDA M10 SET TIMEOUT STA RPTRY,I COUNTER R1A LDA FMISC,I NEED TO TELL AND CIB HIGHER LEVELS ABOUT SZA CONNECT? JMP R2D YES LDA RDSIZ,I FRAME SZA READY? JMP R2 YES LDA FBITS,I NO, CLEAR ERA,CLE,ELA READ ABORTED BIT STA FBITS+RA-RA,I JUST IN CASE AND RPNB READ CPA FBITS,I PENDING? JMP R1D NO AND ACB YES, ARE WE AUTHORIZED SZA,RSS TO CONNECT? JMP R1B NO, ERROR JSB CMDAT GET READ'S NOP LDA TEMP1 MESSAGE TYPE CPA .4 DS 2 TYPE? JMP R1D YES, DON'T TIME HIM LDA TGONE DID A SZA TIMEOUT OCCUR? ISZ RPTRY,I YES, TOO MANY? JMP R1C NO LDA #TMOT YES, BOUNCE THIS RSS REQUEST WITH TIMEOUT R1B LDA #NOIN NOT INITIALIZERDD JSB STAT INDICATE ERROR JSB COMPL DUMP REQUEST JMP R1 TRY AGAIN R1C LDA FBITS,I REQUEST IOR MTB TIMEOUT STA FBITS,I R1D JSB SUSP WAIT JMP R1A SEE WHAT HAPPENED M10 DEC -10 SPC 1 **** **** * *** PART 2: DETERMINE MESSAGE PARAMETERS *** * **** **** R2 LDA FMISC,I IS MESSAGE AND TRB TYPE SZA,RSS DS 1? JMP R2A YES LDA RDSIZ,I NO, FIRST BUFFER STA RLEN1,I LENGTH IS FRAME SIZE CLA SECOND BUFFER LENGTH IS ZERO JMP R2E * * DS MESSAGE, GET TOTAL LENGTHS FROM FIRST TWO WORDS * R2A JSB LOCK GRAB BACKPLANE LDB RDSIZ,I IS FRAME ADB M3 AT LEAST LDA FBITS,I THREE WORDS LONG AND SMB AND IS START SSB,INB,RSS OF MESSAGE SZA,RSS BIT SET? JMP R2B NO, THROW THE BUM OUT STB RDSIZ,I SAY BUFFER TWO WORDS SHORTER LDA !R2WD TELL CARD THAT WE WANT JSB OTCM$ TO READ IN TWO WORDS JSB WFLG$ SC201 LIA SCODE,C FIRST WORD IS LENGTH STA RLEN1,I OF FIRST BUFFER JSB WFLG$ SECOND WORD SC202 LIA SCODE,C IS LENGTH STA RLEN2,I OF SECOND BUFFER ARS IS SECOND BUFFER SZA SHORTER THAN 2 WORDS? JMP R2C NO, GOOD * * ILLEGAL FRAME, THROW IT AWAY * R2B LDA !DCRD TELL CARD JSB OTCM$ TO THROW JSB WCOM$ OUT FRAME JSB UNLK$ CLA NO MORE STA RDSIZ,I FRAME PENDING JMP R1 TRY AGAIN * R2C JSB UNLK$ GIVE BACK BACKPLANE JMP R3 * * SEND CONNECT INDICATION REQUEST TO HIGHER UPS * R2D CLA REQUEST STA RLEN1,I CONNECT R2E STA RLEN2,I INDICATION SPC 1 **+** **** * *** PART 3: GET A READ REQUEST *** * **** **** R3 CLA CLEAR OUT STA RPTRY,I RETRY COUNTER * * WAIT FOR A READ REQUEST, MAKE ONE IF NEEDED * R3A LDA FBITS+RA-RA,I CLEAR READ ABORTED BIT ERA,CLE,ELA IN CASE IT WAS SET STA FBITS,I FROM BEFORE AND RPB IS A READ REQUEST SZA PENDING? JMP R3B YES, DO OUR STUFF LDB RLEN1,I IS THIS A ADB RLEN2,I CONNECT SZB,RSS INDICATION? JMP R3A2 YES, DS 1 MESSAGE TYPE LDA FBITS,I AND RCB IS THIS A SZA,RSS 3000 CALL? JMP R3B2 YES, WAIT FOR QUEZ LDB FMISC,I GET AND RRL 6+TR-TR SAVE AND .7 MESSAGE R3A2 STA TEMP4 TYPE CPA .2 FRONT PANEL RSS MESSAGE TYPE? JMP R3A1 NO LDA FBITS+FW-FW,I YES, IN FRONT PANEL SSA WAIT MODE? JMP R3B2 YES, WAIT LDA FMISC,I NO, IS THIS THE AND FMB FIRST FRONT PANEL SZA MESSAGE SEEN? JMP R3B4 NO, DISCARD IT R3A1 LDB RLEN1,I GET LENGTHS LDA RLEN2,I OF BUFFERS STA TEMP3 SAVE SECOND LENGTH SZA IS SECOND LENGTH LDA RPTRY,I NON-ZERO AND IS ADA RRLIM RETRY COUNTER SSA,RSS BIG? CLB YES, DUMP FIRST BUFFER STB TEMP2 SAVE FIRST LENGTH LDA FMISC,I SAVE AND LUB LU IOR BIT15 INDICATING SECOND EQT STA TEMP1 JSB $LIST SCHEDULE R3A3 OCT 701 PROGRAM DEF R3A5 R3A4 DEF QUEUE NAME = QUEUE DEF FNMBR SECURITY CODE SO QUEUE IS HAPPY DEF TEMP1 LU DEF TEMP2 BUFFER DEF TEMP3 LENGTHS DEF TEMP4 MESSAGE TYPE R3A5 SZA SCHEDULED OK? = JMP R3A6 NO STB R3A4 YES, MODIFY CALL SO NEXT TIME CLA,INA WE WILL USE STA R3A3 ID SEGMENT POINTER R3A6 LDA FBITS,I ASK FOR IOR STB QUICK STA FBITS,I TIMEOUT JSB SUSP WAIT JMP R3A SEE IF A GOOD THING HAPPENED * * HANDLE NO SAM REQUESTS * R3B CLA SET JSB STAT GOOD STATUS JSB CMDAT FIND OUT ABOUT REQUEST JMP R1 REQUEST ABORTED LDA TEMP3 IS IT A IOR TEMP4 NO SAM SZA REQUEST? JMP R3C NO JSB COMPL MAYBE, DO A COMPLETION JSB CMDAT IS THIS JMP R1 REQUEST ABORTED LDA TEMP1 A CONNECT SZA,RSS INDICATION? JMP R3B3 YES LDA EQT9,I DOES THIS SAY CPA .1 BAD LENGTHS? JMP R3B4 YES, TOSS OUT FRAME CLB CLEAR RETRY COUNTER CPA .2 IF DS/1000 STB RPTRY,I IS ILL JSB LOCK WAIT FOR BACKPLANE JSB UNLK$ TO QUIET DOWN LDA FBITS,I ASK FOR IOR MTB MEDIUM STA FBITS,I TIMEOUT R3B2 JSB SUSP WAIT FOR SOMETHING LDA TGONE INCREMENT ADA RPTRY,I RETRY COUNTER STA RPTRY,I IF TIMEOUT OCCURRED JMP R3A TRY AGAIN R3B3 LDA FMISC,I CLEAR "MUST AND CINB TELL ABOUT STA FMISC,I CONNECT" BIT LDA RLEN1,I WERE WE IOR RLEN2,I LOOKING FOR A SZA CONNECT REQUEST? JMP R3A NO, WAIT FOR READ JMP R1 DONE R3B4 JSB LOCK GRAB BACKPLANE JMP R2B GO TOSS FRAME * * MAKE SURE COMMAND IS LEGAL * R3C LDA FMISC,I DO READ RRR 10+TR-TR MESSAGE TYPE XOR TEMP1 AND FRAME AND .7 TYPE SZA AGREE? JMP R3C1 NO, ERROR LDB TEMP1 DS 1  SZB MESSAGE TYPE? JMP R3C3 NO, TAKE ANYTHING LDA TEMP4 SECOND CPA RLEN2,I LENGTHS RSS EQUAL? JMP R3C1 NO, COMPLAIN LDA TEMP3 FIRST LENGTHS CPA RLEN1,I EQUAL? JMP R4 YES, GOOD SZA,RSS NO, IS REQUEST FOR ZERO WORDS? JMP R3C2 YES, SORT OF GOOD R3C1 JSB COMPL CLAIM LDA #WRMD ILLEGAL JSB STAT REQUEST JMP R3A TRY AGAIN R3C2 LDA #RBUS SET STATUS TO JSB STAT LOCAL BUSY JMP R4 R3C3 LDA FMISC,I INDICATE IOR FMB FRONT PANEL MESSAGE CPB .2 IF THAT IS STA FMISC,I WHAT WE HAVE SPC 1 **** **** * *** PART 4: READ DATA *** * **** **** * * SET UP RLEN1, RLEN2, RPTRY * R4 LDA TEMP2 SET BUFFER POINTER IOR BIT15 WITH DCPC INPUT STA RPTRY,I DIRECTION BIT LDA TEMP3 SET COMBINED ADA TEMP4 LENGTHS TO READ ADA BIT15 AND START OF MESSAGE BIT STA RLEN2,I ALLOWED FLAG LDB TEMP1 GET MESSAGE TYPE LDA RLEN1,I GET THE NUMBER OF WORDS CMA,INA WE MUST SKIP ADA TEMP3 FOR A DS 1 MESSAGE SZB,RSS DS 1 MESSAGE? STA RLEN1,I YES, RECORD SKIP COUNT * * WAIT FOR A FRAME TO ARRIVE, HANDLE EXCEPTIONS * R4B LDA RLEN2,I DO WE NEED SZA,RSS TO READ MORE WORDS? JMP R4F NO, WE ARE DONE R4B1 JSB CMDAT REQUEST STILL PENDING? JMP R1 NO, ABORTED LDB RDSIZ,I IS A SZB FRAME READY? JMP R4C YES LDA FBITS,I GET STATUS AND LCB IS THE LINK SZA,RSS LOGICALLY CONNECTED? JMP R4B2 NO, GO STOP THE READ JSB SUSP WAIT FOR SOME SIGNIFICANT EVENT JMP R4B1 TRY AGAIN R4B2 JSB COMPL  REQUEST COMPLETION LDA #LFAL LINE FAILURE JSB STAT IS THE STATUS JMP R1 TRY AGAIN * * MAKE SURE WE HAVE A GOOD LOOKING FRAME * R4C LDA FMISC,I DO INPUT RRR 10+TR-TR MESSAGE TYPE XOR TEMP1 AND COMMAND AND .7 TYPE SZA AGREE? JMP R4C1 NO, ERROR LDA RLEN2,I GET START OF MESSAGE RAL,CLE,ERA ALLOWED INDICATOR STA RLEN2,I CLEAR IT LDA FBITS,I IS START AND SMB OF MESSAGE CME BIT SET AND SEZ,SZA NOT ALLOWED? JMP R4C1 YES, THAT'S BAD LDB RLEN1,I SSB,RSS CLB IS THE ADB RDSIZ,I FRAME SIZE CMB,INB BIGGER THAN ADB RLEN2,I THE NUMBER OF SSB,RSS WORDS WE WANT? JMP R4C2 NO, GOOD R4C1 JSB COMPL YES, COMPLETE THIS REQUEST LDA #MEAB BLAME THINGS ON JSB STAT THE OTHER SIDE JMP R1 GO GET BACK IN SYNC R4C2 JSB LOCK WE WILL NEED THE BACKPLANE * * DO SOMETHING WITH THIS FRAME * R4D LDA RLEN1,I DO WE SSA,RSS NEED CLA TO ADA RDSIZ,I SKIP THE LDB A ENTIRE CMA,SSA,INA,SZA FRAME? JMP R4D1 NO STB RLEN1,I YES, UPDATE COUNT CLA NO FRAME STA RDSIZ,I READY NOW LDA !DCRD TELL CARD JSB OTCM$ TO DUMP JSB WCOM$ FRAME JMP R4E1 R4D1 STB RDSIZ,I UPDATE FRAME SIZE JSB RDCP$ GET DCPC R4D2 LDA RLEN1,I DO WE NEED CMA,SSA,INA TO SKIP SOME WORDS? JMP R4D3 NO ADA MB400 YES, SKIP SSA,RSS AT MOST CCA 255 ADA B400 WORDS LDB A UPDATE ADB RLEN1,I SKIP STB RLEN1,I COUNT IOR !ADBP TELL iJSB OTCM$ CARD JSB WCOM$ WAIT FOR CARD TO FINISH JMP R4D2 SEE IF WE MUST SKIP MORE R4D3 LDA !INTR TELL CARD THAT ADA RDSIZ,I WE WANT TO JSB OTCM$ READ IN THE FRAME LDA RPTRY,I SET DCPC STARTING ADDRESS STA TEMP2 WITH INPUT BIT SET ADA RDSIZ,I UPDATE STA RPTRY,I BUFFER POINTER LDA RDSIZ,I SET DCPC CMA,INA TRANSFER STA TEMP3 LENGTH ADA RLEN2,I SAY HOW MANY WORDS STA RLEN2,I MUST STILL BE READ CLA SAY NO STA RDSIZ,I FRAME READY JSB DCPC$ START UP DCPC * * WAIT FOR TRANSFER TO FINISH, HANDLE EXCEPTIONS * R4E JSB WTRN$ WAIT FOR TERMINATION R4E1 JSB UNLK$ UNLOCK BACKPLANE LDA FMISC,I IS AND TRB MESSAGE TYPE SZA,RSS DS 1? JMP R4B YES, GET NEXT FRAME * * ENTIRE MESSAGE HAS BEEN READ, COMPLETE * R4F JSB COMPL DONE AT LAST JMP R1 BACK FOR MORE WORK SKP ************************************************** * * * WRITE SECTION * * * ************************************************** SPC 2 **** **** * *** PART -1: HANDLE POWER-FAIL AND SEVERE ERROR *** * **** **** WSER EQU * SEVERE ERROR RECOVERY LDA FBITS,I REQUEST ON AND WPB WRITE SZA,RSS PROCESS? JMP W1C NO JSB COMPL YES, DUMP IT LDA #SERR WITH NASTY JSB STAT ERROR W1C JSB SUSP WAIT FOR A NEW COMMAND LDA FBITS,I DID A CONFIGURATION AND WPB COMMAND SZA,RSS ARRIVE? JMP W1C NO, WAIT SOME MORE LDA FBITS,I CLEAR SICK CARD AND SEIRCN AND AUTOMATIC RECONNECT STA FBITS,I FLAGS JSB LOCK RESERVE BACKPLANE LDA !RSET RESET JSB OTCM$ CARD JSB WFLG$ WAIT FOR HIM TO RECOVER RSS WPFL EQU * POWER FAIL RECOVERY JSB LOCK KEEP THINGS FOR OURSELVES LDA !PWUP TELL CARD THAT JSB OTCM$ WE UNDERSTAND JSB WCOM$ HIS TROUBLES JSB UNLK$ RELEASE DCPC IF WE HAVE SOME SPC 1 **** **** * *** PART 0: HANDLE STARTUP OF CARD *** * **** **** WINI JSB LOCK LOCK THINGS UP CLA SAY NO BUFFERS STA WBUFS,I READY LDA FMISC,I SET WRITE TYPE IOR TWB UNDEFINED AND CINB AND NO CONNECT STA FMISC,I INDICATION NEEDED LDA FBITS,I AUTOMATIC AND RCB RECONNECTION? SZA,RSS JMP W1D NO, DON'T BOTHER LDA !CNCT TELL CARD JSB OTCM$ TO CONNECT JSB WCOM$ ONCE MORE LDA FBITS,I SET IOR ACB ASKED TO CONNECT STA FBITS,I FLAG W1D LDA !TIME TELL JSB OTCM$ CARD JSB WFLG$ THAT TIMEOUT IS COMMING LDA EQT14,I GET OUR TIMEOUT VALUE CMA,INA AS A POSITIVE QUANTITY SC301 OTA SCODE,C TELL CARD JSB WCOM$ ABOUT IT JSB UNLK$ GIVE BACK BACKPLANE **** **** * *** PART 1: WAIT FOR SOMETHING TO DO *** * **** **** W1 LDA FBITS,I IS A REQUEST PENDING AND WPB FOR THE WRITE PROCESS SZA TO EXECUTE? JMP W1A YES, GO DO OUR THING JSB SUSP NO, WAIT FOR SOMETHING TO HAPPEN JMP W1 W1A CLA SET GOOD JSB STAT STATUS LDA FBITS,I CLEAR WRITE ABORT BIT AND WANB IN CASE IT WAS  STA FBITS,I SET FROM BEFORE JSB LOCK WE ARE GOING TO NEED THE BACKPLANE JSB CMDAT GET COMMAND JMP W3D ABORTED LDB TEMP1 TYPE CCE,SSB SPECIAL COMMAND? JMP W3 YES, GO TO PART 3 CPB .3 SEND BREAK MESSAGE? JMP W3C YES, DO THAT SPC 1 **** **** * *** PART 2: SEND WRITE DATA *** * **** **** * * SET MESSAGE TYPE * W2 LDA FMISC,I GET CARD'S ALF,RAR CURRENT AND .7+TW-TW OUTPUT TYPE CPA TEMP1 MATCH? JMP W2A YES, WE CAN SAVE SOME WORK LDA FMISC,I NO, SET TW ALF,RAR TO NEW RRR 3+TW-TW MESSAGE TYPE STA FMISC,I LDA TEMP1 GET BACK MESSAGE TYPE ADA !NMT MAKE COMMAND TO TELL CARD JSB OTCM$ TELL IT JSB WCOM$ WAIT FOR IT TO FINISH JSB CMDAT RESTORE COMMAND INFORMATION JMP W3D COMMAND ABORTED * * GET MESSAGE PARAMETERS * W2A LDA TEMP2 GET POINTER TO START OF BUFFERS LDB TEMP1 SET SIGN BIT CCE,SZB,RSS IF MESSAGE TYPE RAL,ERA IS DS STA WPTR,I SAVE POINTER LDA TEMP3 GET LENGTH OF FIRST BUFFER ADA TEMP4 ADD LENGTH OF SECOND BUFFER STA WLEN,I SAVE NUMBER OF WORDS TO WRITE * * TRANSFER EACH FRAME * W2B LDA WLEN,I MORE DATA TO CCE,SZA,RSS WRITE OUT? JMP W3D NO, ALL DONE * * WAIT FOR BUFFER TO BE READY OR ERROR CONDITION * THE BACKPLANE IS LOCKED IFF E IS SET * W2C LDA FBITS,I WRITE REQUEST ABORTED AND WALCB OR LINE LOGICALLY CPA LCB DISCONNECTED? JMP W2C0 NO, SO FAR SO GOOD SEZ GIVE BACK BACKPLANE JSB UNLK$ IF WE HAVE IT LDA #LFAL LINE FAILURE STATUS JMP W2C5 REPORT W2C0 LDA WBUFS,I HAVE WE ASKEpD SSA FOR A OUTPUT BUFFER? JMP W2C2 YES, WAIT SOME MORE SEZ,RSS NO, GRAB BACKPLANE JSB LOCK IF WE DON'T HAVE IT LDA WBUFS,I SEE HOW MANY BUFFERS WE HAVE SZA ARE THERE ANY? JMP W2C1 YES, FILL ONE UP CLB NO, COMPUTE LDA WLEN,I HOW MANY BUFFERS DIV WFSIZ,I WE WILL NEED AND B77 ADA !OTBF ASK JSB OTCM$ FOR JSB WCOM$ BUFFERS W2C1 ADA M1 GET HOW MANY STA WBUFS,I MINUS ONE CCE,SSA,RSS DID WE GET ANY? JMP W2D YES, FILL ONE UP LDA M60 SET TIMEOUT STA WBUFS,I LIMIT W2C2 SEZ GIVE BACK BACKPLANE JSB UNLK$ IF WE HAVE IT LDA WBUFS,I IS TIME INA,SZA,RSS UP? JMP W2C3 YES, ERROR LDB TGONE NO, DID TIMEOUT SZB OCCUR? STA WBUFS,I YES, COUNT IT LDA FBITS,I ASK FOR IOR MTB MEDIUM STA FBITS,I TIMEOUT JSB SUSP WAIT FOR SOMETHING CLE SAY WE DON'T OWN THE BACKPLANE JMP W2C SEE WHAT WE GOT W2C3 LDA #RBUS REMOTE BUSY W2C5 JSB STAT STATUS JSB COMPL JMP W1 WAIT FOR A NEW REQUEST M60 DEC -60 * * SEND OUTPUT TRANSFER COMMAND * W2D JSB RDCP$ GET DCPC LDA WLEN,I GET LENGTH CPA WFSIZ,I LAST FRAME CANNOT BE FULL SIZE ADA M1 SO WE CAN DETECT DUPLICATE FRAMES LDB WPTR,I ADD TWO WORDS TO LENGTH SSB IF LENGTH WORDS MUST BE ADA .2 WRITTEN OUT LDB WFSIZ,I IS LENGTH CMB GREATER THAN ADB A MAXIMUM FRAME SSB,RSS SIZE? LDA WFSIZ,I YES, USE MAX FRAME SIZE ADA !OTTR MAKE OUTPUT TRANSFER COMMAND LDB WPTR,I IS THIS FRAME SSB START OF DS 1 MESSAGE? ADA !SWMB YES, SET START OF MESSAGE BIT JSB OTCM$ SEND COMMAND * * START UP DCPC * W2E LDA WPTR,I DO WE HAVE TO SEND SSA,RSS LENGTH WORDS? JMP W2E1 NO ELA,CLE,ERA YES, BUT WE WON'T STA WPTR,I ANY MORE JSB WFLG$ JSB CMDAT SEND LENGTH JSB WTRN$ COMMAND ABORTED LDA TEMP3 OF FIRST SC303 OTA SCODE,C BUFFER JSB WFLG$ JSB CMDAT SEND LENGTH JSB WTRN$ COMMAND ABORTED LDA TEMP4 OF SECOND SC304 OTA SCODE,C BUFFER LDA WFSIZ,I MAX DCPC TRANSFER NOW ADA M2 IS TWO LESS THAN JMP W2E2 MAX FRAME SIZE W2E1 LDA WFSIZ,I GET MAX DCPC TRANSFER CPA WLEN,I LAST FRAME CANNOT BE FULL SIZE ADA M1 SO WE CAN DETECT DUPLICATE FRAMES W2E2 LDB WLEN,I BIGGER CMB THAN ADB A WORDS TO SSB,RSS WRITE? LDA WLEN,I YES, USE WORDS TO WRITE LDB WPTR,I SET DCPC STB TEMP2 STARTING ADDRESS ADB A ADJUST BUFFER STB WPTR,I POINTER CMA,INA SET DCPC STA TEMP3 WORD COUNT ADA WLEN,I UPDATE NUMBER OF WORDS STA WLEN,I THAT MUST BE TRANSFERRED JSB DCPC$ START DCPC * * WAIT FOR DCPC TO FINISH OR ABORT, HANDLE IT * W2F JSB WTRN$ WAIT FOR DCPC TO FINISH JMP W2B DO NEXT FRAME SPC 1 **** **** * *** PART 3: PROCESS CONTROL COMMANDS *** * **** **** W3 ERB,RBR GET LAST THREE BITS OF FUNCTION CODE CMB,CME,SZB WAS COMMAND 30 OR 31? JMP W3B NO * * PROCESS INITIALIZE LINK * SEZ REALLY INITIALIZE LINK? JMP W3A NO, MUST BE CLEAR LINK LDA #ILRQ GET POSSIBLE ERROR LDB EQT12,I IS THIS CMB,INB THE ADB EQT12  FIRST SSB,RSS EQT? JMP W3F NO, REJECT LDA TEMP2 GET AND LUB THE LU LDB ACB RECONNECT ALLOWED CPA TEMP2 ONLY FOR TYPE 0 ADB RCB CONNECT XOR FMISC,I PUT LU AND LUB WHERE WE XOR FMISC,I CAN GET IT STA FMISC,I LATER LDA FBITS,I CLEAR FUNNY FLAGS AND M3NB ADD ASKED TO CONNECT, IOR B AND RECONNECT IF NECESSARY STA FBITS,I SAVE FLAGS LDA TEMP2 GET ALF,ALF CONNECT AND B377 TYPE IOR !CNCT TELL JSB OTCM$ CARD JSB WCOM$ TO CONNECT LDB A SAVE RESPONSE LDA #NOIN GET POSSIBLE ERROR SZB CONNECT OK? JMP W3F NO, COMPLAIN LDA !MIFL ASK CARD JSB OTCM$ WHAT THE LARGEST JSB WCOM$ BUFFER SIZE IS STA WFSIZ,I SAVE ANSWER JSB UNLK$ RELEASE BACKPLANE JSB COMPL COMPLETE JSB LOCK GET BACK BACKPLANE JMP W1D UPDATE CARD'S TIMEOUT M3NB ABS -RC-ND-100000B+FW-FW-1 * * PROCESS CLEAR LINK * W3A LDA FBITS,I SAY AND XCNB NOT ASKED TO CONNECT STA FBITS,I NOT CONNECTED, AND NO RECONNECT LDA !DSCN TELL CARD JSB OTCM$ TO HANG UP JSB WCOM$ HEAR ME, OH CARD JMP W3D COMPLETE * * PROCESS SET/CLEAR MODE COMMANDS * W3B SSB,SLB MODE COMMAND? JMP W3E NO, MUST BE READ/WRITE FUNNY STUFF LDA NDB GET APPROPRIATE BIT SLB FOR THIS LDA FWB COMMAND XOR FBITS,I GET THE REST OF THE BITS SEZ,RSS CLEAR BIT? AND FBITS,I YES SEZ SET BIT? IOR FBITS,I YES STA FBITS,I SAVE NEW BITS JSB CIBCK SEE IF WE MUST FLAG LINE UP FOR DS JMP W3D * * PROCESS SEND BREAK * W3C LDA !BRK GET STOMP ON NEIGHBOR COMMAND JSB OTCM$ TELL CARD JSB WCOM$ TO SEND BREAK SZA,RSS DID THINGS GO WELL? JMP W3D YES LDA #LFAL NO, TELL W3F JSB STAT PROBLEMS W3D JSB UNLK$ JSB COMPL REQUEST COMPLETION JMP W1 BACK TO MAIN LOOP * * READ OR WRITE CONFIGURATION DATA * W3E LDA TEMP4 GET AND B377 DATA TYPE SZA,RSS DEFAULT IS INA ONE IOR !SIDT TELL CARD JSB OTCM$ ABOUT TYPE JSB WCOM$ OF DATA JSB RDCP$ GET DCPC JSB CMDAT GET BACK INFO JMP W3G COMMAND ABORTED, BACK OFF LDA TEMP3 GET BUFFER LENGTH LDB TEMP1 INPUT CMB,CCE,SLB OR OUTPUT RAL,ERA TRANSFER JSB OTCM$ TELL CARD LDA TEMP3 SET LENGTH CMA,INA NEGATIVE STA TEMP3 FOR DCPC LDA TEMP2 SET ADDRESS CCE,SLB,RSS WITH RAL,ERA DIRECTION STA TEMP2 BIT JSB DCPC$ START DCPC JSB WTRN$ WAIT FOR COMPLETION JMP W3D COMPLETE W3G LDA !SIDT SET CARD BACK JSB OTCM$ TO ORDINARY JSB WCOM$ DATA TRANSFER JMP W3D SKP ************************************************** * * * BACKPLANE SECTION * * * ************************************************** SPC 2 * * REQUEST COMPLETION RETURN * COMPL NOP LDA ACTIV+WA-WA AND FBITS,I IS THE ABORT BIT OF THE SZA,RSS ACTIVE PROCESS SET? JMP COMP1 NO XOR FBITS,I YES, CLEAR IT AND RETURN, STA FBITS,I A COMPLETION RETURN HAS ALREADY JMP COMPL,I BEEN REQUESTED COMP1 LDA SRVOK DO WE WANT WHAT CPA ACmTIV WE CAN'T HAVE CLA OR HAS A IOR SSERV SYSTEM SERVICE AND .7 EXCEPT DCPC RETURN SZA,RSS ALREADY BEEN REQUESTED? JMP COMP2 NO ISZ RENTR YES, REQUEST DRIVER REENTRY LDB COMPL SUSPEND THIS JMP SUSPB PROCESS COMP2 LDA ACTIV SET UP THE CMA SERVICE STA SSERV WORD RAL,RAL CLEAR THE PROPER AND FBITS+WP-WP,I REQUEST PENDING STA FBITS,I BIT JMP COMPL,I SPC 1 * * LOCK THE BACKPLANE * LOCK NOP LDB LOCK GET RETURN ADDRESS JSB BSYCK CAN WE HAVE THE BACKPLANE? JMP SUSPB NO, GO WAIT FOR IT LDA ACTIV+WL-WL ALF SET THE BACKPLANE IOR FBITS,I LOCKED TO OUR STA FBITS,I PROCESS JMP LOCK,I TELL OUR GOOD NEWS SPC 1 * * UNLOCK THE BACKPLANE * UNLK$ NOP LDA ACTIV CLEAR THE ALF CORRECT XOR FBITS,I BACKPLANE LOCK STA FBITS,I FLAG CCA MAKE SURE THE NEXT PROCESS STA ADV IS ACTIVATED WHEN WE SUSPEND LDB DCHAN DO WE HAVE A SZB,RSS DCPC CHANNEL? JMP UNLK$,I NO, DONE ADB M6 YES, CLEAR ADB INTBA THE CLA ALLOCATION STA B,I WORD STA DCHAN SAY DCPC NOT AVAILABLE LDA SSERV REMEMBER IOR SRVOK LDB .8 TO TELL SZA,RSS SYSTEM STB SSERV ABOUT CHANNEL JMP UNLK$,I M6 DEC -6 SPC 1 * * REQUEST DCPC * RDCP$ NOP LDA ACTIV HAS THE AND FBITS+WA-WA,I CURRENT REQUEST SZA BEEN ABORTED? JMP RDCP$,I YES, PRETEND WE GOT DCPC LDA DCHAN DO WE HAVE SZA DCPC? JMP RDCP$,I YES, NO WORK LDA ACTIV HAVE WE JSB EQTST ALREADY LDA EQT5,I ASKED FOR RAL A DCPC SSA,SLA CHANNEL? JMP RDCP1 YES, WAIT LDB ACTIV NO, GET WHO WE WANT LDA SSERV SYSTEM SERVICE IOR SRVOK NOT ALLOWED SZA,RSS OR ALREADY NEEDED? STB SSERV NO, ASK FOR DCPC SZA ISZ RENTR YES, ASK TO TRY AGAIN RDCP1 ISZ SCCLF TELL SUSP TO CLEAR FLAG ON CARD SC404 STF SCODE BUT SET IT IN CASE LDB RDCP$ SUSPEND THIS JMP SUSPB PROCESS SPC 1 * * WAIT FOR DCPC TRANSFER TO FINISH OR BE ABORTED * IF ABORTED, STOP DCPC, TELL CARD, AND RETURN TO R1 OR W1 * WTRN$ NOP LDA FBITS+WA-WA,I AND ACTIV HAS THIS TRANSFER SZA BEEN ABORTED? JMP WTRN1 YES, TUBE IT LDB WTRN$ NO, GET SUSPEND ADDRESS DC409 SFS DCPCH DCPC FINISH? JMP SUSPB NO, WAIT SC413 SFS SCODE YES, CARD FINISH? JMP SUSPB NO, WAIT JMP WTRN$,I YES WTRN1 EQU * LDA !ABDM GET ABORT DMA COMMAND SC407 OTA SCODE,C SEND IT WTRN2 LDA MTB ASK FOR IOR FBITS,I HALF SECOND STA FBITS,I TIMEOUT JSB WAIT HAS THE CARD SET THE FLAG? RSS NO JMP WTRN3 YES JSB SUSP WAIT FOR CARD'S DMA TO DO SOMETHING LDA TGONE TIMEOUT? SZA,RSS IF YES, THEN DMA MUST HAVE FINISHED JMP WTRN2 NO, KEEP WAITING WTRN3 EQU * SC408 STC SCODE,C INDICATE COMMAND TO CARD JSB WFLG$ WAIT FOR HIM TO FINISH JSB UNLK$ RELEASE BACKPLANE LDA ACTIV RETURN TO CPA .2 THE CORRECT JMP W1 PROCESS CLB FIXING RDSIZ STB RDSIZ,I IF FROM JMP R1 READ PROCESS SPC 1 * * OUTPUT A COMMAND TO THE CARD * OTCM$ NOP SC401 OTA SCODE SEND THE COMMAND SC402 STC SCODME,C TELL THE CARD IT IS A COMMAND JMP OTCM$,I SPC 1 * * SET UP AND START DCPC * DCPC$ NOP LDA ACTIV HAS THE AND FBITS+WA-WA,I CURRENT REQUEST SZA BEEN ABORTED? JMP DCPC$,I YES, PRETEND WE ARE DONE LDA DCPCC SET DC401 OTA DCPCH CONTROL WORD DC402 CLC DCPCL SET LDA TEMP2 MEMORY DC403 OTA DCPCL ADDRESS DC404 STC DCPCL SET LDA TEMP3 WORD DC405 OTA DCPCL COUNT DC406 STC DCPCH,C START DCPC DC407 CLC DCPCH PREVENT INTERRUPTS JMP DCPC$,I SPC 1 * * WAIT FOR FLAG FROM CARD * WFLG$ NOP LDB WFLG$ GET RETURN ADDRESS JSB WAIT FLAG SET? JMP SUSPB NO, SUSPEND JMP WFLG$,I YES, RETURN SPC 1 * * WAIT FOR RESPONSE TO COMMAND, MAKE SURE RESPONSE * IS GOOD, RETURN RESPONSE IN A * WCOM$ NOP LDB WCOM$ GET RETURN ADDRESS JSB WAIT FLAG SET? JMP SUSPB NO, SUSPEND SC405 LIA SCODE YES, GET ANSWER SSA FAILURE BIT SET? JMP SICK YES, MUST BE POWERFAIL OR WORSE JMP WCOM$,I NO, MUST BE OK SPC 1 * * WAIT A SHORT TIME FOR FLAG * SKIP RETURN IF FLAG IS SET, B IS UNCHANGED * WAIT NOP LDA M20 GET SHORT TIME COUNTER WAIT1 INA,SZA,RSS TIME UP? JMP WAIT,I YES, THAT'S ALL SC403 SFS SCODE NO, FLAG SET? JMP WAIT1 NO, WAIT SOME MORE ISZ WAIT YES, SAY FLAG SET JMP WAIT,I RETURN SPC 1 * * CHECK FOR BACKPLANE NO LONGER BUSY * SKIP RETURN IF SO, B IS UNCHANGED * BSYCK NOP LDA FBITS,I GET LOCK AND WLRLB FLAGS SZA,RSS ANY LOCK? JMP BSYC2 NO, SAY SO CPA WLRLB YES, LOCKED TO BACKPLANE? BSYC1 JSB WAIT YES, HAS CARD RESPONDED? JMP BSYCK,I NO, STILL LOCKED UP SC409 CLF SCODE ALLOW ANOTHER INTERRUPT SC410 LIA SCODE GET CARD'S RESPONSE SSA POWER FAIL? JMP SICK YES, GET HIM BACK ON HIS FEET SZA AN ACKNOWLEDGEMENT? JMP BSYC1 NO, GIVE HIM ANOTHER CHANCE LDA FBITS,I YES, CLEAR XOR WLRLB LOCK STA FBITS,I FLAGS BSYC2 ISZ BSYCK SAY NOT BUSY JMP BSYCK,I RETURN TO POINT OF ORIGIN SPC 1 * * SUSPEND ACTIVE PROCESS, ACTIVATE OTHER ONE OR SET UP * BACKPLANE FOR DRIVER EXIT AND EXIT * SUSP NOP LDB SUSP RETURN ADDRESS IS RSS PROCESS CONTINUATION ADDRESS SUSPB ADB M1 ALTERNATE ENTRY, B IS ADDRESS + 1 LDA ACTIV SAVE CPA .1 RESTART STB RCONT,I ADDRESS CPA .2 IN CORRECT STB WCONT,I WORD ISZ ADV SHOULD WE ACTIVATE OTHER PROCESS? JMP SUSP1 NO, PREPARE BACKPLANE TO EXIT XOR .3 YES, ADJUST SUSP3 STA ACTIV ACTIVE PROCESS INDICATOR ADA RCNTA JUMP TO LDB A,I NEW JMP B,I PROCESS SUSP1 LDA SCCLF NEED TO CLEAR FLAG CMA,SLA,RSS ON CARD? LDA RENTR MAYBE, DO WE WANT SZA,RSS RE-ENTRY SC411 CLF SCODE NO, CLEAR FLAG LDA FBITS,I IS AND WLRLB BACKPLANE SZA LOCKED? JMP SUSP4 YES, KEEP OUR HANDS OFF LDA !UNST GET UNSOLICITED STATUS INPUT COMMAND LDB RENTR DRIVER REENTRY SZB,RSS REQUESTED? JMP SUSP2 NO LDA FBITS,I YES, SET BACKPLANE IOR WLRLB BUSY FLAGS IOR LTB AND REQUEST STA FBITS,I TIMEOUT LDA !NOOP GET NO-OP COMMAND SUSP2 JSB OTCM$ SEND OUR PARTING COMMAND JMP EXIT RETURN TO THE SYSTEM SUSP4 LDA FBITS,I BACKPLANE LOCKED, IOR LTB REQUEST LDB SCCLF LONG TIMEOUT SZB,RSS UNLESS WAITING STA FBITS,I FOR DCPC JMP ZEXIT SPC 1 * * PROCESS DRIVER ENTRY FROM CARD INTERRUPT * CONTN JSB BSYCK BACKPLANE LOCKED? JMP GO YES, NONE OF OUR BUSINESS SC406 LIA SCODE GET CARD'S RESPONSE SSA FAILURE? JMP SICK YES, MUST BE POWERFAIL OR WORSE LDB A SAVE INPUT RBL,RBL SCRAMBLE SOME BITS SLB,RSS UNSOLICITED INPUT? JMP GO NO, MUST HAVE BEEN A NO-OP RBL,SLB,RBL YES, INCOMMING FRAGMENT? JMP CONT1 YES RBL,SLB NO, NEW MESSAGE TYPE? JMP CONT2 YES RBL,SLB,BLF NO, OUTPUT BUFFER READY? JMP CONT3 YES LDA FBITS,I NO, STATUS CHANGE, GET FLAGS RBL,RBL RBL,SLB DISCONNECT, TRYING TO RECONNECT? AND LCNB YES, RECORD IT RBL,SLB COMPLETE DISCONNECT? AND XCNB YES, RECORD IT RBL,SLB CONNECT? IOR LCB YES, RECORD CONNECT STA FBITS,I SAVE NEW STATUS JSB CIBCK SEE IF WE MUST FLAG CONNECT JMP CONT4 CONT1 AND B7777 SET STA RDSIZ,I FRAGMENT SIZE LDA FBITS,I RECORD IOR SMB START OF SLB,RSS MESSAGE XOR SMB BIT STA FBITS,I VALUE JMP CONT4 CONT2 RRL 10+TR-TR MOVE TYPE TO PROPER FIELD XOR FMISC,I PUT IT IN AND TRB THE REST OF XOR FMISC,I THE WORD STA FMISC,I SAVE NEW TYPE JMP CONT4 CONT3 AND B77 GET NUMBER OF BUFFERS LDB WBUFS,I GET OLD NUMBER OF BUFFERS STA WBUFS,I SAVE NEW NUMBER OF BUFFERS LDA FBITS,I GET FLAGS IN CASE CPB M1 HAD WE GIVEN UP ON GETTING A BUFFER? JSB CIBCK YES, TELL RE-ROUTING THE GOOD NEWS CONT4 JMP GO START THINGS UP SPC 1 * * SET FLAG TO SEND INDICATION OF LINE UP TO HIGHER UPS * IF THE LINE IS NOW READY FOR DS/1000 TRAFFIC * ON ENTRY A MUST EQUAL FBITS,I * CIBCK NOP j  AND M4B ISOLATE RC, LC, FW, ND LDB A SAVE THEM LDA WBUFS,I HAVE WE GIVEN UP CPA M1 ON GETTING A BUFFER? CLB YES, THEN WE ARE NOT READY LDA FMISC,I GET THE INFO AND FMNB SAY NO FRONT PANEL MESSAGE CPB LCRCB READY FOR DS/1000 TRAFFIC? IOR CIB YES, SET FLAG STA FMISC,I PUT IT ALL BACK JMP CIBCK,I FIN SPC 1 * * PROCESS DRIVER ENTRY NOT FROM CARD INTERRUPT * PFAIL LDA .3 SAY NO SYSTEM SERVICE STA SRVOK AVAILABLE INIT LDA FBITS,I AND WLRLB BACKPLANE SZA LOCKED? JMP GO YES, NONE OF OUR BUSINESS LDA !UNDS NO, GET DISABLE UNSOLICITED INPUT JSB OTCM$ SEND CANCEL COMMAND LDA FBITS,I INDICATE IOR WLRLB BACKPLANE STA FBITS,I BUSY SPC 1 * * START UP WRITE PROCESS * GO LDA FBITS,I CLEAR AND XTNB TIMEOUT STA FBITS,I REQUEST BITS CCA TELL SUSP TO ACTIVATE READ PROCESS STA ADV WHEN WRITE PROCESS SUSPENDS LDA .2 START UP WITH JMP SUSP3 WRITE (RIGHT) PROCESS SPC 1 * * HANDLE UNEXPECTED TIMEOUT * SICK EQU * SC412 LIA SCODE GET WHAT THE CARD HAS TO SAY LDB WPFLA GET POWERFAIL RECOVERY ADDRESS CPA !STGD RECOVERY FROM POWER-FAIL? CLA,RSS YES CPA !STG2 OTHER GOOD STATUS? CLA,RSS YES LDA SEB NO, THE CARD IS SICK SZA IF,SICK, MUST USE LDB WSERA SEVERE ERROR RECOVERY ADDRESS IOR FBITS,I BESTOW THE BUSTED BOARD BIT IF SICK AND PWUPB AND SAVE SE, WP, RP, AND RC STA FBITS,I SAVE NEW BITS STB WCONT,I RECOVERY LDA RSERA RESTART STA RCONT,I ADDRESSES LDA DCHAN STOP DCPC SZA IF WE HAVE DC410 STF DCPCH A CHANNEL JMP GO SKP ************************************************** * * * TEMPORARIES AND CONSTANTS * * * ************************************************** SPC 2 * * EQT EXTENSION POINTERS * XTBEG EQU * RPTRY DEF *-XTBEG RETRY COUNTER / => NEXT WORD TO READ RLEN1 DEF *-XTBEG BUFFER LENGTH / - WORDS TO SKIP RLEN2 DEF *-XTBEG BUFFER LENGTH / WORDS TO READ RDSIZ DEF *-XTBEG LENGTH OF FRAME READY ON CARD WPTR DEF *-XTBEG => NEXT WORD TO WRITE WLEN DEF *-XTBEG LENGTH OF WRITE BUFFERS WFSIZ DEF *-XTBEG MAXIMUM PSI FRAME SIZE WBUFS DEF *-XTBEG NUMBER OF ALLOCATED OUTPUT BUFFERS * - NUMBER OF TIMEOUTS LEFT IF CARD * HAS BEEN ASKED TO ALLOCATE BUFFERS RCONT DEF *-XTBEG READ PROCESS CONTINUATION ADDRESS WCONT DEF *-XTBEG WRITE PROCESS CONTINUATION ADDRESS * THE ABOVE TWO WORDS MUST BE IN ORDER FBITS DEF *-XTBEG FLAG BITS FMISC DEF *-XTBEG MISCELLANEOUS INFORMATION MXTLN ABS XTBEG-* XTPTR DEF XTBEG SPC 1 * * TEMPORARY VARIABLES * SSERV BSS 1 SYSTEM SERVICE REQUEST * -3 = COMPLETE WRITE PROCESS REQUEST * -2 = COMPLETE READ PROCESS REQUEST * -1 = COMPLETE CURRENT REQUEST * 0 = NO SYSTEM SERVICE * 1 = REQUEST DCPC FOR READ PROCESS * 2 = REQUEST DCPC FOR WRITE PROCESS * 8 = RELEASE DCPC SRVOK BSS 1 PROCESS ALLOWED TO DO COMPLETION RETURN * 0 IF ANY SYSTEM SERVICE OK ACTIV BSS 1 WHICH PROCESS IS ACTIVE * 1=READ, 2=WRITE ADV BSS 1 -1 SAYS ACTIVATE OTHER PROCESS ENTRY BSS 1 DRIVER ENTERED AT CA66 IF -1, IA66 IF 0 TGONE BSS 1 ONE IFF MEDIUM TIMEOUT EXPIRED SCCLF BSS 1 ONE SAYS DO CLF TO CARD ON EXIT DCHAN BSS 1 DCPC CHANNEL ASSIGNED TO DRIVER, IF ANY RENTR BSS 1 NON-ZERO SAYS DRIVER REENTRY REQUESTED TEMP1 BSS 1 FOUR WORD TEMPORARY AREA FOR ACTIVE TEMP2 BSS 1 PROCESS, USED FOR DCPC CONFIGURATION TEMP3 BSS 1 AMONG OTHER THINGS TEMP4 BSS 1 SPC 1 * * DRIVER CONFIGURATION VARIABLES * SCCON ABS SCODE SELECT CODE FOR WHICH DRIVER IS CONFIGURED DCCON ABS DCPCH DCPC CHANNEL FOR WHICH DRIVER IS CONFIGURED SPC 1 * * SYSTEM BASE PAGE EQUIVALENCES * INTBA EQU 1654B EQT1 EQU 1660B EQT2 EQU EQT1+1 EQT3 EQU EQT2+1 EQT4 EQU EQT3+1 EQT5 EQU EQT4+1 EQT6 EQU EQT5+1 EQT7 EQU EQT6+1 EQT8 EQU EQT7+1 EQT9 EQU EQT8+1 EQT10 EQU EQT9+1 EQT11 EQU EQT10+1 EQT12 EQU 1771B EQT13 EQU EQT12+1 EQT14 EQU EQT13+1 EQT15 EQU EQT14+1 SPC 1 * * FBITS BIT EQUIVALENCES * FW EQU 000000B WAIT FOR READ FOR FRONT PANEL MESSAGES * SHOULD BE 100000B RC EQU 40000B RECONNECTION AFTER POWER-FAIL WANTED SE EQU 20000B SEVERE ERROR OCCURRED ON CARD AC EQU 10000B CARD HAS BEEN ASKED TO CONNECT ND EQU 4000B LINK IS IN NON-DS MODE SM EQU 2000B START OF DS 1 MESSAGE LC EQU 1000B LINE IS LOGICALLY CONNECTED LT EQU 400B LONG TIMEOUT RUNNING MT EQU 200B MEDIUM TIMEOUT RUNNING ST EQU 100B SHORT TIMEOUT RUNNING WL EQU 40B BACKPLANE LOCKED TO WRITE PROCESS RL EQU 20B BACKPLANE LOCKED TO READ PROCESS * BOTH SET SAY BACKPLANE BUSY WP EQU 10B WRITE REQUEST PENDING RP EQU 4B READ REQUEST PENDING WA EQU 2B REQUEST ON WRITE PROCESS ABORTED RA EQU 1B REQUEST ON READ PROCESS ABORTED SPC 1 * #* FMISC BIT EQUIVALENCES * TW EQU 60000B CARD OUTPUT MESSAGE TYPE * SHOULD BE 160000B TR EQU 16000B CARD INPUT MESSAGE TYPE FM EQU 1000B FRONT PANEL MESSAGE SEEN CI EQU 400B MUST SEND CONNECT INDICATION LU EQU 377B LOGICAL UNIT NUMBER OF CARD SPC 1 * * OTHER EQUIVALENCES * A EQU 0 B EQU 1 SCODE EQU 0 DCPCL EQU 2 DCPCH EQU 6 SPC 1 * * DECIMAL AND OCTAL CONSTANTS * .0 DEC 0 .1 DEC 1 .2 DEC 2 .3 DEC 3 .4 DEC 4 .5 DEC 5 .6 DEF 6 .7 DEC 7 .8 DEC 8 B10 EQU .8 .9 DEC 9 B11 EQU .9 .10 DEC 10 B12 EQU .10 B13 OCT 13 .50 DEC 50 B77 OCT 77 B100 OCT 100 B377 OCT 377 B400 OCT 400 B600 OCT 600 B1000 OCT 1000 B4000 OCT 4000 B7777 OCT 7777 B10K OCT 10000 B30K OCT 30000 B40K OCT 40000 BIT15 OCT 100000 MB1K1 ABS -1000B-1 MB400 OCT -400 M20 DEC -20 M5 DEC -5 M3 DEC -3 M2 DEC -2 M1 DEC -1 SPC 1 * * I/O CHANNEL RECONFIGURATION TABLE * SCTPT DEF *+1,I DEF SCCON DEF SC101 DEF SC201 DEF SC202 DEF SC301 DEF SC303 DEF SC304 DEF SC401 DEF SC402 DEF SC403 DEF SC404 DEF SC405 DEF SC406 DEF SC407 DEF SC408 DEF SC409 DEF SC410 DEF SC411 DEF SC412 DEF SC413 DEF M1 SPC 1 * * DCPC CHANNEL RECONFIGURATION TABLE * DCTPT DEF *+1,I DEF DCCON DEF DC401 DEF DC402 DEF DC403 DEF DC404 DEF DC405 DEF DC406 DEF DC407 DEF DC409 DEF DC410 DEF M1 SPC 1 * * ERROR CODES * #LFAL EQU .1 #TMOT EQU .2 #LBUS EQU .3 #MEAB EQU .4 #NOIN EQU B10 #WRMD EQU B11 #ILRQ EQU B12 #RBUS EQU .5 #SERR EQU B13 SPC 1 * * CARD COMMANDS * DCPCC EQU SCCON DCPC CONTROL WORD * !NOOP EQ$PU B40K NO OPERATION (CANCELS UNSOLICITED INPUT) !UNST OCT 50000 ENABLE UNSOLICITED STATUS INPUT !UNDS OCT 45401 ABORT UNCOLICITED STATUS INPUT !ABDM OCT 45402 ABORT DMA TRANSFER !OTBF OCT 43001 ALLOCATE OUTPUT BUFFERS !NMT OCT 40400 NEW MESSAGE TYPE !OTTR EQU BIT15 OUTPUT DATA TRANSFER !SMB EQU B10K START OF MESSAGE BIT FOR !OTTR !INTR EQU .0 INPUT DATA TRANSFER !RSET OCT 57400 RESET !MIFL OCT 42400 WHAT IS MAXIMUM I FIELD? !R2WD OCT 45002 READ 2 WORDS FROM BUFFER !TIME OCT 140401 SET CARD TIMEOUT !CNCT OCT 41400 CONNECT !DSCN OCT 41000 DISCONNECT !DCRD OCT 46000 DISCARD INPUT FRAME !ADBP OCT 52400 ADVANCE BUFFER POINTER !PWUP OCT 77400 POWER UP ACKNOWLEDGE !BRK OCT 50400 SEND BREAK FRAME !SIDT OCT 44000 SET INTERNAL DATA TYPE !STGD OCT 135336 GOOD POWER UP STATUS !STG2 OCT 177164 OTHER GOOD POWER UP STATUS SPC 1 * * PARAMATERS AND POINTERS * SHORT EQU .10 COUNTER FOR SHORT TIME MDIUM EQU .50 MEDIUM TIMEOUT LONG DEC 1500 15 SECOND TIMEOUT VLONG DEC 3000 30 SECOND TIMEOUT RRLIM DEC -20 READ RETRY LIMIT FNMBR DEC 29150 SECURITY CODE FOR QUEUE RINIA DEF RINI WINIA DEF WINI RSERA DEF RSER WSERA DEF WSER WPFLA DEF WPFL RCNTA DEF RCONT-1,I QUEUE ASC 3,QUEUE PROGRAM THAT MAKES READ REQUESTS SPC 1 * * BIT MASKS * TRB ABS TR FMB EQU B1000+FM-FM CIB EQU B400+CI-CI LUB EQU B377+LU-LU FWB EQU BIT15+FW-FW RCB ABS RC SEB ABS SE ACB EQU B10K+AC-AC NDB EQU B4000+ND-ND SMB ABS SM LCB EQU B1000+LC-LC LTB ABS LT MTB ABS MT STB EQU B100+ST-ST WPB EQU .8+WP-WP RPB EQU .4+RP-RP WALCB ABS WA+LC LCRCB ABS LC+RC M4B ABS LC+RC+ND+100000B+FW-FW BUSYB ABS AC+WP+RP+WL+RL TWB ABS 160000B+TW-TW FMNB EQU MB1K1+FM-FM CINB ABS -CI-1 PWUPB ABS SE+RC+WP+RP WLRLB ABS WL+RL SERCN ABS -SE-RC-1 XTNB ABS -ST-MT-LT-1 XCNB ABS -AC-RC-LC-1 LCNB EQU MB1K1+LC-LC RPUNB EQU M5+RP-RP WANB EQU M3+WA-WA SPC 3 BSS 0 FIND HOW MUCH SPACE WE TAKE END * 0$U 91750-18108 2013 S C0122 &DVG67              H0101 wbASMB,Q,C HED DVG67 RTE 12889 BISYNC DRIVER * (C) HEWLETT-PACKARD NAM DVG67,0,0 91750-16108 REV.2013 800519 MEF: 3000 HSI LINK SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT IG67,CG67 EXT $CGRN SPC 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: DVG67 *SOURCE: 91750-18108 * RELOC: 91750-16108 * PGMR: DMT LST ************************** DVG67 ************************** * * * SOURCE: 91750-18108 * * * * BINARY: 91750-16108 * * * * TOM KEANE * * * * JUNE 24, 1976 * * * *********************************************************** * * * MODIFIED BY DMT BEGINNING 5/29/79 TO REMOVE UNUSED CODE * * AND MAKE THE COMMENTS READABLE. * * * *********************************************************** SPC 2 A EQU 0 B EQU 1 SC EQU 0 CHAN EQU 1673B SPC 1 * THE FOLLOWING DRIVER WAS WRITTEN FOR A DOS III * * PHYSICAL LEVEL DRIVER. * * RTE EQT TABLE AND INTERNAL STORAGE NAME EQT01 EQU 1660B EQT04 EQU 1663B STAT1 EQT0c5 EQU 1664B STAT2 EQT06 EQU 1665B CONWD EQT07 EQU 1666B PARM1 EQT08 EQU 1667B PARM2 EQT09 EQU 1670B EQT13 EQU 1772B TRLOG EQT15 EQU 1774B SKP **************************************************** * * * CONTINUATOR SECTION * * * **************************************************** * MODIFIED TO CHECK FOR SPURIOUS INTERRUPT BY DMT (7/11/78) CG67 NOP LDB EQT01,I SPURIOUS SZB,RSS INTERRUPT? JMP SPURI YES--IGNORE. SPRTN CLB ZERO RETURN STB SAVA CODE. STA SCODE SAVE SELECT CODE. JSB INTON TEST INTERRUPT SYSTEM. CLA,INA SET RETURN STA RTX FLAG. LDA EQT04,I WAS IT ALF TIMER SSA,RSS INTERRUPT? JMP WEND NO. LDA EQT04,I YES. RESET AND PAROF TIMER STA EQT04,I BIT. JMP LTIM JUMP TO TIMER ROUTINE. * WEND LDB LSIT GET TABLE BASE. JMP LSWCH GO PROCESS. SPC 2 * SPURIOUS INTERRUPT-- SPURI LDB SWORD IF WE'RE EXPECTING SZB AN ENQ, JMP SPRTN NOT SPURIOUS. SPUR2 STB EQT15,I ZERO TIME-OUT CLOCK WORD. * * KEEP LONG-TERM COUNT FOR # OF SPURIOUS INTERRUPTS * IN UNUSED "# ERROR-FREE MSGS RECEIVED" EQT EXTENSION WORD. * LDB P03$ BUMP JSB BUMP STATISTIC. ISZ CG67 MAKE A JMP CG67,I CONTINUATION RETURN. SKP **************************************************** * * * INITIATOR SECTION * * * **************************************************** IG67 NOP CLB STB RTX CLEAR RETURN FLAG. STB SAVA ZERO RETURN CODE. STA SCODE SAVE SELECT CODE.PH JSB INTON TEST INTERRUPT SYSTEM. LDA EQT09,I GET REQUEST. AND MASK1 ISOLATE FUNCTION AND REQUEST. CPA INCD INITIALIZE REQUEST? JMP I.67B YES. AND MASK2 CPA B4400 CLEAR REQUEST? JMP I.67A YES. LDB EXTSN SZB LOGICAL LINKAGE PRESENT? JMP I.67A YES. CLA,INA NO. INVALID REQUEST. STA SAVA RETURN TO JMP RTRN SYSTEM. * * HANDLE INITIALIZE REQUEST I.67B LDB EQT07,I GET EXTENSION ADDRESS. STB EXTSN LINK WITH LOGICAL. * SET UP POINTERS INTO EQT EXTENSION LDA B,I GET CONTENTS OF D$EQT STA TRLWA & STORE AS LAST TRACE ENTRY. INB STB TSBTS TEST BITS LDA B,I GET CONTENTS. AND N64$ MASK OUT PARITY & CHAR SIZE. IOR P08$ SPEC NO PARITY & 8-BIT BYTE. STA B,I STORE. ADB P02$ STB NTRY NUMBER OF RETRIES INB STB NLTO # OF 3-SECS IN LONG T/O INB STB PRVAC PREV & CURRENT ACTIONS INB STB PRVST PREV-1 & PREV STATES INB STB ENVIR ENVIRONMENT LDA B,I GET CONTENTS. IOR BIT14 SET "ASCII" BIT. STA B,I STORE. INB STB LTCS LONG-TERM COMM STATISTCS ADB P11$ STB TRNEW ADDR OF NEWST TRACE NTRY INB STB TROLD ADDR OF OLDST TRACE NTRY INB STB TRFWA TRACE TABLE 1ST WORD STB TROLD,I INITIALIZE OLDEST AND STB TRNEW,I NEWEST ADDRESSES. INB STB TRFWA,I START FIRST ENTRY. * CLA STA STAT2 CLEAR LINE STATE STA CONWD AND TEST BITS. * I.67A LDB EQT05,I SET UP STB STAT1 INTERNAL LDB EQT07,I EQT STB PARM1 VALUES. LDB EQT08,I STB PARM2 LDB EQT13,I STB TRLOG  LDA CONWD GET DMA AND DMAMF CHANNEL IOR DMAA AND LDB CHAN SET SLB ALLOCATED IOR DMAM FLAG. STA CONWD LDA STAT1 SET AND LBYT$ STATUS STA STAT1 TO ZERO. LDA SCODE GET SELECT CODE. JSB SETIO SET I/O INSTRUCTIONS. LDA EQT09,I GET CONTROL WORD. AND MASK2 ISOLATE FUNCTION CODE. CPA B4400 CLEAR REQUEST? JMP C0 YES. LDA EQT06,I GET CURRENT I/O WORD. AND B17$ ISOLATE BITS 0-3. CPA P02$ WRITE OR CONTROL REQUEST? JMP TWOPR YES. CHECK OPTIONAL PARAM. * CPA P01$ READ REQUEST? JMP READR YES. ISZ SAVA INDICATE ERROR JMP RTRN AND RETURN TO SYSTEM. * * BECAUSE RTE CONTROL REQUESTS CANNOT PASS ENOUGH PARAMETERS, * SOME WRITE REQUESTS MAY ACTUALLY BE CONTROL REQUESTS. * TWOPR LDA EQT09,I GET OPTIONAL PARAMETER. AND N64$ REMOVE LOGICAL UNIT. IOR P02$ INSERT REQUEST CODE. STA EQT06,I STORE IN CONTROL WORD. AND BIT14 IF BIT 14 IS SET, SZA IT'S A CONTROL JMP CONTL REQUEST. SPC 2 **************************************************** * * * WRITE REQUEST INITIATION * * * **************************************************** STA SWORD CLEAR "WAITING FOR ENQ" FLAG. JSB SLCW CALL LOGICAL WRITE (HSLC). JMP DONE COMPLETION RETURN. JSB SETMR CONTINUATION RETURN. JMP RTRN RETURN TO SYSTEM. SPC 4 **************************************************** * * * READ REQUEST INITIATION * * * **************************************************** READR LDA EQT09,I GET CONTRADOL WORD. AND N64$ REMOVE LOGICAL UNIT. IOR P01$ INSERT REQUEST CODE. STA EQT06,I STORE CONROL WORD TO SYSTEM. AND MASK2 IS IT THE CPA B4500 SPECIAL READ? JMP SPECR YES. * CLA,INA JSB SLCR CALL LOGICAL READ (HSLC). JMP DONE COMPLETION RETURN. JSB SETMR CONTINUATION RETURN. JMP RTRN RETURN TO SYSTEM. * SPECR STA SWORD SET SPECIAL CASE. LDA PARM1,I GET RN PARAMETER. STA RNUMB STORE. JSB RDMA INHIBIT DMA INTERRUPTS. LDA IO05A START STA STDMA INSTRUCTION. LDA RECV LINE STATE STA STAT2 EQUALS RECEIVE. JSB READP ENABLE INTERFACE. JMP DONE1 IMMEDIATE COMPLETION. SKP **************************************************** * * * CONTROL REQUEST INITIATION * * * **************************************************** CONTL LDA EQT06,I CURRENT I/O WORD. XOR CONOF SET BIT 14 OFF, 1 ON. STA EQT06,I RESTORE SYSTEM CONTROL WORD. CLA JSB SLCC CALL LOGICAL CONTROL (HSLC). JMP DONE1 COMPLETION RETURN. LDA EQT06,I GET CONTROL WORD. ALF,ALF ISOLATE RAL,RAL FUNCTION AND B77$ CODE. ADA N04$ FUNCTION LESS SSA,RSS THAN FIVE? JMP CNTL1 NO. INVALID. ADA CNTLT YES. CALCULATE LDA A,I TABLE ADDRESS. JMP A,I PROCESS BY FUNCTION CODE. SPC 1 * INVALID REQUEST CNTL1 ISZ STAT1 INDICATE INVALID JMP DONE1 REQUEST AND RETURN. SPC 3 *--------------------------------------------------+ * CONTROL TRANSFER TABLE ! *--------------------------------------------------+ DEF C0 CLEAR DEF DONE1 INITIALIZE(NO ADDITIONAL PROCESS) DEF C2 LINE OPEN T DEF C3 LINE CLOSE CNTLT DEF * SPC 1 *--------------------------------------------------+ * CLEAR REQUEST ! *--------------------------------------------------+ C0 JSB CLC.C CLEAR INTERFACE. JSB RDMA RELEASE DMA. CLA BREAK STA EXTSN LINKAGE. LDA IDLE LINE STATE STA STAT2 EQUALS IDLE. JMP DONE1 RETURN. SPC 1 *--------------------------------------------------+ * LINE OPEN REQUEST ! *--------------------------------------------------+ C2 LDA TSBTS,I GET TEST BITS. RAL PRIMARY SSA STATION? JSB SETBT YES. SET INDICATOR. LDA AOPEN LINE STATE STA STAT2 EQUALS OPEN. JMP DONE1 RETURN. * SETBT NOP LDA CONWD GET TEST BITS. IOR BIT10 SET PRIMARY STATION. STA CONWD STORE WORD. JMP SETBT,I SPC 1 *--------------------------------------------------+ * LINE CLOSE REQUEST ! *--------------------------------------------------+ C3 JSB CLC.C CLEAR INTERFACE. JSB RDMA RELEASE DMA. LDA CLOSE LINE STATE STA STAT2 EQUALS CLOSED. JMP DONE1 RETURN. SPC 3 ******************************************************** * * * ENTER HERE IF HSLC INDICATED COMPLETION FROM READ, * * WRITE, OR CONTROL INITIATION. (P+1 RETURN) * * * ******************************************************** * DONE LDA IDLE SET LINE STATE STA STAT2 TO IDLE. LDA RTX IF FROM INITIATOR, SZA DO IMMEDIATE COMPLETION. JMP RTRN * DONE1 LDA P04$ INDICATE IMMEDIATE STA SAVA COMPLETION. JMP RTRN RETURN TO SYSTEM. SKP ************************************************ * * * LOGICAL TIMER * * * ************************************************ LTIM LDB LSTT GET TABLE BASE. * LSWCH ADB STAT2 PROCESS LDB B,I BY LINE JMP B,I STATE. SPC 2 *--------------------------------------------------+ * LOGICAL STATE TABLE FOR TIMER ! *--------------------------------------------------+ LSTT DEF *+1 DEF RTRN 0-CLOSED DEF RTRN 1-AWAITING OPEN DEF RTRN 2-IDLE DEF LSTC 3-RECEIVE DEF LSTD 4-CONTROL DEF LSTE 5-SEND DEF LSTE 6-SEND TO RECEIVE SPC 2 *--------------------------------------------------+ * LOGICAL STATE TABLE FOR CONTINUATION ! *--------------------------------------------------+ LSIT DEF *+1 DEF RTRN 0-CLOSED DEF RTRN 1-AWAITING OPEN DEF RTRN 2-IDLE DEF LSIC 3-RECEIVE DEF LSID 4-CONTROL DEF LSIE 5-SEND DEF LSIF 6-SEND TO RECEIVE SKP **************************************************** * * * SET UP I/O INSTRUCTIONS * * * **************************************************** SETIO NOP ADA ISTCC FORM STC INSTRUCTION STA IO07 STA IO08 STA IO09 STA IO10 ADA ICLCC FORM CLC INSTRUCTION STA XIO02 ADA IOTA FORM OTA INSTRUCTION STA XIO03 ADA ILIA FORM LIA INSTRUCTION STA XIO05 ADA ISTF FORM STF INSTRUCTION STA IO06 * * CONFIGURE DMA LOW SC INSTRUCTIONS * LDB P02$ LDA CONWD AND DMAM SZA INB ADB ISTCC STB IO02 ADB ICLCC STB IO00 ADB IOTA STB IO01 n STB IO03 ADB ILIA STB IO15 * * CONFIGURE DMA HI SC INSTRUCTIONS * ADB .ISTC STB IO05 ADB ICLCC STB IO05A STB IO05B ADB IOTA STB IO04 ADB ISTF0 STB IO13 STB IO14 JMP SETIO,I SKP **************************************************** * * * SET RTE TIMER * * * * B=TIME (CENTISECONDS) * * <0-INITIATE/UPDATE VALUE * * =0-NO REQUEST * * >0-CANCEL REQUEST * * * **************************************************** SETMR NOP STB EQT15,I STORE TIMER COUNT. LDA EQT04,I TELL SYSTEM IOR BIT12 WE WILL SERVICE STA EQT04,I TIMER INTERRUPTS. JMP SETMR,I RETURN. SPC 2 **************************************************** * * * START READ * * * * A-REG = ADDRESS, B-REG = BYTE COUNT * * * **************************************************** HREC NOP STA ADDR STORE OFF STB LNGTH PARAMETERS. LDB HREC,I GET TIMER PARAMETER. ISZ HREC IF TIMER REQUESTED, SZB JSB SETMR GO SET IT. LDA RECV LINE STATE STA STAT2 EQUALS RECEIVE. JSB RDMA RELEASE DMA. LDA ADDR GET BOTH LDB LNGTH PARAMETERS. BRS CHANGE BYTES TO WORDS. IOR BIT15 SET INPUT. JSB INDMA SET UP DMA. SZB,RSS DO NOT START JMP NONDM IF LENGTH = 0. LDA IO05 FOR DMA STA STDMA TRANSFER LDA OCONWD SET BIT INDICATING IOR DMAA WE ARE USING STA CONWD DMA. LDA IO05A STA STDMA+1 JMP DMARD * NONDM JSB RDMA INHIBIT DMA INTERRUPTS. LDA IO05A START INSTRUCTION. STA STDMA * DMARD JSB READP LDA SWORD SPECIAL SZA,RSS CASE? JMP CRTN CONTINUATION RETURN TO SYSTEM. CLA RESET STA SWORD SPECIAL CASE FLAG. LDA EBIT EOT SZA,RSS RECEIVED? JMP ENQR NO. FAKE ENQ. CLA YES. CLEAR STA EBIT TEST WORD. JMP EOTR FAKE EOT. SPC 1 INDMA NOP IO00 CLC DMAL,C INITIALIZE DMA ROUTINE. IO01 OTA DMAL SET ADDRESS. IO02 STC DMAL,C LDA B SET COUNT. IO03 OTA DMAL LDA SCODE SET SELECT CODE. IO04 OTA DMAH JMP INDMA,I RETURN. SPC 2 **************************************************** * * * START WRITE * * * * A-REG = ADDRESS, B-REG = BYTE COUNT * * * **************************************************** HSND NOP STA ADDR STORE STB LNGTH PARAMETERS. LDB HSND,I TIMER ISZ HSND PARAMETER? SZB JSB SETMR YES. SET TIME. LDA SEND LINE STATE STA STAT2 EQUALS SEND. IO07 STC SC,C SET INTERFACE CONTROL WORD. LDA TCWD1 JSB OTA JSB RDMA RELEASE DMA. LDA ADDR INITIALIZE DMA LDB LNGTH AND SET STB TRLOG XLOG. BRS CHANGE BYTES TO WORDS. JSB INDMA INITIALIZE DMA. SZB,RSS DO NOT START JMP NODMW IF LENGTH = 0. LDA CONWD SET BIT INDICATING IOR DMAA WE ARE USING STA CONWD DMA. IO05 STC DMAH,C START DMA. IO05A CLC DMAH,C IO06 STF SC START TRANSFER. JMP CRTN CONTINUATION RETURN TO SYSTEM. * NODMW JSB RDMA INHIBIT DMA INTERRUPTS. JMP IO05A RETURN. SPC 3 **************************************************** * * * WRITE ONE WORD OUT * * CONTROL REQUEST * * * **************************************************** HCONT NOP STA ADDR STORE ISZ HCONT PARAMETER. LDA CNTRR LINE STATE STA STAT2 EQUALS CONTROL. JSB RDMA INHIBIT DMA INTERRUPTS. IO10 STC SC,C SET INTERFACE CONTROL WORD. LDA TCWD5 JSB OTA LDA ADDR,I GET CHARACTER. JSB OTA JMP CRTN CONTINUATION RETURN TO SYSTEM. SPC 2 *--------------------------------------------------+ * CONTROL INTERRUPT ! *--------------------------------------------------+ LSID CLA,RSS NORMAL COMPLETION. * LSTD LDA P15$ TIMEOUT. JMP HCONT,I RETURN TO LOGICAL. SPC 2 *--------------------------------------------------+ * SEND INTERRUPT ! * WRITE END OF TEXT ! *--------------------------------------------------+ LSIE JSB RDMA RELEASE DMA. LDA TCWD3 END OF TEXT. JSB CLC.C SEND ETX. JSB OTA LDA TRLOG MODIFY CMA,INA AND B17$ ETX ALF,ALF BY ALF BYTE IOR ETX COUNT. JSB OTA JSB WAIT LDA TCWD4 SEND CRC. JSB CLC.C JSB OTA JSB OTA DUMMY WORD. JSB WAIT LDA S2R LINE STATE EQUALS STA STAT2 SEND TO RECEIVE. LDA IO05A INHIBIT DMA. STA STDMA START INSTRUCTION. JSB READP READ GARBAGE CHARACTER. LSIF CLA RETURN TO CLB iE LOGICAL. JMP HSND,I COMPLETION. * LSTE LDA P15$ TIMEOUT. JMP HSND,I RETURN TO LOGICAL. SPC 1 * WAIT NOP SUBROUTINE TO WAIT LDA DELAY SEVERAL MICRO-SECONDS CHK SLA,RAR SO HP3000 WON'T JMP WAIT,I MISS ANY DATA. JMP *+1,I DEF CHK SPC 2 *--------------------------------------------------+ * ENABLE INTERFACE TO READ ! *--------------------------------------------------+ READP NOP LDA RCWD1 SET CONTROL WORD. JSB CLC.C JSB OTA JSB LIA READ 1 OR 2 JSB LIA DATA WORDS. IO08 STC SC,C SET CONTROL, CLEAR FLAG, JSB LIA AND CLEAR THE STATUS WORD. STDMA NOP [OVERLAY WITH START DMA INST.] NOP [OVERLAY WITH CLC DMAH.] CLA CLEAR THE START DMA INST. STA STDMA STA STDMA+1 JMP READP,I RETURN TO CALLER. SPC 2 *--------------------------------------------------+ * PROCESS END OF TEXT ! *--------------------------------------------------+ PETX EQU * IO14 STF DMAH INHIBIT DMA XFERS. IO15 LIA DMAL GET CHARACTER COUNT. STA MOD16 SAVE IT. JSB WAIT WAIT FOR HP 3000. JSB CLC.C READ STATUS JSB LIA WORD. JSB LIA READ CRC WORD. LDA TCWD4 TRANSMIT JSB CLC.C CRC JSB OTA TO JSB OTA CHECK IT. JSB WAIT JSB CLC.C READ STATUS & JSB LIA CHECK AND P02$ ERROR SZA BITS. JMP BTEXT CRC ERROR. LDA MOD16 CHECK MODULO COUNT. LDB LNGTH NEGATIVE BYTE COUNT. CMB,INB MAKE IT POSITIVE BRS WORDS. STB LNGTH ADA LNGTH ADD WORD COUNT. ALS MAKE POSITIVE BYTES. STA TRLOG STORE IN XMISSION LOG. ALF,ALF ALF XOR XTE AND BMNIB3 MASK FOR ERROR. SZA JMP BTEX1 JSB RDMA RELEASE DMA. LDA P10$ GOOD TEXT. JMP HREC,I RETURN TO LOGICAL. * BTEXT LDA P11$ CRC ERROR. JMP LRTN RETURN TO LOGICAL. * * BTEX1 LDA P12$ TEXT UNDERRUN. JMP LRTN RETURN TO LOGICAL. SPC 2 *-----------------------------------------------------+ * RECEIVE INTERRUPT ! *-----------------------------------------------------+ LSIC LDA SCODE ADA N08$ IGNORE SSA DMA JMP CRTN INTERRUPTS. JSB CLC.C READ INTERRUPT. JSB LIA TAG1 WORD? SLA NO, JUST DATA WORD. JMP RTAG1 YES. WENDC STC SC,C REENABLE INTERFACE. JSB LIA JSB LIA JMP CRTN CONTINUATION RETURN TO SYSTEM. * RTAG1 JSB LIA LOAD TAG1 WORD. STA XTE SAVE CHARACTER. AND MASK0 CLEAR HI-ORDER BIT. CPA ACK0 CHARACTER = JMP ACK0R ACK0 CPA ENQ CHARACTER = JMP ENQR ENQ CPA EOT CHARACTER = JMP EOTR EOT CPA ACK1 CHARACTER = JMP ACK1R ACK1 CPA WACK CHARACTER = JMP WACKR WACK CPA RVI CHARACTER = JMP RVIR RVI CPA NAK CHARACTER = JMP NAKR NAK CPA DEOT CHARACTERS = JMP DEOTR DLE EOT CPA TTD CHARACTERS = JMP TTDR STX ENQ/ABORTED TEXT AND MASK1 HI-ORDER BITS. CPA ETX CHARACTER = JMP PETX ETX/PROCESS CRC JMP BTEXT NO RECOGNIZABLE CHARACTERS. XTE OCT 0 IO09 EQU WENDC SPC 1 ACK0R CLA,INA JMP LRTN SPC 1 ACK1R LDA P02$ JMP LRTN SPC 1 WACKR LDB P10$ BUMP WACK/TTD JSB BUMP LONG-TERM STAT. LDA P03$ JMP LRTN SPC 1 RVIR LDA P04$ JMP LRTN SPC 1 ENQR LDA P05$ LDB SWORD  WAITING FOR SZB,RSS LINE BID? JMP HREC,I NO. TAKE LOGICAL RETURN. JMP SCASE YES. SPECIAL CASE. SPC 1 NAKR LDB P05$ BUMP NAK JSB BUMP LONG-TERM STAT. LDA P06$ JMP LRTN SPC 1 EOTR LDA P07$ LDB SWORD WAITING FOR SZB,RSS LINE BID? JMP HREC,I NO. TAKE LOGICAL RETURN. STA EBIT SET EOT RECEIVED. * SCASE LDA RNUMB UNLOCK RN. JSB $CGRN CLA,INA STA TRLOG JMP CRTN CONTINUATION RETURN TO SYSTEM. SPC 1 DEOTR LDA P08$ JMP LRTN SPC 1 TTDR LDA P09$ JMP LRTN SPC 2 LSTC LDA P15$ TIMEOUT. JMP HREC,I RETURN TO LOGICAL. SPC 3 * IF DVG67 WAS IN "SPECIAL READ" STATE (WAITING FOR LINE BID) AND * SOMETHING OTHER THAN ENQ OR EOT CAME DOWN THE LINE, HANDLE AS A * SPURIOUS INTERRUPT. OTHERWISE RETURN TO LOGICAL DRIVER. * LRTN LDB SWORD WAS DRIVER WAITING SZB,RSS FOR LINE BID (ENQ)? JMP HREC,I NO. RETURN TO LOGICAL. CLB YES. TREAT AS A JMP SPUR2 SPURIOUS INTERRUPT. SKP ******************************************************* * * * INTERFACE COMMANDS * * * ******************************************************* CLC.C NOP XIO02 CLC SC,C JMP CLC.C,I SPC 1 OTA NOP XIO03 OTA SC JMP OTA,I SPC 1 LIA NOP XIO05 LIA SC JMP LIA,I SPC 4 **************************************************** * * * COMMON RETURN * * * **************************************************** * * CONTINUATION RETURN AT CRTN; COMPLETION AT RTRN * CRTN ISZ CG67 INCREMENT FOR CONTINUATION. * RTRN LDA STAT1 GET SLC STATUS. STA EQT05,I LDB TRLOG GET TRANSMISSION LOG. LDA RTX DETERMINE SZA,RSS RETURN TYPE. JMP RTRN1 IG67. * LDA SAVA COMPLETION STATUS. ISZ IFLAG IF INTERRUPT SYSTEM ON, STF 0 ENABLE INTERRUPTS. JMP CG67,I RETURN TO SYSTEM. * RTRN1 LDA SAVA ISZ IFLAG STF 0 JMP IG67,I SKP * SUBROUTINE TO BUMP LONG-TERM STATISTIC. * CALLING SEQUENCE: LDB * JSB BUMP * BUMP NOP ENTRY. ADB LTCS ADD BASE ADDRESS. ISZ B,I BUMP IT. NOP IN CASE OF ROLL-OVER. JMP BUMP,I RETURN. SPC 4 * * SET "INTERRUPT ON" FLAG * INTON NOP CCB ASSUME ON. SFC 0 IF NOT, CLB USE 0. STB IFLAG STORE INTERRUPT FLAG. JMP INTON,I SPC 2 * * DMA IS NOT REQUIRED. INHIBIT IT. * RDMA NOP LDA CONWD CLEAR DMA AND DMAA IF CHANNEL SZA,RSS IS JMP RDMA1 ALLOCATED. IO05B CLC DMAH,C IO13 STF DMAH RDMA1 LDA CONWD AND DMAMF STA CONWD JMP RDMA,I SKP **************************************************** * * * STORAGE & CONATANTS * * * **************************************************** SPC 1 * INTERNAL EQT VALUES. * STAT1 NOP STATUS STAT2 NOP LINE STATE CONWD NOP I/F CONTROL WORD PARM1 NOP PARAMETER 1 PARM2 NOP PARAMETER 2 TRLOG NOP TRANSMISSION LOG * EXTSN NOP EXTENSION LINK TSBTS NOP BOARD PARAMETERS ADDR NOP ADDR PARAMETER FOR HREC, HSND & HCONT LNGTH NOP LENGTH PARAMETER FOR HREC, HSND & GTEXT SPC 2 EBIT NOP IFLAG NOP MOD16 NOP RNUMB NOP RTX NOP SAVA NOP SCODE NOP SWORD NOP SPC 2 N04$ DEC -4 N08$ DEC -8 N64$ DEC -64 P00$ DEC 0 P01$ DEC 1 P02$ DEC 2 P03$ DEC 3 P04$ DEC 4 P05$ DEC 5 P06$ DEC 6 P07$ DEC 7 P08$ DEC 8 P09$ DEC 9 P10$ DEC 10 P11$ DEC 11 P12$ DEC 12 P15$ DEC 15 P67$ DEC 67 B17$ EQU P15$ B77$ OCT 77 B4400 OCT 4400 B4500 OCT 4500 LBYT$ OCT 177400 BIT15 OCT 100000 BIT14 OCT 40000 BIT12 OCT 10000 BIT11 OCT 4000 BIT10 OCT 2000 BIT9 OCT 1000 BIT6 OCT 100 AOPEN EQU P01$ CLOSE EQU P00$ CNTRR EQU P04$ CONOF OCT 40001 DELAY EQU BIT15 DMAA EQU BIT9 DMAMF OCT 172777 DMAM EQU BIT11 DMAL EQU 0 DMAH EQU 0 ETX OCT 1775 ICLCC EQU BIT11 IDLE EQU P02$ ILIA EQU N64$ IOTA OCT 172700 INCD EQU P67$ ISTCC OCT 103700 .ISTC OCT 1204 ISTF EQU LBYT$ ISTF0 OCT 177300 MASK0 OCT 77777 MASK1 OCT 7777 MASK2 OCT 7700 NIB3 OCT 170000 PAROF OCT 173777 RECV EQU P03$ RCWD1 OCT 2404 SEND EQU P05$ S2R EQU P06$ TCWD1 EQU P04$ TCWD3 EQU BIT6 TCWD4 EQU BIT11 TCWD5 EQU BIT6 SKP ******************************************************* * * * * * BEGINNING OF OLD HSLC CODE. * * * * MODIFIED BY DMT ON MAY 30, 1978 TO REMOVE UNUSED * * CODE, MOSTLY IN THESE AREAS * * EBCDIC CHARACTER HANDLING * * LCR BLOCK CHECK (CRC ONLY IS USED) * * ID SEQUENCE CHECKING/SENDING * * CHARACTER CHECK UPON RETURN FROM DRIVER * * * * FURTHER CLEANUP DONE ONE YEAR LATER. * * * ******************************************************* SPC 2 * * SLC (HSI VERSION) * TOM KEANE * JULY 1, 1975 * SKP * SLC CONTROL ROUTINE FOR LOGICAL DRIVER * SLCC NOP LDB SLCC GET RETURN ADDRESS JSB SETUP SET UP RETURN ADDR & PTRS LDB B300 SPECIFY CONTROL: REQ CODE OFFSET JSB TRAIN GET FUNCTION & INIT TRACE ENTRY CPA P01$ INITIALIZE? JMP CF01 YES CPA P02$ LINE OPEN? JMP CF02 YES CPA P03$ LINE CLOSE? JMP CF02 YES ADA M32 SUBTRACT OCT 40 FROM FUNCTION CPA P02$ CHANGE ERROR RECOVERY PARAMS? JMP CF42 YES CPA P03$ ZERO THE LONG TERM STATISTICS? JMP CF43 YES SSA,RSS FUNCTION BELOW 40? JMP SLCER NO,ERROR CLA YES CLB JMP PRET,I LET PHYSICAL (P+2) LOOK AT FUNCT * CF01 CLA SET STATE = 0 (UNOPENED) STA STATE * ------------------------------------------------- * COMPLETE "CONTINUATION" RETURN TO PHYSICAL * SLCPC LDA PRET SPECIFY CONTINUATION CLB & COMP STATUS = 0 = OK JMP SLCXT+2 * ------------------------------------------------- CF02 ADA M2 GET EVENT NO. (0 OR 1) JMP SEA GO TO STATE-EVENT-ACTION CIRCLE CF42 LDA EQT07,I GET SPECIFIED # LDA A,I CMA,INA MAKE NEGATIVE STA NTRY,I AND SAVE LDA EQT08,I GET # OF 3-SEC PERIODS IN LTO CMA,INA MAKE NEG STA NLTO,I & SAVE JMP SLCXT EXIT WITH STATUS =OK CF43 JSB ZSTAT ZERO THE LONG TERM STATISTICS JMP SLCXT EXIT WITH STATUS =OK * SLCER CLB,INB COMP STATUS =INVALID REQUEST =1 JMP SLCXT+1 * ------------------------------------------------- * COMPLETION RETURN TO PHYSICAL * SLCXT CLB COMPLETION STATUS =OK =0 LDA PRETF SPECIFY COMPLETION STA PRETV & SET UP RETURN LDA MPFLS AND M3 CLEAR SEND-CONTINUE FLAG (BIT 1) STA MPFLS LDA STAT1 AND HFF00 MASK OUT OLD COMP STATUS IOR B & PUT NEW ONE LDB BLKSP PLUS THE BLOCK SPEC BITS BLF (MOVED TO BITS 7-5) RBL,RBL SLB,RSS IS THIS A WRITE REQ? IOR B NO, PUT BLK SPEC INTO STATUS STA STAT1 RIGHT HALF OF EQT 4 * ------------------------------------------------- * ROUTINE TO COMPLETE TRACE TABLE ENTRY * AND B377 ALF,ALF MOVE COMPLETION STATUS TO LEFT LDB TRNEW,I B =ADDR OF CURRENT ENTRY WORD 1 JSB TRINC GET ADDR OF ENTRY WORD 2 IOR B,I MERGE IN REQUEST & FUNCTION CODE STA B,I & STORE BACK IN WORD 2 LDB TRNEW,I LDB B,I B = ADDR OF NEXT WORD TO BE FILLD STB TRTMP SAVE IT (NOW ADDR OF NEXT ENTRY) JSB TRINC GET ADDR OF WORD AFTER NEXT STB A JSB TRACE INIT WORD 1 FOR NEXT ENTRY LDB TRNEW,I B =ADDR OF CURRENT ENTRY WORD 1 LDA TRTMP A =ADDR OF NEXT ENTRY WORD 1 STA B,I RESTORE PTR TO NEXT ENTRY STA TRNEW,I & SET NEXT ENTRY =CURRENT ENTRY CLA CLB JMP PRETV,I RETURN TO PHYSICAL SPC 4 * SLC READ ROUTINE FOR LOGICAL DRIVER * SLCR NOP LDB SLCR GET RETURN ADDRESS JSB SETUP SET UP RETURN ADDR LDA NTRY,I STA RTCTR INIT RETRY CTR ISZ LTCS,I INC TOTAL # OF READ REQUESTS NOP NULL IN CASE OF ROLLOVER LDB B100 SPECIFY READ: REQ CODE OFFSET JSB TRAIN GET FUNCTION & INIT TRACE ENTRY SZA,RSS FUNCTION = 0? JMP SLCER YES,ERROR CPA P07$ FUNCTION = 7? JMP SLCER YES, ERROR INA GET EVENT NO. (2 THROUGH 7) STA CURRQ SAVE CURRENT READ REQ # JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 4 * SLC WRITE ROUTINE FOR LOGICAL DRIVER * Q SLCW NOP LDB SLCW GET RETURN ADDRESS JSB SETUP SET UP RETURN ADDR & PTRS LDA NTRY STA RTCTR INIT RETRY CTR CLB,INB B=ADDR OF WORD 1, LONG-TERM STAT JSB BUMP INC TOTAL # OF WRITE REQUESTS LDB B200 SPECIFY WRITE: REQ CODE OFFSET JSB TRAIN GET FUNCTION & INIT TRACE ENTRY ADB BIT10 SET BIT 10 TO IND WRITE STB BLKSP SAVE BLOCK SPEC BITS SLB,RSS TRANSPARENT TEXT TO BE SENT? JMP *+4 NO LDB ENVIR,I SSB LRC SPECIFIED? JMP SLCER YES, ERROR SZA,RSS FUNCTION = 0? JMP SLCER YES,ERROR ADA M7 SSA,RSS FUNCTION > 6? JMP SLCER YES, ERROR ADA P14$ GET EVENT NO. (8 THROUGH 13) JMP SEA GO TO STATE-EVENT-ACTION CIRCLE * HE000 OCT 160000 OCT 160000 SKP * STATE-EVENT-ACTION CIRCLE -- A STATE-TRANSITION PROCESSOR * * CALLING SEQUENCE: * (A) = EVENT # * (P) = JMP SEA * (A) = MESSAGE PROCESSOR FLAGS * SEA STA EVENT SAVE EVENT # LDA PRVST,I GET PREVIOUS STATES, AND B377 ISOLATE PREV-1, ALF,ALF & MOVE TO LEFT HALF LDB STATE GET CURRENT STATE (NOW PREV) IOR B MERGE IN PREV STATE STA PRVST,I ADB STADT ADD STATE TABLE BASE, GET ENTRY STB A INA LDA A,I GET ADDR OF NEXT STATE STA NEXST LDB B,I GET CLUSTER HEADER ADDR PCLUS LDA B,I GET CLUSTER HEADER INB STB CLUST SAVE ADDR OF 1ST CLUSTER WORD CLB RRR 8 A = 1ST EVENT IN CLUSTER BLF,BLF & B = -1 + LENGTH OF CLUSTER CMA,INA ADA EVENT COMPUTE REAL EVENT - 1ST EVENT SSA RESULTS NEG (EVENT BELOW CLUST)? JMP SEAER YES, ERROR STA EVOFF SAVE EVENT OFFSET CMA,INA ADA B COMPUTE CLUSTER LENGTH -E OFFSET SSA RESULTS NEG (EVENT ABOVE CLUST)? JMP EVOUT YES LDB CLUST ADB EVOFF B = ADDR OF ACTION/NEXT STATE PR LDA B,I SEAF CLB RRR 8 A = ACTION INDEX BLF,BLF & B = NEXT STATE STB STATE STA CURAC SAVE ACTION LDA EVENT ALF,ALF GET WORD READY FOR TRACE TABLE: IOR B EVENT & RESULTANT STATE JSB TRACE LDA PRVAC,I AND B377 ISOLATE PREVIOUS ACTION ALF,ALF IOR CURAC MERGE IN CURRENT ACTION STA PRVAC,I & SAVE LDA CURAC ADA ACTAD A = ADDR OF APPROPRIATE ACTION: LDB A,I LDA MPFLS JMP B,I GO TO ACTION EVOUT ADB CLUST INB B = ADDR OF NEXT CLUSTER HEADER CPB NEXST ARE WE THROUGH WITH THIS STATE? JMP SEAER YES, ERROR SINCE EVENT NOT FOUND JMP PCLUS NO, PROCESS NEXT CLUSTER SEAER LDA BLOUT SET ACTION/NEXT STATE TO HANDLE JMP SEAF IMPROBABLE SITUATION * CLUST OCT 0 ADDR OF 1ST CLUSTER ENTRY CURAC OCT 0 CURRENT ACTION EVENT OCT 0 CURRENT EVENT # EVOFF OCT 0 OFFSET OF EVENT FROM CLUSTER NEXST OCT 0 ADDR OF ENTRY FOR NEXT STATE SPC 6 * SUBROUTINE SCM: SEND CONTROL MESSAGE (ID, IF ANY, HAS * BEEN SENT ALREADY) * (A) = INDEX OF MESSAGE TO BE SENT: * 0 = ENQ 5 = WACK * 1 = NAK 6 = RVI * 2 = EOT 7 = DLE EOT * 3 = ACK0 8 = TTD (STX ENQ) * 4 = ACK1 9 = SOH ENQ * SCM NOP STA SCMTP ADA ASCMA LDA A,I A = ADDR OF MESSAGE JSB HCONT NOP SZA SEND OK? JMP LOW NO, SET EVENT =LINE ERROR (LOW) LDA SCM GET RETURN FROM SCM JMP STXT4 INC # OF MESSAGES SENT SCMTP OCT 0 TEMP FOR SCM SKP <* SUBROUTINE SETUP: SET UP RETURN ADDRESSES TO PHYSICAL * DRIVER & EQTX POINTERS * (A) = A-REG PASSED BY PHYSICAL * (B) = P+1 RETURN OF CURRENT SLC ROUTINE * (P) = JSB SETUP * SETUP NOP STB PRETF SAVE P+1 (COMPLETION) ADDR INB STB PRET SAVE P+2 (CONTINUATION) ADDR JMP SETUP,I RETURN SPC 4 * SUBROUTINE STXT: SEND TEXT * STXT NOP LDA MPFLS AND HFFBF CLEAR MP TIMEOUT FLAG (BIT 6) STA MPFLS CLA STA TLOG ZERO TRANSMISSION LOG LDA PARM1 A = BUFFER ADDR LDB PARM2 JSB HSND NOP NOP SZA SEND OK? JMP LOW NO, SET EVENT =LINE ERROR(LOW) LDA NLTO,I STA TOCTR RESET LONG-TIME-OUT CTR LDA MPFLS AND M3 CLEAR SEND-CONTINUE FLAG STA MPFLS LDA STXT GET RETURN FROM STXT STXT4 LDB P02$ INC # OF MESSAGES SENT; JSB BUMP WORD 3 OF LONG-TERM STAT JMP A,I RETURN HFFBF OCT 177677 REVERSE MASK BIT 6 SKP * SUBROUTINE STXCH: SEND TEXT CHARACTERS * (A) = INDEX OF MESSAGE TO BE SENT * 10 = SOH 11 = STX ) ONE CHAR * 12 = ETX 13 = ETB ) * 14 = DLE STX 15 = DLE ETX ) TWO CHAR * 16 = DLE ETB ) STXCH NOP STA SCMTP ADA ASCMA LDA A,I A = ADDR OF CHARS LDB SCMTP ADB M14 COMPUTE INDEX - 14 SSB INDEX 14 OR MORE? JMP *+3 NO LDB M3 YES: IN EITHER CASE, RSS LDB M2 B = - (1 + # OF CHARS) JMP STXCH,I RETURN SKP * SUBROUTINE TRACE: PUT WORD INTO TRACE TABLE * (A) = WORD TO BE STORED * TRACE NOP LDB TRNEW,I A =ADDR OF CURRENT ENTRY, WORD 1 LDB B,I B =ADDR OF NEXT WORD TO BE FILLD CPB TROLD,I MATCJWH ADDR OF OLDEST ENTRY? RSS YES JMP *+5 NO LDB B,I B =ADDR OF NEXT-TO-OLDEST ENTRY STB TROLD,I UPDATE PTR TO OLDEST ENTRY LDB TRNEW,I LDB B,I B=ADDR OF NEXT WORD TO BE FILLED STA B,I STORE WORD IN TRACE TABLE JSB TRINC GET ADDR OF NEXT WORD TO FILL LDA TRNEW,I CPB A IS NEXT WORD = CURRENT ENTRY? RSS YES, SET NEXT WORD = ENTRY START JMP *+3 JSB TRINC ADVANCE TO 2ND WORD OF ENTRY JSB TRINC ADVANCE TO 3RD WORD OF ENTRY STB A,I UPDATE WORD 1 OF CURRENT ENTRY JMP TRACE,I SPC 2 * SUBROUTINE TRAIN: GET FUNCTION & INITIALIZE TRACE ENTRY * (B) = REQUEST CODE (OFFSET 6 BITS TO LEFT) * (P) = JSB TRAIN * (A) = FUNCTION CODE * (B) = BLOCK SPEC BITS * TRAIN NOP LDA EQT06,I GET CONTROL WORD ALF,ALF & POSITION FUNCTION RAL,RAL CPB B300 IS THIS A CONTROL REQUEST? RSS YES AND P07$ ISOLATE READ/WRITE FUNCTION AND B77$ ISOLATE CONTROL FUNCTION STA TRTMP & SAVE IT IOR B MERGE IN REQUEST CODE (OFFSET) JSB TRACE STORE REQ & FUNCT IN TRACE TABLE CLA STA TLOG STA BLKSP LDA EQT06,I GET CONTROL WORD ALF POSITION BLOCK SPEC BITS AND HE000 & ISOLATE THEM RAL,RAL NOW IN BITS 1,0, & 15 STA B LDA TRTMP GET FUNCTION JMP TRAIN,I TRTMP OCT 0 TRACE TABLE TEMPORARY SKP * SUBROUTINE TRINC: INCREMENTS ADDRESS IN EVENT TRACE, * CHECKING FOR WRAPAROUND * (B) = ADDR TO BE INC * TRINC NOP CPB TRLWA IS IT LAST WORD OF TABLE? JMP *+3 YES INB JMP TRINC,I LDB TRFWA WRAPAROUND TO 1ST OF TABLE JMP TRINC,I SPC 3 * SUBROUTINE ZSTAT: ZERO LONG TERM COMM. STATISTICS * ZSTAT NOP LDA M11 STA MPCTR SET COUNTER = 11 LDA LTCS A=ADDR OF WORD 1, LONG-TERM STAT CLB ZLOOP STB A,I ZERO TABLE ENTRY INA ISZ MPCTR JMP ZLOOP JMP ZSTAT,I * MPCTR OCT 0 COUNTER SKP * CONSTANTS & STORAGE FOR MESSAGE PROCESSOR ONLY * .16 DEC 16 DEC 16, OCT 20 .20 DEC 20 DEC 20, OCT 24 .27 DEC 27 DEC 27, OCT 33 .29 DEC 29 DEC 29, OCT 35 .30 DEC 30 DEC 30, OCT 34 .31 DEC 31 DEC 31, OCT 37 .32 DEC 32 DEC 32, OCT 40, BIT 5 B200 OCT 200 OCT 200, DEC 128 B300 OCT 300 OCT 300, DEC 192 H1400 OCT 012000 LEFT HALF = DEC 20 BIT13 OCT 020000 HBFFF OCT 137777 OCT 137777, REVERSE BIT 14 HEFFF OCT 167777 OCT 167777, REVERSE BIT 12 HFF00 EQU LBYT$ M11 DEC -11 DEC -11, OCT 177765 M14 DEC -14 DEC -14, OCT 177762 M17 DEC -17 DEC -17, OCT 177757, REV BIT 4 M20 DEC -20 DEC -20, OCT 177754, OCT -24 M32 DEC -32 DEC -32, OCT 177740, OCT -40 * PRETV OCT 0 VARIABLE RETURN TO PHYSICAL * * EQT EXTENSION POINTERS * CONVL OCT 0 WRITE-CONV BUFFER LENGTH CURRQ OCT 0 CURRENT READ REQ # NLTO OCT 0 PTR TO # OF 3-SECS IN LONG TMOUT PRVAC OCT 0 PTR TO PREV ACTION: PREV,CURRENT PRVST OCT 0 PTR TO PREV STATES: PREV-1,PREV PVACK OCT 0 CODE FOR PREV ACK STATE OCT 0 MAIN SLC STATE NUMBER TOCTR OCT 0 LONG-TIMEOUT CTR CMBUF DEF *+1 ADDR OF CONTROL MESSAGE RECV BUF BSS 8 LTCS OCT 0 ADDR OF LONG-TERM COMM STATISTCS TRNEW OCT 0 ADDR OF NEWEST TRACE TABLE ENTRY TROLD OCT 0 ADDR OF OLDEST TRACE TABLE ENTRY TRFWA OCT 0 FIRST WORD ADDR OF TRACE TABLE TRLWA OCT 0 LAST WORD ADDR OF TRACE TABLE SKP * ASCII CONTROL MESSAGES -- WITH ODD PARITY * ASCM EQU * ENQ : OCT 77776 ENQ 0 NAK OCT 000576 NAK 1 EOT OCT 001176 EOT 2 ACK0 OCT 002176 ACK0 3 OCT 77577 PAD PAD ACK1 OCT 004176 ACK1 4 OCT 77577 PAD PAD WACK OCT 003576 WACK 5 OCT 77577 PAD PAD RVI OCT 000376 RVI 6 OCT 77577 PAD PAD DEOT OCT 016177 EOT 7 OCT 77577 PAD PAD TTD OCT 007176 TTD 8 OCT 00605 SOH ENQ 9 OCT 00400 SOH 10 OCT 01000 STX 11 OCT 101400 ETX 12 OCT 113400 ETB 13 OCT 10002 DLE STX 14 OCT 010203 DLE ETX 15 OCT 010227 DLE ETB 16 * ASCMA DEF *+1 ASCII CONTROL MESSAGE ADDR PTR DEF ASCM ENQ 0 DEF ASCM+1 NAK DEF ASCM+2 EOT DEF ASCM+3 ACK0 DEF ASCM+5 ACK1 DEF ASCM+7 WACK DEF ASCM+9 RVI DEF ASCM+11 DLE EOT DEF ASCM+13 TTD DEF ASCM+14 SOH ENQ DEF ASCM+15 SOH 10 TEXT DEF ASCM+16 STX 11 DEF ASCM+17 ETX 12 DEF ASCM+18 ETB 13 DEF ASCM+19 DLE STX 14 DEF ASCM+20 DLE ETX 15 DEF ASCM+21 DLE ETB 16 SPC 2 SKP * ACTION DEFINITIONS * AC01 EQU 400B OPEN LINE AC02 EQU 1000B CLOSE LINE AC03 EQU 1400B SEND EOT AC04 EQU 2000B SEND EOT, RECV RESPONSE AC05 EQU 2400B SEND ENQ, RECV RESPONSE AC06 EQU 3000B SEND ENQ, RECV CONVERSATNAL TEXT AC07 EQU 3400B INC RETRY CTR & RESPONSE ERRORS AC08 EQU 4000B SEE IF PRIMARY OR SECONDARY AC09 EQU 4400B SET CONTACT FLG & POST NORM COMP AC10 EQU 5000B POST 0, NORMAL COMPLETION AC11 EQU 5400B POST 1, INVALID REQUEST AC12 EQU 6000B POST 2, REQ INCOMPATIBLE W STATE AC13 EQU 6400B POST 3, BAD ID SEQUENCE AC14 EQU 7000B POST 4, LINE ERROR AC15 EQU 7400B  POST 5, EOT RECVD AC16 EQU 10000B POST 6, DLE EOT RECVD AC17 EQU 10400B POST 7, LONG TIMEOUT OCCURRED AC18 EQU 11000B POST 8, ENQ RECVD AFTER EOT SENT AC19 EQU 11400B POST 9, TEXT OVERRUN AC20 EQU 12000B POST 10, MAX # OF NAKS RECVD AC21 EQU 12400B POST 11, MAX # OF ENQS SENT AC22 EQU 13000B POST 12, RVI RECVD AC23 EQU 13400B POST 13, ENQ RECVD AFTER ENQ SENT AC24 EQU 14000B POST 14, NAK RECVD AFTER ENQ SENT AC25 EQU 14400B POST 15, MAX ENQS RECVD FRM CONV AC26 EQU 15000B POST 16, BAD RESPONSE TO TTD AC27 EQU 15400B SEND TTD, RECV RESPONSE AC28 EQU 16000B SEND TEXT, RECV RESPONSE AC29 EQU 16400B SEND TEXT, TEXT AC30 EQU 17000B CHECK RVI AC31 EQU 17400B PROCESS POSITIVE ACK AC32 EQU 20000B PROCESS SHORT TIMEOUT DURNG SEND AC33 EQU 20400B INC RETRY CTR AC34 EQU 21000B CHECK TIMEOUT & BAD RESPSE FLAGS AC35 EQU 21400B PROCESS ENQ RECVDIN WRITE STATE AC36 EQU 22000B PROCESS SHORT TIMEOUT DURNG RECV AC37 EQU 22400B CHECK READ REQUEST TYPE AC38 EQU 23000B SEND ACK, RECV TEXT AC39 EQU 23400B SEND PREV ACK, RECV TEXT AC40 EQU 24000B SEND NAK, REVV TEXT AC41 EQU 24400B RECV RESPONSE AC42 EQU 25000B RECV TEXT AC43 EQU 25400B SEND WACK, RECV RESPONSE AC44 EQU 26000B SEND RVI, RECV TEXT AC45 EQU 26400B POST 17, IMPOSSIBLE SITUATION AC46 EQU 27000B SEND DLE-EOT AC47 EQU 27400B INC MESSAGE ERRORS,RECV RESPONSE AC48 EQU 30000B TOGGLE RECV ACK FLAG AC49 EQU 30400B BCC ERROR: SEND NAK, RECV TEXT AC50 EQU 31000B SET RECV ACK, CLEAR SEND ACK FLG AC51 EQU 31400B TOGGLE SEND ACK FLAG AC52 EQU 32000B TOGGLE SEND ACK & RECV ACK FLAGS * * EVENT DEFINITIONS * EV00 EQU 0 EVENT 0: LINE OPEN REQUEST EV14 EQU AC14 EVENT 14: ACK0 RECVD EV18 EQU AC18 EVENT 18: ENQ RECEIVED EV29 EQU AC29 EVENT 29: LONG TIMEOUT EV30 EQU AC30 EVENT 30: LOW EV31 EQU AC31 EVENT 31: HIGH  SPC 4 * LINE OPEN ACT1 JSB ZSTAT ZERO THE LONG TERM STATISTICS LDA M7 STA NTRY,I INIT # OF RETRIES = 7 LDA M20 STA NLTO,I INIT LONG TIMEOUT = 60 SEC CLA STA MPFLS INIT MESS PROC FLAGS JMP SLCPC CONT.RETURN TO PHYS, STATUS = OK SPC 2 * LINE CLOSE ACT2 JMP SLCPC CONT.RETURN TO PHYS, STATUS = OK SPC 2 * SEND EOT ACT3 LDA P02$ JSB SCM SEND EOT CONTROL MESSAGE LDA MPFLS AND P01$ EXCEPT FOR CONTACT-MADE FLAG, STA MPFLS INIT MESS PROC FLAGS JMP HIGH SET EVENT = HIGH (NORMAL COMPL) SPC 2 * SEND EOT, RECV RESPONSE ACT4 LDA P02$ JSB SCM SEND EOT CONTROL MESSAGE LDA MPFLS AND P01$ EXCEPT FOR CONTACT-MADE FLAG, STA MPFLS INIT MESS PROC FLAGS ACT4A LDA NLTO,I STA TOCTR RESET LONG-TIMEOUT CTR JMP ACT5B RECV RESPONSE (NO ID) SPC 2 * SEND ENQ, RECV RESPONSE ACT5 EQU * LDB ENVIR,I GET SPECIFIED ENVIRONMENT CLA SPECIFY ENQ MESSAGE BLF,SLB HASP WORKSTATION (BIT 12 =1)? LDA P09$ YES, SPECIFY SOH ENQ MESSAGE JSB SCM SEND CONTROL MESSAGE LDA PRVAC,I AND HFF00 ISOLATE PREV ACTION CPA BIT13 PREV ACTION = 32? JMP *+3 YES, BYPASS RESET LDA NLTO,I STA TOCTR RESET LONG-TIME-OUT CTR LDA ENVIR,I SLA,RSS IS STATION PRIMARY? JMP ACT5C NO LDA M270 STA NOM3 SET NOM 3-SEC TIMEOUT TO 2.7 SEC ACT5C LDA MPFLS AND M3 CLEAR SEND-CONTINUE FLAG (BIT 1) STA MPFLS ACT5A EQU * ACT5B CLE SET E = 0: DISCARD ID LDA CMBUF A = ADDR OF CONTRL MESS RECV BUF LDB M17 B = -(1 + BUF LENGTH) JSB BSCR RECEIVE CONTROL MESSAGE * ------------------------------------------------- STEM ADA .13 SET UP MOST EVENT NUMBERS CPA .27 LINE ERROR? ADA P03$ YES, CHANGE EVENT TO "LOW" JMP SEA GO TO STATE-EVENT-ACTION CIRCLE * M270 DEC -270 SPC 2 * SEND ENQ, RECEIVE CONVERSATIONAL TEXT ACT6 CLA CODE = 0 JSB SCM SEND CONTROL MESSAGE: ENQ LDA PRVAC,I AND HFF00 ISOLATE PREV ACTION CPA BIT13 PREV ACTION = 32? JMP *+3 YES, BYPASS RESET OF LTO CTR LDA NLTO,I STA TOCTR RESET LONG-TIMEOUT CTR CLA STA TLOG ZERO TRANS LOG LDA PARM1 GET REQ BUFFER ADDR LDA A,I GET LENGTH OF WRITE BUFFER ISZ PARM1 GET CORRECT POINTER LDB PARM2 GET READ BUFFER LENGTH JMP AC29A RECV CONV TEXT SPC 2 * INCREMENT RETRY CTR & NO. OF RESPONSE ERRORS ACT7 LDB P08$ SPECIFY THE 9TH LONG-TERM STAT JSB BUMP INCREMENT NO. OF RESPONSE ERRORS IOR .32 SET BAD-RESPONSE FLAG (BIT 5) STA MPFLS JMP INTRY INC RETRY CTR & GET EVENT SPC 2 * SEE IF PRIMARY OR SECONDARY ACT8 LDA ENVIR,I GET SPECIFIED ENVIRONMENT SLA,RSS IS STATION PRIMARY? JMP LOW NO, SECONDARY: SET EVENT = LOW LDA RTCTR SZA,RSS CTR =0? JMP LOW YES ISZ RTCTR YES; RETRY CTR OVERFLOW? JMP HIGH NO, SET EVENT =HIGH JMP LOW YES, REPORT ENQ-ENQ CONTENTION SPC 2 * SET CONTACT-MADE FLAG & POST NORMAL COMP ACT9 IOR P01$ SET CONTACT-MADE FLAG STA MPFLS SPC 2 * POST NORMAL COMPLETION ACT10 JMP SLCXT EXIT WITH COMP STATUS = 0 = OK SPC 2 * REPORT: ACT11 CLB,INB COMP STATUS = 1 =INVALID REQ JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * Y REPORT: ACT12 LDB P02$ STATUS =2 =REQ INCOMPATL W STATE JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT13 LDB P03$ STATUS =3 =BAD ID JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT14 LDB P04$ STATUS =4 =LINE ERROR LDA P04$ INC TOTAL # OF LINE ERRORS ACXIT ADA LTCS A=ADDR OF WORD 1, LONG-TERM STAT ISZ A,I UPDATE LONG-TERM STAT TABLE NOP NULL IN CASE OF ROLLOVER JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT15 LDB P05$ STATUS =5 =EOT RECVD AND P01$ EXCEPT FOR CONTACT-MADE FLAG, A15ST STA MPFLS INIT MESS-PROC FLAGS JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT16 LDB P06$ STATUS =6 =DLE EOT RECVD JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT17 LDB P07$ STATUS =7 =LONG TIMEOUT LDA P07$ INC TOTAL # OF LONG TIMEOUTS JMP ACXIT P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT18 LDB P08$ STATUS =8 =ENQ RECVD TO EOT SENT AND HBFFF CLEAR BIT 14 (SEND ACK FLAG) IOR BIT15 SET BIT 15 (RECV ACK FLAG) JMP A15ST STORE FLAGS & RETURN SPC 2 * REPORT: ACT19 LDB P09$ STATUS = 9 =DATA OVERRUN JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT20 LDB P10$ STATUS =10 =MAX # NAKS RECVD JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT21 LDB P11$ STATUS =11 =MAX # ENQS SENT AND HFFDF CLEAR BAD-RESPONSE FLAG JMP A15ST STORE FLAGS & RETURN HFFDF OCT 177737 REVERSE MASK BIT 5 SPC 2 * REPORT: ACT22 LDB P12$ STATUS =12 =RVI RECBD ADA BIT15 TOGGLE RECV ACK FLAG (BIT 15) JMP A15ST STORE FLAGS & RETURN SPC 2 * REPORT: ACT23 LDB .13 STATUS =13 =ENQ RECV TO ENQ SENT JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT24 LDB P14$ STATUS =14 =NAK RECV TO ENQ SENT JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT25 LDB .15 STATUS =15 =MAX ENQS FROM CONVER JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * REPORT: ACT26 LDB .16 STATUS =16 =BAD RESPONSE TO TTD JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * SEND TTD, RECEIVE RESPONSE ACT27 LDA P08$ JSB SCM SEND CONTROL MESSAGE: TTD JMP ACT4A RESET LTO CTR & RECV RESPONSE SPC 2 * SEND TEXT, READ RESPONSE ACT28 JSB STXT SEND TEXT JMP ACT4A RESET LTO CTR & RECV RESPONSE SPC 2 * SEND TEXT, RECEIVE TEXT ACT29 LDA PARM1 GET REQUEST BUFFER ADDR LDB PARM2 GET & STB CONVL SAVE REQUEST BUFFER LENGTH LDA A,I GET LENGTH OF WRITE BUFFER STA PARM2 & PUT INTO EQT 11 ISZ PARM1 ADVANCE TO WRITE BUFFER ADDR JSB STXT SEND TEXT IN THE WRITE BUFFER LDA NLTO,I STA TOCTR RESET LONG-TIMEOUT CTR CLA STA TLOG ZERO TRANSMISSION LOG LDA PARM2 GET WRITE BUFFER LENGTH IN BYTES LDB CONVL STB PARM2 PUT BACK ORIG :READ BUFFR LENGTH AC29A CMA,INA CLE,ERA CHANGE TO POSITIVE WORD COUNT SEZ BYTE LENGTH ODD? INA YES, ADD ONE TO WORD LENGTH ADA PARM1 A = RECV BUFFER ADDR STA SAVEA N SAVE FOR WC NAK 10/16 ADB M1 B= -(1+RECV BUFFER LENGTH) STB SAVB SAVE FOR WC NAK 10/16 CLE E = 0: DISCARD ID OR LG JSB BSCR RECEIVE TEXT CCB ADB PARM1 RETURN POINTER STB PARM1 JMP STEM GET EVENT FROM COMPLETION CODE SPC 2 * SET RVI FLAG ACT30 STA B BLF,SLB RVI FLAG (BIT 12) SET? JMP LOW YES, SET EVENT =LOW(BAD RVI) IOR BIT12 NO, THEN SET RVI FLAG STA MPFLS JMP HIGH SET EVENT =HIGH (GOOD RVI) SPC 2 * PROCESS RECVD POSITIVE ACKNOWLEDGEMENT ACT31 AND HEFFF CLEAR RVI FLAG STA MPFLS CLE,ELA PUT ACK0/1 FLAG (BIT 15) INTO E LDA P14$ START WITH ACK0 IND LDB ENVIR,I BLF,SLB HASP WORKSTATION? JMP *+3 YES, ONLY ACK0 VALID SEZ CURRENT FLAG = ACK1? INA YES, CHANGE TO ACK1 IND CPA EVENT CURRENT EVENT = CORRECT ACK? JMP MID YES, SET EVENT = MID JMP LOW NO, SET EVENT = LOW SPC 2 * PROCESS SHORT TIMEOUT (SENDING) ACT32 IOR B100 & SET MP TIMEOUT FLAG (BIT 6) STA MPFLS LDA TOCTR SZA,RSS LTO CTR =0? JMP *+3 YES ISZ TOCTR LONG TIMEOUT CTR OVERFLOW? JMP INTRY NO LDA .29 SET EVENT =29 =LONG TIMEOUT JMP SEA GO TO STATE-EVENT-ACTION CIRCLE * ------------------------------------------------- * ROUTINE TO INCREMENT RETRY COUNTER * INTRY LDA RTCTR SZA,RSS RETRY CTR =0? JMP *+3 YES ISZ RTCTR RETRY CTR OVERFLOW? JMP MID+2 NO LDB EVENT LDA .30 START WITH NEXT EVENT = LOW CPB .27 CURRENT EVENT = BAD ID? MID LDA .32 YES, SET EVENT = MID JMP SEA GO TO STATE-EVENT-ACTION CIRCLE LDB PRVST,I GET PREV STATES CLA RRR 8 B = PREV -1, A = PREV (OFFSET) CPA H1400 PREV STATE = WRITE CONV (20)? JMP MID YES, SET EVENT = MID LDA .31 NO, START WITH EVENT = HIGH CPB .20 PREV -1 STATE = WRITE CONV? JMP MID YES, SET EVENT = MID JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 2 * INCREMENT RETRY COUNTER ACT33 JMP INTRY INCREMENT RETRY COUNTER SPC 2 * CHECK TIMEOUT & BAD RESPONSE FLAGS ACT34 ALF,ALF RAL,RAL SLA,RSS MP TIMEOUT FLAG SET (BIT 6 =1)? JMP LOW NO, SET EVENT =LOW SSA BAD RESPONSE FLAG SET (BIT 5 =1)? JMP LOW YES, SET EVENT =LOW LDA PRVST,I AND HFF00 ISOLATE PREV-1 STATE CPA H1400 PREV-1 STATE =WRITE CONV (20)? JMP MID YES, SET EVENT =MID JMP HIGH NO, SET EVENT =HIGH SPC 2 * PROCESS ENQ RECVD IN WRITE ACT35 LDB P09$ INC # OF PREV-RESP ENQS RECVD, JSB BUMP WORD 10 OF LONG-TERM STAT ALF,ALF SLA ENQ JUST SENT (BIT 8 =1)?? JMP MID YES, SET EVENT = MID SSA TEXT JUST RECVD (BIT 7 =1)? JMP HIGH YES, SET EVENT = HIGH JMP LOW NO, SET EVENT = LOW SPC 2 * PROCESS SHORT TIMEOUT, RECEIVING ACT36 LDA .29 START WITH EVENT = LONG TIMEOUT LDB TOCTR SZB,RSS LTO CTR =0? JMP SEA YES ISZ TOCTR INCREMENT TIMEOUT CTR RSS NO OVFLO JMP SEA OVFLO: STATE-EVENT-ACTION CIRCLE LDA STATE CPA P02$ CURRENT STATE = READ ENQ? JMP ACT5A YES, RECV RESPONSE & ID, IF ANY JMP AC38C NO, RECEIVE TEXT SPC 2 * CHECK READ REQUEST TYPE ACT37 AND HBFFF CLEAR BIT 14 (SEND ACK FLAG) IOR BIT15 SET BIT 15 (RECV ACK FLAG) STA MP!FLS LDA CURRQ GET CURRENT READ REQUEST # CPA P03$ CURRENT REQ = 3 (READ INITIAL)? JMP HIGH YES, SET EVENT = HIGH LDA PRVST,I AND HFF00 ISOLATE PREV-1 STATE CPA BIT11 PREV-1 STATE =8 (RESTRCTED READ)? JMP MID YES, SET EVENT = MID LOW LDA .30 SET EVENT = LOW JMP SEA GO TO STATE-EVENT-ACTION CIRCLE HIGH LDA .31 SET EVENT = HIGH JMP SEA GO TO STATE-EVENT-ACTION CIRCLE SPC 2 * SEND ACK, RECV TEXT ACT38 EQU * LDA P03$ START WITH MESSAGE CODE FOR ACK0 LDB ENVIR,I GET SPECIFIED ENVIRONMENT BLF,SLB HASP WORKSTATION? JMP AC38A YES, SEND ONLY ACK0 LDB MPFLS GET SEND ACK FLAG (BIT 14) RBL SSB ACK0 TO BE SENT (BIT 14 =0)? INA NO AC38A STA PVACK SET UP PREV ACK AC38D JSB SCM SEND ACK LDA MPFLS AND M3 CLEAR SEND-CONTINUE FLAG (BIT 1) STA MPFLS LDA NLTO,I STA TOCTR RESET LONG-TIMEOUT CTR AC38C CLA STA TLOG ZERO TRANSMISSION LOG LDA EQT06,I GET CONTROL WORD 10/16 AND N64$ MASK OUT FUNCTION 10/16 CPA WCWRD WRITE CONVERSATIONAL 10/16 JMP WCNAK YES/GET ORIGINAL POINTERS 10/16 LDA PARM1 A = RECV BUFFER ADDR CCB ADB PARM2 CLRE CLE SET E =0: DISCARD ID OR LG JSB BSCR RECEIVE TEXT JMP STEM GET EVENT FROM COMPLETION CODE * WCNAK LDA SAVEA GET RECEIVE 10/16 LDB SAVB POINTERS 10/16 JMP CLRE RETURN * SAVEA NOP SAVB NOP WCWRD OCT 22300 SPC 2 * SEND PREV ACK, RECEIVE TEXT ACT39 EQU * LDB P09$ INC # OF PREV-RESP ENQS RECVD, JSB BUMP WORD 10 OF LONG-TERM STAT LDA PVACK GET MESSAGE CODE FOR PREV ACK JMP AC38D SEND CONTROL MESSAGE: PREV ACK SPC 2 * SEND NAK, RECEIVE TEXT ACT40 EQU * AC40A CLA,INA AC40B STA PVACK SET UP PREV ACK JMP AC38D SEND CONTROL MESSAGE: NAK SPC 2 * RECEIVE RESPONSE ACT41 LDA NLTO,I STA TOCTR RESET LONG-TIMEOUT CTR JMP ACT5A RECV RESPONSE, CHECK ID, IF ANY SPC 2 * INC MESSAGE ERRORS, RECV TEXT ACT42 LDB P06$ SPECIFY WORD 7,LONG-TERM STAT JSB BUMP UPDATE MESSAGE ERROR STAT JMP AC38C RECV TEXT BUT DONT RESET TIMER SPC 2 * SEND WACK, RECV RESPONSE ACT43 LDA P05$ JMP ACT27+1 SEND WACK, RESET LTO, RECV RESP SPC 2 * SEND RVI, RECV TEXT ACT44 LDA P06$ SET UP PREV ACK, SEND RVI, JMP AC40B SPC 2 * REPORT IMPOSSIBLE SITUATION ACT45 LDB .17 STATUS =17 =IMPOSSIBLE SITUATION JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL SPC 2 * SEND DLE-EOT (DISCONNECT) ACT46 LDA P07$ JMP ACT3+1 SEND DLE-EOT CONTROL MESSAGE SPC 2 * INC. MESSAGE ERRORS, READ RESPONSE ACT47 LDB P06$ SPECIFY WORD 7,LONG-TERM STAT JSB BUMP UPDATE MESSAGE ERROR STAT CLA SINCE READ ERROR, ALLOW TIMEOUT: STA NOM3 DONT RESTART 3-SEC TIMEOUT JMP ACT5A RECV RESPONSE SPC 2 * TOGGLE RECV ACK FLAG ACT48 ADA BIT15 TOGGLE RECV ACK FLAG (BIT 15) JMP ACT9 SET CNTACT-MADE FLG,STORE,& RETN SPC 2 * SEND NAK BECAUSE OF ERROR, RECEIVE TEXT ACT49 LDB P06$ SPECIFY WORD 7, LONG-TERM STAT JSB BUMP UPDATE MESSAGE-ERROR STAT RAR,RAR SLA,RSS NAK SENDING DISABLED (BIT 2 =1)? JMP AC40A NO SEND NAK, RECV TEXT LDB .18 YES; STATUS =18 =BAD BCC ETC. JMP SLCXT+1 P+1 (COMP) RETURN TO PHYSICAL .18 DEC 18 * * SET RECV ACK, CLEAR SEND ACK FLAG + ACT 9 ACT50 AND HBFFF CLEAR BIT 14 (SEND ACK FLAG) IOR BIT15 SET BIT 15 (RECV ACK FLAG) JMP ACT9 SET CNTACT-MADE FLG,STORE,& RETN SPC 2 * TOGGLE SEND ACK FLAG + ACT 9 ACT51 XOR BIT14 TOGGLE SEND ACK FLAG (BIT 14) JMP ACT9 SET CNTACT-MADE FLG,STORE,& RETN SPC 2 * TOGGLE SEND ACK & RECV ACK FLAGS + ACT 9 ACT52 ADA BIT15 TOGGLE RECV ACK FLAG (BIT 15) JMP ACT51 SKP * ACTION ADDRESS TABLE * ACTAD DEF * DEF ACT1 DEF ACT2 DEF ACT3 DEF ACT4 DEF ACT5 DEF ACT6 DEF ACT7 DEF ACT8 DEF ACT9 DEF ACT10 DEF ACT11 DEF ACT12 DEF ACT13 DEF ACT14 DEF ACT15 DEF ACT16 DEF ACT17 DEF ACT18 DEF ACT19 DEF ACT20 DEF ACT21 DEF ACT22 DEF ACT23 DEF ACT24 DEF ACT25 DEF ACT26 DEF ACT27 DEF ACT28 DEF ACT29 DEF ACT30 DEF ACT31 DEF ACT32 DEF ACT33 DEF ACT34 DEF ACT35 DEF ACT36 DEF ACT37 DEF ACT38 DEF ACT39 DEF ACT40 DEF ACT41 DEF ACT42 DEF ACT43 DEF ACT44 DEF ACT45 DEF ACT46 DEF ACT47 DEF ACT48 DEF ACT49 DEF ACT50 DEF ACT51 DEF ACT52 SKP * MESSAGE PROCESSOR STATE DEFINITIONS * UNOPN EQU 0 UNOPENED CNTRL EQU 1 CONTROL -- WAITING FOR USER REQ RENQ EQU 2 READ ENQ RERR EQU 3 "READ ENQ" ERROR RREQ EQU 4 CHECK READ REQUEST TYPE READ EQU 5 READ -- WAITING FOR READ REQ RTEXT EQU 6 READ TEXT RRVI EQU 7 READ RVI -- IS RVI VALID RREAD EQU 8 RESTRICTED READ -- ENQ AFTER EOT WENQ EQU 9 WRITE ENQ ERRWE EQU 10 "WRITE ENQ" ERROR EN.EN EQU 11 ENQ-ENQ CONTENTION WRITE EQU 12 * WRITE -- WAITING FOR WRITE REQ WTEXT EQU 13 WRITE TEXT WPREV EQU 14 WRITE PREVIOUS RESPONSE ENQ CKRES EQU 15 CHECK RESPONSE BDACK EQU 16 BAD ACK RECEIVED WRTRY EQU 17 WRITE RETRY WRENQ EQU 18 ENQ RECEIVED IN WRITE OR CONV WRNQ2 EQU 19 2ND STATE, ENQ RECVD IN WRITE WCONV EQU 20 WRITE CONVERSATIONAL WEOT EQU 21 WRITE EOT REOTR EQU 22 READ EOT RESPONSE HNGUP EQU 23 HANG UP -- IDLE EOT RECEIVED WTTD EQU 24 WRITE TTD - WAITING FOR RESPONSE SPC 2 * STATE ADDRESS TABLE * STADT DEF *+1 DEF ST00 DEF ST01 DEF ST02 DEF ST03 DEF ST04 DEF ST05 DEF ST06 DEF ST07 DEF ST08 DEF ST09 DEF ST10 DEF ST11 DEF ST12 DEF ST13 DEF ST14 DEF ST15 DEF ST16 DEF ST17 DEF ST18 DEF ST19 DEF ST20 DEF ST21 DEF ST22 DEF ST23 DEF ST24 DEF ST25 SPC 4 * STATE TRANSITION TABLE * * STATE 0: UNOPN - UNOPENED * ST00 ABS EV00+13 -------------------- ABS AC01+CNTRL REQUEST: LINE OPEN ABS AC11+UNOPN REQUEST: LINE CLOSE ABS AC11+UNOPN REQUEST: READ ENQ ABS AC11+UNOPN REQUEST: READ INITIAL ABS AC11+UNOPN REQUEST: READ CONTINUE ABS AC11+UNOPN REQUEST: READ REPEAT ABS AC11+UNOPN REQUEST: READ WITH RVI ABS AC11+UNOPN REQUEST: DELAY READ ABS AC11+UNOPN REQUEST: WRITE ENQ ABS AC11+UNOPN REQUEST: WRITE CONTINUE ABS AC11+UNOPN REQUEST: WRITE CONVERSATNAL ABS AC11+UNOPN REQUEST: WRITE EOT ABS AC11+UNOPN REQUEST: WRITE DISCONNECT ABS AC11+UNOPN REQUEST: DELAY WRITE * * STATE 1: CNTRL - CONTROL * ST01 ABS EV00+13 -------------------- ABS AC12+CNTRL REQUEST: LINE OPEN ABS AC02+UNOPNN REQUEST: LINE CLOSE ABS AC41+RENQ REQUEST: READ ENQ ABS AC41+RENQ REQUEST: READ INIT ABS AC12+CNTRL REQUEST: READ CONT ABS AC12+CNTRL REQUEST: READ REPEAT ABS AC12+CNTRL REQUEST: READ WITH RVI ABS AC12+CNTRL REQUEST: DELAY READ ABS AC05+WENQ REQUEST: WRITE ENQ ABS AC12+CNTRL REQUEST: WRITE CONTINUE ABS AC12+CNTRL REQUEST: WRITE CONV ABS AC03+WEOT REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC12+CNTRL REQUEST: DELAY WRITE * * STATE 2: RENQ - READ ENQ * ST02 ABS EV14+16 -------------------- ABS AC47+RENQ ACK0 RECVD ABS AC47+RENQ ACK1 RECVD ABS AC47+RENQ WACK RECVD ABS AC47+RENQ RVI RECVD ABS AC37+RREQ ENQ RECVD ABS AC47+RENQ NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC47+RENQ TTD RECVD ABS AC47+RENQ TEXT RECVD ABS AC47+RENQ BAD TEXT RECVD ABS AC47+RENQ TEXT OVERRUN ABS AC47+RENQ GARBAGE RECVD ABS AC33+RERR BAD ID ABS AC36+RENQ SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 3: RERR - "READ ENQ" ERROR * ST03 ABS EV31+1 -------------------- ABS AC47+RENQ HIGH (NO OVERFLOW) ABS AC13+CNTRL MID (CTR OVERFLOW & BAD ID) * * STATE 4: RREQ - CHECK READ REQUEST TYPE * ST04 ABS EV30+2 -------------------- ABS AC10+READ LOW=READ ENQ OR DELAY, READ ABS AC38+RTEXT HIGH=READ INITIAL, READ ST ABS AC10+RREAD MID=READ DELAY, RESTCT READ * * STATE 5: READ - READ -- WAITING FOR READ REQ * ST05 ABS EV00+13 -------------------- ABS AC12+READ REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE< CLOSE ABS AC12+READ REQUEST: READ ENQ ABS AC12+READ REQUEST: READ INIT ABS AC38+RTEXT REQUEST: READ CONT ABS AC40+RTEXT REQUEST: READ REPEAT ABS AC30+RRVI REQUEST: READ WITH RVI ABS AC43+RENQ REQUEST: DELAY READ ABS AC12+READ REQUEST: WRITE ENQ ABS AC28+WTEXT REQUEST: WRITE CONTINUE ABS AC29+WCONV REQUEST: WRITE CONV ABS AC03+WEOT REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC12+READ REQUEST: DELAY WRITE * * STATE 6: RTEXT - READ TEXT * ST06 ABS EV14+16 -------------------- ABS AC42+RTEXT ACK0 RECVD ABS AC42+RTEXT ACK1 RECVD ABS AC42+RTEXT WACK RECVD ABS AC42+RTEXT RVI RECVD ABS AC39+RTEXT ENQ ABS AC42+RTEXT NAK ABS AC15+CNTRL EOT ABS AC16+HNGUP DLE EOT RECVD ABS AC40+RTEXT TTD RECVD ABS AC51+READ TEXT RECVD ABS AC49+RTEXT BAD TEXT RECVD ABS AC19+READ TEXT OVERRUN ABS AC42+RTEXT GARBAGE RECVD ABS AC45+CNTRL BAD ID ABS AC36+RTEXT SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 7: RRVI - READ RVI -- IS RVI VALID * ST07 ABS EV30+1 -------------------- ABS AC12+READ LOW (2ND RVI REQUEST) ABS AC44+RTEXT HIGH (OK TO SEND RVI) * * STATE 8: RREAD - RESTRICTED READ * ST08 ABS EV00+13 -------------------- ABS AC12+RREAD REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC12+RREAD REQUEST: READ ENQ ABS AC12+RREAD REQUEST: READ INIT ABS AC38+RTEXT REQUEST: READ CONT ABS AC40+RTEXT REQUEST: READ REPEAT ABS AC12+RREAD REQUEST: READ WITH RVI ABS AC43+RENQ REQUEST: DELAY READ ABS AC12+RREAD REQUEST: %WRITE ENQ ABS AC12+RREAD REQUEST: WRITE CONTINUE ABS AC12+RREAD REQUEST: WRITE CONV ABS AC03+WEOT REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC12+RREAD REQUEST: DELAY WRITE * * STATE 9: WENQ - WRITE ENQ * ST09 ABS EV14+16 -------------------- ABS AC50+WRITE ACK0 RECVD ABS AC07+ERRWE ACK1 RECVD ABS AC05+WENQ WACK RECVD ABS AC07+ERRWE RVI RECVD ABS AC08+EN.EN ENQ ABS AC24+CNTRL NAK ABS AC15+CNTRL EOT ABS AC16+HNGUP DLE EOT RECVD ABS AC07+ERRWE TTD RECVD ABS AC07+ERRWE TEXT RECVD ABS AC07+ERRWE BAD TEXT RECVD ABS AC07+ERRWE TEXT OVERRUN ABS AC07+ERRWE GARBAGE RECVD ABS AC07+ERRWE BAD ID ABS AC32+ERRWE SHORT TIMEOUT ABS AC45+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) BLOUT EQU ST09+16 ACTION STATE FOR IMPROBABLE ERR * * STATE 10: ERRWE - "WRITE ENQ" ERROR * ST10 ABS EV29+3 -------------------- ABS AC17+CNTRL LONG TIMEOUT ABS AC21+CNTRL LOW (CTR OVFLO, NO BAD ID) ABS AC05+WENQ HIGH (NO OVFLO) ABS AC13+CNTRL MID (CTR OVFLO, BAD ID) * * STATE 11: EN.EN - ENQ-ENQ CONTENTION * ST11 ABS EV30+1 -------------------- ABS AC23+CNTRL LOW (SECONDARY OR CTR OFLOW) ABS AC05+WENQ HIGH (PRIMARY) * * STATE 12: WRITE - WRITE -- WAITING FOR WRITE REQ * ST12 ABS EV00+13 -------------------- ABS AC12+WRITE REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC12+WRITE REQUEST: READ ENQ ABS AC12+WRITE REQUEST: READ INIT ABS AC12+WRITE REQUEST: READ CONT ABS AC12+WRITE REQUEST: READ REPEAT ABS AC12+WRITE REQUEST: READ WITH RVI ABS AC12+WRITE REQUEST: DELAY READ ABS AC12+WRITE REQUEST: WRITE ENQ ABS AC28+WTEXT REQUEST: WRITE CONTINUE ABS AC29+WCONV REQUEST: WRITE CONV ABS AC04+REOTR REQUEST: WRITE EOT ABS AC46+WEOT REQUEST: WRITE DISCONNECT ABS AC27+WTTD REQUEST: DELAY WRITE * * STATE 13: WTEXT - WRITE TEXT * ST13 ABS EV14+16 -------------------- ABS AC31+CKRES ACK0 RECVD ABS AC31+CKRES ACK1 RECVD ABS AC05+WTEXT WACK RECVD ABS AC30+CKRES RVI RECVD ABS AC35+WRENQ ENQ RECVD ABS AC33+WRTRY NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC07+WPREV TTD RECVD ABS AC07+WPREV TEXT RECVD ABS AC07+WPREV BAD TEXT RECVD ABS AC07+WPREV TEXT OVERRUN ABS AC07+WPREV GARBAGE RECVD ABS AC07+WPREV BAD ID ABS AC32+WPREV SHORT TIMEOUT ABS AC45+CNTRL LONG TIMEOUT (NOT EXECTED) ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 14: WPREV - WRITE PREVIOUS RESPONSE ENQ * ST14 ABS EV29+3 ------------------- ABS AC17+CNTRL LONG TIMEOUT ABS AC21+CNTRL LOW: CTR OVERFLOW ABS AC05+WTEXT HIGH: WRITE, NO OVERFLOW ABS AC06+WCONV MID: WRITE CONV, NO OVFLOW * * STATE 15: CKRES - CHECK RESPONSE * ST15 ABS EV30+2 -------------------- ABS AC34+BDACK LOW (BAD ACK) ABS AC22+WRITE HIGH (RVI RECVD) ABS AC48+WRITE MID (GOOD ACK) * * STATE 16: BDACK - BAD ACK RECEIVED * ST16 ABS EV30+2 --------------------------- ABS AC07+WPREV LOW: T/O FLAG NOT SET OR * BR FLAG SET ABS AC28+WTEXT HIGH: WRITE, T/O FLAG SET & * BR FLAG NOT SET ABS AC29+WCONV MID: WRITE CONV, " " * * STATE 17: WRTRY - WRITE RET4RY * ST17 ABS EV30+2 -------------------- ABS AC20+CNTRL LOW (CTR OVERFLOW) ABS AC28+WTEXT HIGH (WRITE, NO OVFLO) ABS AC29+WCONV MID (WRITE CONV, NO OVFLO) * * STATE 18: WRENQ - ENQ RECVD IN WRITE OR CONV * ST18 ABS EV30+2 --------------------------- ABS AC07+WPREV LOW (TEXT NOT JJUST RECVD) ABS AC07+WRNQ2 HIGH (TEXT RECVD,ENQ NOT X) ABS AC23+CNTRL MID (ENQ JUST SENT) * * STATE 19: WRNQ2 - 2ND STATE, ENQ RECVD IN WRITE * ST19 ABS EV30+2 --------------------------- ABS AC25+CNTRL LOW (CTR OVERFLOW) ABS AC28+WTEXT HIGH (NO OVFLO, WRITE) ABS AC29+WCONV MID (NO OVFLO, WRITE CONV) * * STATE 20: WCONV - WRITE CONVERSATIONAL * ST20 ABS EV14+16 -------------------- ABS AC31+CKRES ACK0 RECVD ABS AC31+CKRES ACK1 RECVD ABS AC06+WCONV WACK RECVD ABS AC30+CKRES RVI RECVD ABS AC35+WRENQ ENQ RECVD ABS AC33+WRTRY NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC40+WCONV TTD RECVD ABS AC52+READ TEXT RECVD ABS AC49+WCONV BAD TEXT RECVD ABS AC19+READ TEXT OVERRUN ABS AC07+WPREV GARBAGE RECVD ABS AC45+CNTRL BAD ID (NOT EXPECTED) ABS AC32+WPREV SHOFT TIMEOUT ABS AC45+CNTRL LONG TIMEOUT (NOT EXECTED) ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 21: WEOT - WRITE EOT * ST21 ABS EV30+1 -------------------- ABS AC14+CNTRL LOW (LINE ERROR) ABS AC10+CNTRL HIGH (NORMAL COMPLETION * * STATE 22: REOTR - READ EOT RESPONSE * ST22 ABS EV18+12 -------------------- ABS AC18+RREAD ENQ RECVD ABS AC45+CNTRL NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+HNGUP DLE EOT RECVD ABS AC45+CNTRL TTD RzECVD ABS AC45+CNTRL TEXT RECVD ABS AC47+REOTR DATA ERROR RECVD ABS AC47+REOTR DATA OVERRUN ABS AC47+REOTR GARBAGE RECVD ABS AC45+CNTRL BAD ID ABS AC10+CNTRL SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT ABS AC14+CNTRL LOW (LINE ERROR) * * STATE 23: HNGUP - HANG UP -- DLE EOT RECVD * ST23 ABS EV00+13 -------------------- ABS AC16+HNGUP REQUEST: LINE OPEN ABS AC02+UNOPN REQUEST: LINE CLOSE ABS AC16+HNGUP REQUEST: READ ENQ ABS AC16+HNGUP REQUEST: READ INIT ABS AC16+HNGUP REQUEST: READ CONT ABS AC16+HNGUP REQUEST: READ REPEAT ABS AC16+HNGUP REQUEST: READ WITH RVI ABS AC16+HNGUP REQUEST: DELAY READ ABS AC16+HNGUP REQUEST: WRITE ENQ ABS AC16+HNGUP REQUEST: WRITE CONTINUE ABS AC16+HNGUP REQUEST: WRITE CONV ABS AC16+HNGUP REQUEST: WRITE EOT ABS AC16+HNGUP REQUEST: WRITE DISCONNECT ABS AC16+HNGUP REQUEST: DELAY WRITE * * STATE 24: WTTD - WRITE TTD * ST24 ABS EV14+16 -------------------- ABS AC26+CNTRL ACK0 RECVD ABS AC26+CNTRL ACK1 RECVD ABS AC26+CNTRL WACK RECVD ABS AC26+CNTRL RVI RECVD ABS AC26+CNTRL ENQ RECVD ABS AC10+WRITE NAK RECVD ABS AC15+CNTRL EOT RECVD ABS AC16+CNTRL DLE EOT RECVD ABS AC26+CNTRL TTD RECVD ABS AC26+CNTRL TEXT RECVD ABS AC26+CNTRL BAD TEXT RECVD ABS AC26+CNTRL TEXT OVERRUN ABS AC10+WRITE GARBAGE RECVD ABS AC45+CNTRL BAD ID (NOT EXPECTED) ABS AC27+WTTD SHORT TIMEOUT ABS AC17+CNTRL LONG TIMEOUT (NOT EXECTED) ABS AC14+CNTRL LOW (LINE ERROR) * ST25 NOP LOGICAL END TO STATE-TRANS SKP * CONSTANTS & STORAGE SHARED BY MESSAGE PROC & CHARACTER PROC * .13 DEC 13 5" DEC 13, OCT 15 P14$ DEC 14 DEC 14, OCT 16 .15 DEC 15 DEC 15, OCT 17 .17 DEC 17 DEC 17 OCT 21 B100 DEC 64 DEC 64, OCT 100 B377 DEC 255 DEC 255, OCT 377 M1 DEC -1 DEC -1, OCT 177777 M2 DEC -2 DEC -2, OCT 177776 M3 DEC -3 DEC -3, OCT 177775 M7 DEC -7 DEC -7, OCT 177771 M300 DEC -300 NOM3 DEC -300 TICKS IN NOMINAL 3-SEC TIMEOUT PRET OCT 0 P+2 RETURN ADDRESS FOR PHYSICAL PRETF OCT 0 P+1 RETURN ADDRESS FOR PHYSICAL SPC 4 * EQT EXTENSION POINTERS * MPFLS OCT 0 MESSAGE PROCESSOR FLAGS NTRY OCT 0 PTR TO # OF RETRIES RTCTR OCT 0 RETRY CTR TLOG OCT 0 TRANSMISSION LOG ENVIR OCT 0 PTR TO SPECIFIED ENVIRONMENT SKP * SUBROUTINE BSCR: BSC RECEIVE * (A) = BUFFER ADDRESS * (B) = -(1 + BUFFER LENGTH IN BYTES) * (E) = INDICATOR: 1 =SAVE ID SEQ, 0 =DONT SAVE ID * (P) = JSB BSCR * (A) = COMPLETION STATUS * BSCR NOP RCVR ENTRY STA EBUFA SAVE BYTE ADDR STB EBUFL & BUFFER LENGTH LDB NOM3 SPECIFY NOMINAL 3-SEC TIMEOUT STB PTME THIRD PARAMETER LDA M300 STA NOM3 SET NOM 3-SEC TIMEOUT TO 3 SEC LDA EBUFA ADDRESS LDB EBUFL COUNT JSB HREC PTME NOP NOP JMP BSCR,I RETURN * * EQT EXTENSION POINTERS * BLKSP OCT 0 BLOCK SPEC BITS (15 - 13) EBUFA OCT 0 EDITOR BUFFER ADDR EBUFL OCT 0 EDITOR BUFFER LENGTH SPC 1 BSS 0 SIZE OF DVG67. SPC 1 END IG67  1-_ 91750-18109 2013 S C0122 &DVV00 &DVV00             H0101 ASMB,R,Q,C,N IFN HED "VIRTUAL TERMINAL" DRIVER FOR RTE-IV/M-III NAM DVV00,0 91750-16109 REV.2013 800416 (4/M3) XIF IFZ HED "VIRTUAL TERMINAL" DRIVER FOR RTE-M-II NAM DVV00,0 91750-16110 REV.2013 800416 (M2) XIF * * USE "N" OPTION FOR DMS RTES: RTE-IV, RTE-M-III * USE "Z" OPTION FOR NON-DMS RTES: RTE-M-II * SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 *************************************************************** * * "VIRTUAL TERMINAL" DRIVER FOR DS/1000 * SIMULATES DVR00/DVR05 TO LOCAL SYSTEM. ALL I/O REQUESTS * SENT TO PROGRAM "LUMAP" FOR CONVERSION TO REMOTE 'EXEC' * CALLS. * * IFN * NAME: DVV00 * SOURCE: 91750-18109 * RELOC: 91750-16109 * PGMR: JOHN LAMPING XIF IFZ * NAME: DVV00 * SOURCE: 91750-18109 * RELOC: 91750-18110 * PGMR: JOHN LAMPING XIF * * WRITTEN BY LYLE WEIMAN [MARCH 1979] * MODIFIED BY JOHN LAMPING [OCTOBER 1979] * *************************************************************** SPC 3 ENT IV00,CV00 EXT .MVW,$LIST,#SPLU IFN EXT $OPSY XIF SPC 2 * * IN THIS DRIVER, THE TERM "I/O MAP" IS USED TO REFER TO THE MAPPING * BETWEEN LUS AT THE SOURCE NODE, AND DESTINATION NODE AND LU NUMBERS. * IT HAS NOTHING TO DO WITH "SESSION LU MAPPING", ALTHOUGH IT CAN * OPERATE WITHIN THAT CONTEXT (PROVIDING TWO LEVELS OF I/O MAPPING, * WHICH CAN PERHAPS BE CONFUSING). TO ALLAY THIS CONFUSION, THE * TERM WILL IS ONLY USED HERE WITHIN THE FORMER CONTEXT. * * THE "MAPPING" FROM AN LU IN THE SOURCE SYSTEM TO A DESTINATION NODE * AND LU NUMBER IS PERFORMED BY THE DRIVER, BUT THE ENTIRE OPERATION * REQUIRES ASSISTANCE FROM PROGRAMS "LUQUE" AND "LUMAP". SPC 5 * CALLING SEQUENCES (ORDINARY I/O): * * (NOTE: PRIOR TO ESTABLISHING A MAP FOR AN LU, DVV00 COMPLETES * ALL I/O REQUESTS TO THAT LU WITHOUT TRANSFERRING ANY DATA, I.E., * IT IGNORES ALL I/O REQUESTS). * SPC 2 * "READ" OR "WRITE" DATA SPC 1 * JSB EXEC * DEF *+5,6 OR 7 * DEF RCODE OCT 1 OR 2 * DEF CONWD LU (ANY LU EXCEPT "RESERVED" LU) * ANY SUBFUNCTION BITS EXCEPT "Z" BIT MAY BE SET * DEF DBUF DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH (+ WORDS OR - CHARS) * LIMIT: 512 WORDS, THE LENGTH OF THE BUFFER IN 'LUMAP' * [DEF IPRM1] 1ST OPTIONAL PARAMETER * [DEF IPRM2] 2ND OPTIONAL PARAMETER SPC 2 * THE FOLLOWING ERROR CONDITIONS RESULT IN I/O REJECT: * * 1) DOUBLE-BUFFER ("Z") BIT SET * 2) ORDINARY I/O ISSUED UPON "RESERVED" LU * 3) BUFFER LENGTH >512 WORDS * SPC 2 * CONTROL REQUESTS: * * JSB EXEC * DEF *+3 OR 4 * DEF D3 * DEF CONWD MAY SET ANY SUBFUNCTION BITS * [DEF ] * * I/O REJECT IF: * * 1) "RESERVED" LU IS USED * * UPON RETURN, (A)-REGISTER CONTAINS STATUS INFORMATION AS * RETURNED BY ACTUAL DRIVER AT DESTINATION NODE. * (B)-REGISTER CONTAINS ACTUAL DRIVER-SUPPLIED TRANSMISSION LOG. * SKP * CALLING SEQUENCES ON "RESERVED" LU: * * NOTE: THE "RESERVED LU" IS MEANT TO BE USED ONLY FOR COMMUNICATION * BETWEEN DVV00 AND PROGRAMS 'LUQUE' AND 'LUMAP'. * * THE FIRST TIME THE DRIVER IS ENTERED, IT WILL SET #SPLU TO THE * FIRST LU POINTING TO A EQT WITH A ZERO-LENGTH EXTENSION * THIS LU BECOMES THE RESERVED LU. * W* SUB-FUNCTION SUMMARY: * SUB- ACTION * FUNCTION * -------- ----------------------------- * CONTROL CALLS: * * 35 OBTAIN SYSTEM ATTENTION * 36 RE-TRY ORIGINAL REQUEST AFTER 1 SEC * 37 'STOP': ERROR ON ORIGINAL REQUEST. "COMPLETE" ORIGINAL * REQUEST WITH I/O TIME-OUT INDICATION. * * READ & WRITE CALLS: * * 36 (WRITE) SET UP I/O MAP * 36 (READ) RETURN I/O MAP INFORMATION ON SPECIFIED LU * 37 (READ) SEND REQUEST INFO TO 'LUQUE' * 37 (WRITE) SEND REPLY TO ORIGINAL REQUESTOR * * ALL OTHER CODES IGNORED * * * TO SET UP THE I/O-MAPPING FUNCTION: * * JSB EXEC * DEF *+5 * DEF D2 * DEF CONWD "RESERVED" LU + 3600B * DEF BUFFR SET-UP BUFFER (SEE BELOW) * DEF D4 * * SET-UP BUFFER FORMAT: * * 1 SECURITY CODE (25834) * * 2 "SOURCE" LU NUMBER (IF -1 THEN DRIVER WILL FIND AN UNUSED LU * FROM THE SET OF LUS WHICH "POINT" TO THIS DRIVER--I.E., ONE * WHICH DOES NOT ALREADY HAVE AN I/O MAP CURRENTLY SET UP, AND * EXCLUDING THE "RESERVED" LU--AND RETURN THAT LU IN THE B- * REGISTER, AND SET UP THE I/O MAP FOR IT ACCORDING TO THE * SPECIFICATIONS IN THE REMAINDER OF THIS BUFFER. ZERO IS * RETURNED IF NO LU CAN BE FOUND). * * 3 DESTINATION LU NUMBER * SET BIT 15 IF MESSAGE HEADER IS TO BE APPENDED ("WRITES" ONLY) * SET BIT 14 IF "PROMPT" IS TO BE APPENDED ("READS" ONLY) * THE TWO FUNCTIONS MAY BE COMBINED. * * 4 DESTINATION NODE NUMBER * * THE FOLLOWING ERROR CONDITIONS RESULT IN AN I/O REJECT: * * 1) SECURITY CODE SPECIFIED DOES NOT MATCH 25834 * * 2) SOURCE LU INVALID (NOT IN RANGE 1 TO $LUT#) * * 3) SOURCE LU SPECIFIED IS SAME AS "RESERVED" LU, OR POINTS TO * SAME EQT * * 4) SOURCE LU DOES NOT "POINT" TO DVV00 * * 5) EQT EXTENSION NOT LARGE ENOUGH TO HOL#D MAP * SPC 2 * TO RETURN I/O MAP INFORMATION ON A SPECIFIED LU: * * JSB EXEC * DEF *+6 * DEF D1 "READ" * DEF CONWD "RESERVED" LU + 3600B * DEF BUFFR RETURN DATA BUFFER * DEF D2 RETURNS TWO DATA WORDS * DEF LU LOGICAL UNIT WHOSE I/O MAP IS TO BE RETURNED. * * UPON RETURN: * BUFFR(1) = DESTINATION NODE NUMBER (-1 IF LU DOES NOT * "POINT" TO THIS DRIVER) * BUFFR(2) = DESTINATION NODE LU NUMBER, OR ZERO IF MAP ENTRY IS EMPTY. * THE LU NUMBER WILL HAVE BITS 15 AND 14 SET AS SPECIFIED * IN THE SETUP CALL SKP * THE NORMAL SEQUENCE OF EVENTS IS SUMMARIZED BELOW: * * 1) ORDINARY PROGRAM (ONE WHICH HAS NOT BEEN SPECIFICALLY MODIFIED * FOR REMOTE-EXEC I/O) CALLS EXEC FOR I/O, SPECIFYING AN LU WHICH * "POINTS" TO THIS DRIVER. THE REAL-TIME I/O CONTROL * MODULE CALLS THIS DRIVER. THE REQUEST IS ASSIGNED A SEQUENCE * NUMBER BY THE DRIVER. * * 2) THE DRIVER SCHEDULES "LUQUE", PASSING IT THE ADDRESS OF THE * ORIGINAL REQUEST'S EQT, LENGTH, DESTINATION NODE NUMBER, AND * AND SEQUENCE NUMBER. * * 3) LUQUE ISSUES A CLASS-I/O "READ" CALL, SPECIFYING A "RESERVED" * LU (THIS ONE IS NOT FOR USE BY "ORDINARY" PROGRAMS, AND THUS * IS NOT NORMALLY "BUSY" AT THIS TIME). THE ADDRESS OF THE * ORIGINAL REQUEST EQT IS PASSED BACK TO THE DRIVER IN ONE * OF THE I/O PARAMETERS. THE CLASS NUMBER USED IS THE ONE * ON WHICH "LUMAP" IS SUSPENDED. * * 4) THE DRIVER LOCATES THE ORIGINAL REQUEST'S EQT VIA THE I/O PARAMETER. * IT COPIES THE ORIGINAL REQUEST I/O PARAMETERS (ACTUAL DEVICE NODE * AND LU NUMBER, SUB-FUNCTION, ETC.), AND DATA IN THE CASE THAT THE * ORIGINAL REQUEST WAS A "WRITE", INTO THE BUFFER IN SYSTEM AVAILABLE * MEMORY PROVIDED BY THE LUQUE'S CLASS-I/O REQUEST. * THE DRIVER RETURNS I/O COMPLETION STATUS ON THIS REQUEST, * CAUSING "LUMAP" TO BE SCHEDULED. AND CHANGES THE TIMEOUT * ON THE ORIGINAL REQUEST TO BE SET TO THE MASTER TIMEOUT. * * 5) LUMAP DETERMINES THAT THIS IS A NEW REQUEST, ENTERS INFORMATION * IN A TABLE IT KEEPS, AND BUILDS A REMOTE-EXEC CALL FROM THE * INFORMATION SUPPLIED. RATHER THAN WAIT FOR THE REPLY, AS DO * OTHER REMOTE-EXEC CALLS, IT RETURNS TO ITS "GET" TO AWAIT THE * NEXT NEW REQUEST, OR THE REPLY. THE SAME CLASS NUMBER IS USED * FOR BOTH. * * 6) AT THE DESTINATION NODE, "EXECM" PERFORMS THE REQUESTED I/O * OPERATION AND RETURNS THE REPLY. * * 7) WHEN THE REPLY ARRIVES, GRPM RE-QUEUES IT TO LUMAP'S CLASS, AS IT * RE-QUEUES ALL REPLIES TO THE APPROPRIATE MASTER PROGRAM. * LUMAP DETERMINES THE PROPER ORIGINAL REQUESTOR FROM INFORMATION * IN ITS INTERNAL TABLE, AND MAKES A CLASS-I/O "WRITE" CALL TO THIS * DRIVER, SPECIFYING THE "RESERVED" LU AND THE ORIGINAL REQUEST'S * EQT ADDRESS, AND DATA IN THE CASE WHERE THE ORIGINAL REQUEST * HAD BEEN A "READ". THE SAME CLASS NUMBER IS USED FOR THIS, ALSO. * IT THEN RETURNS TO ITS "GET". * * 8) THE DRIVER LOCATES THE ORIGINAL REQUEST EQT. IF THE ORIGINAL * REQUEST HAD BEEN A "READ", THEN DATA IS TRANSFERRED BACK TO * THE ORIGINAL PROGRAM'S BUFFER. THE ACTUAL DEVICE TYPE AND * STATUS (FROM EQT 5/DVT 6) RETURNED BY THE ACTUAL DRIVER * USED ARE STORED IN THE ORIGINAL REQUEST'S EQT WORD 6. * NOTE THAT THIS FEATURE IS INTENDED TO BE USED SO THAT AN "INNOCUOUS" * I/O REQUEST BE MADE AFTER THE I/O MAP IS SET UP, PRIOR TO SCHEDULING * ANY PROGRAMS WHICH USE THAT LU. THE RETURNED STATUS, POSTED IN * THE EQT, SOLVES THE PROBLEM WHICH WOULD OTHERWISE EXIST BY THE * POSSIBILITY THAT THE PROGRAM MAY ISSUE AN EXEC (13) I/O STATUS * REQUEST TO A MAPPED LU, WHICH IS HANDLED ENTIRELY BY RTIOL, * WITHOUT ANY ASSISuTANCE FROM THE DRIVER. THUS, THE CORRECT * DEVICE TYPE AND STATUS WILL BE OBTAINED. * * 9) THE DRIVER DOES A I/O COMPLETION RETURN ON BOTH THE RESERVED EQT * AND THE ORIGINAL REQUEST EQT. * * 10) LUMAP IS RE-SCHEDULED TO PROCESS THE I/O COMPLETION OF ITS "WRITE" * REQUEST. IT SIMPLY GOES BACK TO ITS "GET". * * AT STEPS 4 AND 9 ABOVE, WHERE THE DRIVER NEEDS TO TAKE ACTION ON TWO * EQT'S AT THE SAME TIME, THE MECHANISM IS AS FOLLOWS. IT SETS THE * CONTINUATION CODE IN THE ORIGINAL REQUEST'S EQT TO THE ACTION IT * WANTS TO PERFORM, AND SETS A ONE TICK TIMEOUT ON THAT EQT. * WHEN THE CLOCK TICKS, IT WILL BE RE-ENTERED ON THAT EQT AND * THE APPROPRIATE ACTION. SPC 2 * THE SEPARATE CALLS TO THE DRIVER MENTIONED ABOVE ARE DESCRIBED * BELOW IN MORE DETAIL. SPC 2 * A "READ" REQUEST IS ISSUED BY 'LUQUE' (SCHEDULED BY THIS DRIVER * WHENEVER AN I/O REQUEST IS MADE ON ANY LU EXCEPT THE "RESERVED" ONE). * THE REQUEST LENGTH MUST BE AT LEAST 9 WORDS (PLUS USER DATA LENGTH, * IN THE CASE OF A "WRITE" REQUEST). * * JSB EXEC * DEF *+7 * DEF D17 CLASS "READ" * DEF <"RESERVED" LU> SUB-FUNCTION = 37 (8) * DEF * DEF * DEF * DEF * * * * INFORMATION RETURNED BY DRIVER IN : * * WORD CONTENTS * ---- ----------------------------------- * 1 DESTINATION NODE NUMER * 2 DESTINATION NODE LU NUMBER * 3 ORIGINAL REQUEST CONTROL WORD (ALL 16 BITS) * 4 ORIGINAL REQUEST LENGTH (+ WORDS OR - CHARS) * 5 " " " OPTIONAL PARAMETER 1 * 6 " " " OPTIONAL PARAMETER 2 * 7 " " " " " 3 * 8 ID SEGMENT ADDRESS OF CALLER (OR ZERO, IF SYSTEM) * 9 SEQUENCE NUMBER (ASSIGNED BY DRIVER) * 10 & FOLL.: USER-SPECIFIED DATA BUFFER ("WRITE" RENQUESTS ONLY) * * NOTE: WORDS 1 THRU 9 ARE CALLED THE "DRIVER REQUEST HEADER AREA" SPC 5 * A "WRITE" REQUEST IS ISSUED BY LUMAP WHEN THE REPLY COMES BACK. * * JSB EXEC * DEF *+7 * DEF D18 CLASS "WRITE" * DEF SUB-FUNCTION = 37(8) * DEF * DEF * DEF * DEF * * PRIOR TO THE CALL, DATA MUST BE SET UP IN THE BUFFER IN THE FOLLOWING * FORMAT: * * 1 (A)-REGISTER STATUS UPON I/O COMPLETION (ACTUAL DEVICE STATUS) * THIS VALUE IS PLACED IN EQT WORD 6 * 2 "ACTUAL" DEVICE TRANSMISSION LOG * 3 EXTENDED STATUS WORD 1 * 4 " " " 2 * * WORDS 5 & FOLLOWING ARE FILLED BY THE DRIVER ("READ" * REQUESTS ONLY) * 5 ORIGINAL \ * 6 DATA, "READ" * 7 AS REQUESTS * ... ONLY * N+4 READ / * * NOTE: WORDS 1 THRU 4 ARE CALLED THE "DRIVER REPLY AREA" * * I/O REJECT IF NOT CLASS-I/O REQUEST SKP * OTHER CAPABILITIES, NOT DESCRIBED ABOVE: SPC 2 * ----TO OBTAIN SYSTEM OR PROGRAM ATTENTION, AS IN REMOTE USE------------------- * (SIMULATES OPERATOR STRIKING KEYBOARD) * * JSB EXEC * DEF *+4 * DEF D3 * DEF LU "RESERVED" LU + 3500 * DEF "ATTENTION" LOGICAL UNIT, I.E., LU SYSTEM SENDS * "PROMPT" & "READ" TO. * THE MUST BE MAPABLE. * IF THE ATN LU IS 1, SYSTEM ATTENTION IS REQUESTED * OTHERWISE, IF THE INTERRUPT CELL FOR THE EQT POINTED TO BY * THE LU CONTAINS A NEGATIVE ID SEGMENT ADDRESS, THAT PROGRAM * IS SCHEDULED AND PASSED THE EQT4 ADDRESS IN THE B REGISTER * (IE LIKE DVR05 DOES) * * ----TO CAUSE THE DRIVER TO RETRY THE REQUEST ----------------------- * * JSB EXEC * DEF *+7 * DEF RCODE OCT 2 * DEF CONWD LU + 3400 * DEF <0> * DEF s<0> * DEF * DEF SPC 2 * ----A 'STOP' REQUEST IS SENT TO THE DRIVER, VIA THE "RESERVED" LU,----- * IF THE REQUEST CANNOT BE HONORED, DUE TO AN ERROR -- ANY ERROR). SPC 1 * JSB EXEC * DEF *+7 * DEF RCODE OCT 2 * DEF CONWD LU + 3500 = 'STOP' * DEF <0> * DEF <0> * DEF IDENTIFIES ORIGINAL REQUEST * DEF * * ERROR CODES (IN EQT 5 STATUS) -- SAME AS RETURNED BY ACTUAL * DEVICE DRIVER AT REMOTE NODE * * * * EQT WORD USAGE BREAKDOWN * * EQT# USE * 5 !AV! EQUIPMENT TYPE! STATUS! * 6 REQUEST CONTROL WORD (CONWD) * 7 ADDRESS OF DATA BUFFER * 8 LENGTH OF DATA BUFFER * 9 1ST OPTIONAL PARAMETER * 10 2ND OPTIONAL PARAMETER * NOTE: AFTER LUMAP SENDS THE REPLY, THE TRANSMISSION * LOG IS STORED HERE FOR USE ON THE I/O TIME-OUT * ENTRY SIGNALING I/O COMPLETION * 11 POINTER TO REMOTE NODE NUMBER IN EXTENSION * FOR CURRENT REQUEST ONLY * 12 LENGTH OF EQT EXTENSION AREA * 13 ADDRESS OF EQT EXTENSION AREA * 14 TIME-OUT RE-SET VALUE * 15 TIME-OUT CLOCK VALUE * * EQT EXTENSION AREA * 1 SEQUENCE NUMBER * 2 CONTINUATION CODE * 3 # RETRIES COUNTER, FOR ATTEMPTS TO SCHEDULE LUQUE * 4 FIRST USER MAP PAGE NUMBER FOR BUFFER * 5 SECOND USER MAP PAGE NUMBER FOR BUFFER * WORDS 6 & FOLLOWING CONTAIN THE "I/O MAP": * * 6 REMOTE NODE NUMBER --SUBCHANNEL 0 * 7 " " LU NUMBER " * 8 REMOTE NODE NUMBER --SUBCHANNEL 1 * 9 " " LU NUMBER " * * ETC. * * * THE "CONTINUATION CODE" IS USED TO DIRECT CONTROL TO THE * NES[XT STAGE OF PROCESSING AFTER AN I/O TIME-OUT. * THE CODE IS VALIDATED BEFORE BEING ADDED TO THE "CONTINUATION * JUMP TABLE ADDRESS" TO OBTAIN THE ADDRESS OF THE CONTINUATION * PROCESSOR. HED DRIVER INITIALIZATION SECTION DREQL EQU 9 DRPRY EQU 4 SPC 2 IV00 NOP LDA EQT5,I CLEAR OLD STATUS AND MB400 STA EQT5,I LDA EQT4,I SET "I WILL IOR IWPTO PROCESS TIMEOUT" STA EQT4,I FLAG LDB SPEQT HAVE WE FOUND SZB THE RESERVED EQT YET? JMP IV1 YES * * THIS IS THE FIRST TIME THIS DRIVER HAS BEEN ENTERED. * WE MUST LOCATE THE RESERVED EQT AND ITS LU NUMBER. * THIS CODE IS ONLY EXECUTED THIS ONCE AND WILL BE * OVERLAYED BY TEMPORARIES LATER. * OVRLY EQU * * LDA LUMAX GET NUMBER OF LU'S CMA,INA NEGATIVE FOR STA CNTR A COUNTER CLB START AT STB VLU LU 1 SPSR1 ISZ VLU ADVANCE TO NEXT LU LDB VLU IS LU JSB OWNLU ONE OF OURS? JMP SPSR3 NO LDA B YES ADA D11 DOES IT'S EQT LDA A,I HAVE AN EXTENSION? SZA,RSS JMP SPSR2 NO, THIS IS IT SPSR3 ISZ CNTR YES, MORE LU'S? JMP SPSR1 YES, TRY NEXT JMP REJCT NO, REJECT THIS REQUEST SPSR2 STB SPEQT SAVE POINTER TO RESERVED EQT LDA VLU STORE RESERVED LU STA #SPLU WHERE OTHER PROGRAMS CAN GET IT * OVREN EQU * END OF OVERLAY AREA * IV1 CPB EQT1 IS THIS THE RESERVED EQT? JMP SPECL YES SPC 2 * HERE FOR ALL I/O ON NON-"RESERVED" LU * * THE 'LUQUE' PROGRAM IS SCHEDULED TO PERFORM THE CLASS-I/O "READ"). * DRIVER EXITS, AND PROCESSING RESUMES WHEN THE CLASS "READ" REQUEST * IS MADE ON THE DRIVER, BEGINNING AT LABEL "MVRED" (ASSUMING THAT * 'LUQUE' IS SCHEDULABLE, AND NO OTHER ERRORS ARE DETECTED). * * amTHE CLASS-I/O REQUEST GOES TO DVV00 ON ITS "RESERVED" * LU. SINCE NO OTHER I/O REQUESTS ARE ALLOWED ON THIS LU AND * IT ALWAYS COMPLETES THESE REQUESTS IMMEDIATELY, THIS EQT * IS NEVER BUSY. SPC 2 LDA EQT13,I SET UP EXTENSION POINTERS JSB SEXT LDA EQT6,I CPA =B100003 IS THIS A SYSTEM CLEAR REQUEST? JMP IEXIT YES IOR ZBIT IS THE "Z" BIT SET? CPA EQT6,I JMP REJCT YES--ERROR! AND B3 CONTROL CPA B3 REQUEST? JMP ORDI YES LDA EQT8,I JSB CHTW CONVERT WORD COUNT TO CHARACTER COUNT ADA =D-513 BUFFER LENGTH SSA,RSS GREATER THAN 512? JMP REJCT YES, REJECT IT. IFN LDB $OPSY IS THIS A MAPPED SYSTEM? RBR SLB,RSS JMP ORDI0 NO RSB ARE WE IN THE USER MAP? BLF,SLB RSS JMP ORDI0 NO LDA EQT7,I RECORD THE RELEVANT MAP REGISTERS LDB MAP1 LDX M2 JSB MVMAP XIF JMP ORDI1 * ORDI LDA EQT7,I CONTROL REQUEST, MOVE PARAMETER STA EQT9,I TO A BETTER SPOT IFN ORDI0 EQU * CCA INDICATE USER MAP NOT NEEDED STA MAP1,I XIF * ORDI1 EQU * LDA EQT4,I PICK UP SUBCHANNEL NUMBER ALF,ALF RAL,RAL AND B37 RAL CONVERT TO ADA .EXTZ TABLE OFFSET LDB A ADB B2 CMB,INB ADB EQT12,I I/O MAP BIG ENOUGH? SSB JMP REJCT NO ADA EQT13,I GET POINTER TO NODE NUMBER STA EQT11,I SAVE IN EQT INA ADVANCE TO REMOTE NODE LU NUMBER LDB A,I PICK UP LU SZB,RSS EMPTY ENTRY? JMP LOG0 YES, IGNORE THIS REQUEST SPC 2 LDA SEQN# ASSIGN A INA SEQUENCE STA SEQN# NUMBER STA SEQN,I LDA NSCDL SET # RETRIES COUNTER STA NTNRY,I JSB LIST CALL $LIST TO SCHEDULE LUQUE CLA CONTINUATION RETURN TO JMP IV00,I RTIOC SPC 2 * HERE TO REJECT REQUEST REJCT EQU * LDA B2 CLB JMP IV00,I RETURN TO RTIOC SPC 2 * HERE FOR READ & WRITE REQUESTS ON "RESERVED" EQT * SPECL EQU * LDA EQT6,I REQUEST CONTROL WORD AND =B3703 IS THIS REQUEST TO CPA =B3602 SET UP I/O MAP? JMP MAPEQ YES CPA =B3601 RETURN I/O MAP SET-UP INFORMATION? JMP RTMAP YES CPA =B3503 OBTAIN SYSTEM ATTENTION? JMP SYSAT YES JSB SXEQT SET UP ALTERNATE EQT POINTERS LDA EQT6,I GET BACK AND =B3703 REQUEST CODE LDB EQT10,I SEQUENCE NUMBER CPA =B3701 MUST MATCH RSS UNLESS THIS IS CPB SEQN,I A READ FROM LUQUE RSS JMP LOG0 NO MATCH, PRETEND NOTHING HAPPENED CPA =B3402 RETRY LATER? JMP RETRY YES CPA =B3502 "STOP" REQUEST? JMP SSTOP YES AND =B3700 MASK SUB-FUNCTION CPA =B3700 CORRECT FOR "SPECIAL" LU? RSS YES, CONTINUE JMP REJCT NO, REJECT REQUEST LDA EQT6,I LOAD REQUEST CONTROL WORD AND =B140000 MASK CLASS-I/O REQUEST BITS CPA =B140000 IS THIS A CLASS-I/O REQUEST? RSS YES, CONTINUE JMP REJCT NO, REJECT LDA EQT6,I OBTAIN REQUEST CODE AGAIN SLA,RSS IS THIS A "WRITE" REQUEST? JMP MVRPL YES, MOVE REPLY SKP * * HERE TO PASS ORIGINAL REQUEST TO LUMAP. * * * * DETERMINE ID SEGMENT ADDRESS OF CALLER * LDB XQT5,I IS THE REQUEST SSB,RSS STILL PENDING? JMP LOG0 NO, IGNORE THIS LDB XQT1,I GET I/O 'LINK' WORD LDA XQT6,I GET REQUEST CODE SSA "SYSTEM" I/O? CLB YES, CAN'T GET ID SEGMENT ADDRESS QJRAL ROTATE THE 'BUFFERED RQST' BIT SSA BUFFERED? CLB YES, CAN'T GET ID SEGMENT ADDRESS STB IDADR & SAVE LOCALLY FOR USE LATER * LDB EQT7,I LOAD CLASS I/O BUFFER ADDRESS LDA XQT11,I STORE REMOTE NODE NUMBER LDA A,I STA B,I IN BUFFER(1) INB LDA XQT11,I STORE REMOTE NODE LU NUMBER INA LDA A,I STA B,I IN BUFFER(2) INB LDA XQT6,I STORE ORIGINAL CONTROL WORD STA B,I IN BUFFER (3) INB LDA XQT8,I STORE ORIGINAL REQUEST LENGTH STA B,I IN BUFFER(4) INB LDA XQT9,I STORE ORIGINAL 1ST OPTIONAL PARAMETER STA B,I IN BUFFER(5) INB LDA XQT10,I STORE ORIGINAL 2ND OPTIONAL PARAMETER STA B,I IN BUFFER(6) INB CLA 3RD OPTIONAL PARAMETER ALWAYS ZERO FOR THIS RTE STA B,I IN BUFFER(7) INB LDA IDADR STORE CALLING PROGRAM'S ID SEGMENT STA B,I ADDRESS IN BUFFER(8) INB LDA SEQN,I LOAD SEQUENCE NUMBER STA B,I STORE IN BUFFER(9) LDA XQT6,I LOAD ORIGINAL CONTROL WORD AGAIN AND B3 MASK CPA B2 "WRITE" REQUEST? INB,RSS YES, (B) POINTS TO BUFFER ADDRESS JMP MVX3 NO, SKIP DATA TRANSFER * * SET UP DATA TRANSFER * STB CV00 SAVE DESTINATION BUFFER ADDRESS LDA XQT8,I LOAD ORIGINAL REQUEST LENGTH JSB CHTW CONVERT CHAR COUNT TO WORDS SZA ZERO? SSA OR NEGATIVE COUNT? JMP MVX3 YES, BYPASS THE TRANSFER STA TEMP SAVE # WORDS TO MOVE CMA,INA MAKE SURE ADA EQT8,I THE LENGTH CPA .REQL WE GOT FROM LUQUE RSS IS RIGHT? JMP LOG0 NO WAY! * * SET UP USER MAP, IF NECESSARY, BEFORE TRANSFERRING DATA. * IFN D JSB SETMP SET UP USER MAP XIF MV1 EQU * LDA XQT7,I LOAD "SOURCE" ADDRESS LDB CV00 LOAD "DESTINATION" ADDRESS IFN SEZ,RSS USER MAP NEEDED? JMP MV2 NO, USE SYSTEM MAP LDX TEMP MWF MOVE WORDS FROM USER MAP JSB RSTMP RESTORE USER MAP JMP MVX3 MV2 EQU * XIF JSB .MVW MOVE WORDS, IN SAME MAP DEF TEMP BUFFER LENGTH NOP MVX3 EQU * LDB B3 "MASTER TIME-OUT" CONTINUATION CODE STB CCODE,I STORE CONTINUATION CODE LDB EQT10,I LOAD DS TIMEOUT LDA XQT11,I GET THE INA PROMPT FLAG LDA A,I (COMPLEMENTED) CMA IN BIT 1 ALF,RAR IOR XQT6,I IF THIS IS A READ RAR,SLA AND PROMPT IS SET RSS LDB BIT15 THEN USE MAXIMUM TIMEOUT STB XQT15,I STORE I/O TIME-OUT CLB,INB GET NON-ZERO TRANSMISSION LOG JMP IEXIT IMMEDIATE COMPLETION SKP * HERE TO SEND THE REPLY BACK TO THE CALLING PROGRAM SPC 2 * BUFFER CONTAINS THE REPLY TO THE ORIGINAL REQUEST, * PLUS DATA (AS READ) IN THE CASE WHERE THE * ORIGINAL REQUEST WAS A "READ". INCLUDED IN THE DATA ARE: * * WORD 1 SEQUENCE NUMBER--ASSIGNED BY DRIVER. MUST BE PROVIDED WITH * REPLY, IN ORDER TO BE SURE OF MATCHING ORIGINAL REQUEST. * 2 (A)-REGISTER AT COMPLETION * 3 TRANSMISSON LOG * 4 EXTENDED STATUS WORD 1 (NOT USED) * 5 EXTENDED STATUS WORD 2 (NOT USED) * 6 & FOL. : ORIGINAL DATA ("READ" REQUEST ONLY) * * ORIGINAL REQUEST IS SPECIFIED VIA THE EQT ADDRESS * (CONTAINED IN 1ST OPTIONAL PARAMETER). MVRPL EQU * LDA XQT5,I IS THE ORIGINAL REQUESTOR SSA,RSS STILL WAITING? JMP LOG0 NO, MUST HAVE TIMED OUT. COMPLETE THIS RQST LDA CCODE,I YES, IS IT CPA B3 , WAITING FOR A RSS RESPONSE? JMP LOG0 NO LDA EQT7,I LOAD BUFFER ADDRESS STA TEMP SAVE IT LDA TEMP,I GET ACTUAL DEVICE STATUS AND =B37777 MASK OFF "AV" FIELD FROM REMOTE IOR =B100000 INCLUDE "AV" FIELD FROM ORIGINAL REQUEST'S EQT STA XQT5,I STORE NEW I/O STATUS & EQUIPMENT TYPE ISZ TEMP POINT TO TRANSMISSION LOG LDA TEMP,I STORE ACTUAL TRANSMISSION LOG IN EQT-- STA XQT10,I WE'LL PICK IT UP ON I/O COMPLETION. CCA SET UP ORIGINAL REQUEST EQT FOR STA XQT15,I I/O TIME-OUT & IMMEDIATE LDB B2 COMPLETION ON RE-ENTRY STB CCODE,I LDA XQT6,I WAS THE ORIGINAL AND B3 REQUEST CPA B1 A "READ"? RSS YES JMP LOG0 NO, RETURN I/O COMPLETION TO RTIOC ISZ TEMP BUMP TO EXTENDED STATUS ISZ TEMP PASS OVER EXTENDED ISZ TEMP STATUS WORDS * * ORIGINAL REQUEST WAS A "READ". * DATA IS TO BE PASSED TO ORIGINAL CALLING PROGRAM'S BUFFER, AS READ * LDA XQT10,I LOAD TRANSMISSION LOG LDB XQT8,I WAS ORIGINAL REQUEST SSB,RSS SPECIFIED IN CHARACTERS? JMP *+3 NO, WORDS INA CHARACTERS: ROUND UP TRUE LNTH, ARS AND CONVERT TO WORDS SZA,RSS WAS LENGTH ZERO?? JMP LOG0 YES, DON'T MOVE THEM STA SXEQT SAVE + WORD COUNT IFN JSB SETMP SET UP USER MAP XIF LDA TEMP LOAD "SOURCE" ADDRESS LDB XQT7,I LOAD DESTINATION ADDRESS SPC 2 IFN SEZ,RSS USER MAP NEEDED? JMP SP2 NO LDX SXEQT MWI MOVE WORDS INTO USER MAP JSB RSTMP RESTORE MAP JMP LOG0 SP2 EQU * XIF * HERE FOR I/O IN SYSTEM MAP (OR NON-DMS SYSTEM) JSB .MVW MOVE DATA DEF SXEQT BUFFER LENGTH NOP SPC 3 LOG0 EQU * CLB SET ZERO TRANSMISSION LOG SPC 1 IEXIT EQU * IMMEDIATE COMPLETION RETURN TO RTIOC LDA B4 JMP IV00,I RETURN TO RTIOC SKP * HERE TO SET UP THE I/O MAPPING FUNCTION * MAPEQ EQU * LDA EQT7,I GET BUFFER ADDRESS LDB A,I GET SECURITY CODE CPB FNMBR CORRECT? RSS JMP LOG0 NO INA LDB @VLU MOVE MAP SET-UP TO LOCAL STORAGE JSB .MVW DEF B3 NOP * LDA VLU CPA M1 ARE WE TO FIND AN LU? JMP FMPEQ YES. LDB VLU LOAD THE LU NUMBER TO BE CHECKED JSB CKMLU CHECK THE LU FOR "MAPPABILITY" JMP SETUP EQT IS GOOD! SET IT UP! JMP LOG0 EQT NOT RIGHT, OR SIZE TOO SMALL SPC 2 * HERE TO SCAN THE LUS TO FIND ONE WHICH IS "MAPPABLE" AND HAS * AN EMPTY MAP ENTRY. * * NOTE: DURING SEARCH, THE FOLLOWING LABELS ARE USED: * * SETTO CONTAINS NUMBER OF LAST EQT CHECKED * TEMP CONTAINS ADDRESS OF LAST EQT CHECKED * FMPEQ EQU * LDA LUMAX SET LOOP CMA,INA COUNTER FOR MAX. # LUS STA CNTR CLB,INB INITIALIZE LU NUMBER STB VLU FMLUP EQU * LDB VLU LOAD LU TO BE CHECKED JSB CKMLU CHECK THE LU FOR "MAPPABILITY". JMP FML1 FOUND ONE!! SPC 2 FMNXT EQU * HERE TO ADVANCE TO NEXT LU ISZ VLU BUMP LU # ISZ CNTR END OF LOOP? JMP FMLUP NO, CONTINUE JMP LOG0 RETURN TO CALLER SPC 2 FML1 EQU * LDA B INA LDA A,I LOAD ENTRY SZA EMPTY? JMP FMNXT NO--ENTRY IN USE * * FOUND AN ENTRY THAT'S AVAILABLE. SETUP EQU * LDA RNODE STORE LU IN THE STA B,I TABLE INB ADVANCE TO NEXT MAP TABLE LOCN LDA RLU STORE THE STA B,I REMOTE LU NUMBER" IN THE TABLE LDB VLU RETURN W/ (B) = LU # TO USE JMP IEXIT SPC 2 * SUBROUTINE TO CHECK THE EQT ASSOCIATED WITH AN LU * TO VERIFY THAT IT IS "MAPPABLE". BY THIS IS MEANS: * 1) THE LU POINTS TO AN EQT WHICH "POINTS" TO THIS DRIVER. * 2) THE LU IS NOT THE "RESERVED" LU, AND DOES NOT POINT TO * THE "RESERVED" EQT. * 3) THE EQT ASSOCIATED WITH IT HAS AN EXTENSION SIZE * OF AT LEAST TWICE THE SUBCHANNEL NUMBER PLUS THE FIXED * STORAGE AREA SIZE (SEE THE EQT LAYOUT IN THE COMMENTS * IN THE FRONT OF THIS LISTING) * * CALLING SEQUENCE: * LDB * JSB CKMLU * CONTAINS ADDRESS OF THIS LU'S CORRESPONDING * ENTRY IN THE MAP TABLE. * CONTAINS ADDRESS OF EQT'S WORD 13 * * * SPC 2 * TEMPORARY STORAGE AREA CKTMP NOP TEMPORARY STORAGE FOR THIS ROUTINE SPC 2 CKMLU NOP ENTRY/EXIT LDA B CHECK THAT LU # IS A VALID ONE CMA,INA ADA LUMAX SSA JMP CKXIT LU > MAX # LUS IN SYSTEM SSB,RSS IS LU SZB,RSS ZERO OR NEGATIVE? JMP CKXIT YES, NO GOOD STB CKTMP SAVE LU JSB OWNLU IS IT ONE OF OURS? JMP CKXIT NO LDA CKTMP YES, GET BACK LU ADB D11 SAVE POINTER STB CKTMP TO EQT WORD 12 ADA M1 GET ADA DRT THE LDA A,I SUBCHANNEL ALF,RAL AND B37 COMPUTE INDEX RAL INTO EQT ADA .EXTZ EXTENSION LDB A IS THE EXTENSION ADA B2 BIG ENOUGH? CMA,INA ADA CKTMP,I SSA CKXIT ISZ CKMLU NO--TAKE "ERROR" EXIT * * COMPUTE ADDRESS OF "I/O MAP" ENTRY ASSOCIATED WITH THIS * LU, AND LEAVE IN UPON RETURN (VALID ONLY FOR "GOOD" EXIT) * ISZ CKTMP POINT TO EXTENSION ADDRESS ADB CKTMP,I ADD ADDRESS TO OFFSET JMP CKMLU,I NOW RETURN SPC 2 * * CHECK LU FOR BELONGING TO THE LU MAPPING DRIVER * ON ENTRY, B=VALID LU NUMBER * NO SKIP RETURN IF LU DOES NOT BELONG TO DVV00 * SINGLE SKIP RETURN WITH B POINTING TO THE LU'S EQT IF * IT DOES BELONG TO DVV00 * OWNLU NOP ADB M1 GET THE ADB DRT EQT NUMBER LDA B,I FROM AND B77 THE DRT SZA,RSS BIT BUCKET? JMP OWNLU,I YES, CAN'T MAP THAT ADA M1 GET THE MPY EQTSZ EQT'S ADA EQTA ADDRESS LDB A INB COMPARE LDA B,I INITIATION XOR EQT2,I ADDRESSES CLE,ELA SZA JMP OWNLU,I NO MATCH INB COMPARE LDA B,I CONTINUE XOR EQT3,I ADDRESSES CLE,ELA SZA JMP OWNLU,I NO MATCH INB COMPARE LDA B,I SELECT XOR EQT4,I CODES AND B77 ADB M3 RESTORE B IN CASE OF SUCCESS SZA,RSS DO SELECT CODES MATCH? ISZ OWNLU YES, TAKE GOOD RETURN JMP OWNLU,I RETURN SPC 2 * HERE TO RETURN I/O MAP INFORMATION FOR A SPECIFIED LU SPC 1 RTMAP EQU * LDA EQT8,I GET BUFFER LENGTH CPA B2 TWO WORDS? RSS JMP REJCT NO! REJECT LDB EQT9,I GET THE LU JSB CKMLU CHECK IT FOR MAPPABILITY JMP RTGUD ***GOOD LU *** CCA LDB EQT7,I GET DATA BUFFER STA B,I RETURN -1 JMP IEXIT SPC 2 RTGUD EQU * HERE WHEN LU RETURNED IS A GOOD ONE LDA EQT7,I GET USER BUFFER ADDRESS STA CKTMP SAVE ADDRESS DLD B,I GET THE MAP ENTRY WORDS DST CKTMP,I RETURN THEM TO USER *  JMP IEXIT IMMEDIATE COMPLETION SKP * HERE ON REQUESTS TO SEND A 'STOP' TO ORIGINATING USER PROGRAM * SSTOP EQU * LDA XQT5,I SET "I/O TIME-OUT" STATUS BIT IOR =B40 STA XQT5,I CLA CLEAR STA XQT10,I TRANSMISSION LOG LDB XQT6,I SET TIMEOUT FOR RE-ENTRY LDA MB400 ON OTHER EQT TO 2.5 SEC FOR READ RBR,SLB AND 10 MS OTHERWISE CCA (THIS PREVENTS READ LOOPS STA XQT15,I FROM HOGGING THE SYSTEM) LDA B2 SET CONTINUATION CODE FOR "I/O COMPLETION" STA CCODE,I LDA B4 "IMMEDIATE COMPLETION" RETURN ON THIS 'SEND STOP' REQUEST JMP IV00,I SPC 2 RETRY EQU * HERE TO SET UP ORIGINAL REQUEST RE-TRY LDA =D-100 SET UP 1-SEC TIME-OUT STA XQT15,I CLA,INA WE WILL RE-ATTEMPT TO EXECUTE THE ENTIRE STA CCODE,I REQUEST ON RE-ENTRY LDA NSCDL SET UP # SCHEDULE ATTEMPTS COUNTER LDB NTRY,I ....UNLESS THE TIMER'S SZB,RSS ALREADY RUNNING STA NTRY,I JMP IEXIT IMMEDIATE COMPLETION RETURN TO RTIOC SPC 2 * HERE TO SIMULATE A REQUEST FOR SYSTEM ATTENTION SYSAT EQU * LDB EQT7,I GET THE LU THE GUY WANTS JSB CKMLU IS IT MAPPABLE? CLA,INA,RSS YES JMP IEXIT NO, THROW THE BUM OUT CPA EQT7,I IS IT LU 1? JMP SYSA1 BINGO! LDB CKTMP SAVE EQT4 ADDRESS ADB M9 OF THE EQT STB BVAL IN QUESTION LDA EQT4,I GET AND B77 SELECT CODE ADA M6 GET ADA INTBA INTERRUPT TABLE LDA A,I CONTENTS CMA,SSA,INA AN ID SEGMENT ADDRESS? JMP IEXIT NO, THROW THE BUM OUT STA SYSID YES, SAVE POSITIVE VALUE JSB $LIST SCHEDULE OURSELVES OCT 601 A PROGRAM, AND SYSID NOP TELL HIM WHERE TO FIND BVAL NOP  THE EQT IN QUESTION JMP IEXIT OUR WORK IS DONE FOR NOW * SYSA1 STA OPATN GET OPERATOR ATTENTION JMP IEXIT THAT WAS EASY HED CONTINUATION INTERRUPT PROCESSING SECTION SKP CV00 NOP CONTINUATOR ENTRY POINT LDA EQT5,I IS THIS A SSA,RSS SPURIOUS INTERRUPT? JMP CEXIT YES LDA EQT4,I AND =B4000 TIME-OUT BIT SET? SZA,RSS JMP CEXIT NO, MUST BE SPURIOUS LDA EQT13,I SET UP EQT EXTENSION POINTERS JSB SEXT POINTERS LDA CCODE,I LOAD CONTINUATION CODE SSA,RSS VERIFY IT SZA,RSS JMP CEXIT NOT VALID, CONTINUATION RETURN TO $CIC ADA CTABL TOO SSA,RSS BIG? JMP CEXIT YES, INVALID LDA CCODE,I LOAD CODE AGAIN ADA CTBLE CONVERT TO JUMP ADDRESS JMP A,I AND GO THERE. SPC 2 * ROUTINE TO RE-ATTEMPT TO SCHEDULE LUQUE * SPC 2 LISTX EQU * ISZ NTRY,I BUMP RE-TRY COUNTER. EXHAUSTED? RSS NO, CONTINUE JMP MTMOT YES--MASTER TIME-OUT JSB LIST SCHEDULE LUQUE SPC 1 CEXIT EQU * ISZ CV00 I/O CONTINUATION RETURN JMP CV00,I TO CIC * SPC 2 IODUN EQU * HERE FOR I/O COMPLETION LDB EQT10,I RECOVER TRANSMISSION LOG CLA I/O COMPLETION RETURN JMP CV00,I TO CIC SPC 2 * MTMOT EQU * HERE ON MASTER TIME-OUT LDA EQT5,I IOR =B40 SET I/O TIME-OUT BIT STA EQT5,I CLB CLA JMP CV00,I RETURN TO $CIC SKP * SUBROUTINE TO SCHEDULE LUQUE * * CALLING SEQUENCE: * * JSB LIST * LIST NOP LDA EQT11,I GET LDA A,I NODE STA TEMP NUMBER LDA SEQN,I GET SEQUENCE NUMBER STA TEMP2 SAVE IT WHERE RTE CAN FIND IT LDB EQT6,I SEND LDA EQT8,I DA<TA SLB ONLY IF CLA WRITE STA CHTW JSB $LIST SCHEDULE 'LUQUE' OCT 701 FUNCTION 1, SUBFUNCTION 7 DEF *+6 RETURN POINT DEF LUQUE NAME DEF EQT1 P1: EQT ADDRESS DEF TEMP P2: REMOTE NODE NUMBER DEF CHTW P3: BUFFER LENGTH DEF TEMP2 P4: SEQUENCE NUMBER LDB LUPTO GET SCHEDULE RETRY TIMEOUT SZA,RSS LUQUE SCHEDULED? LDB =D-100 YES, SET ONE-SECOND TIME-OUT FOR LUMAP STB EQT15,I CLA,INA SET CONTINUATION CODE FOR RETRY STA CCODE,I STORE CONTINUATION CODE JMP LIST,I RETURN TO CALLER SPC 2 IFN * * SUBROUTINE TO SAVE OR RESTORE TWO USER MAP REGISTERS THAT * MAP A GIVEN BUFFER (BUFFER MUST BE <= 1024 WORDS LONG) * * ON ENTRY: * A POINTS TO START OF BUFFER WHOSE MAP IS TO BE SAVED/RESOTRED * B POINTS TO TWO WORD TEMP AREA FOR MAP REGISTERS * X IS -2 TO SAVE REGISTERS AND 2 TO RESTORE REGISTERS * MVMAP NOP ALF GET THE PAGE NUMBER RAL,RAL AND B37 CPA B37 IF LAST PAGE, BACK UP ONE ADA M1 ADA B40 SPECIFY USER MAP XMM MOVE IT JMP MVMAP,I SPC 2 * * SET UP MAP TO MOVE DATA TO/FROM REQUEST * E REGISTER SET IF REQUEST IS IN USER MAP * SETMP NOP LDA MAP1,I IS USER MAP NEEDED? CMA,CLE,SZA,RSS JMP SETMP,I NO LDA XQT7,I SAVE CURRENT USER MAP REGISTERS LDB MAPAD LDX M2 JSB MVMAP LDA XQT7,I SET NEW USER MAP REGISTERS LDB MAP1 LDX B2 JSB MVMAP CCE INDICATE USER MAP NEEDED JMP SETMP,I SPC 2 * * RESTORE USER MAP * RSTMP NOP LDA XQT7,I RESTORE USER MAP REGISTERS LDB MAPAD LDX B2 JSB MVMAP JMP RSTMP,I * MAPAD DEF *+1 BSS 2 SAVE AREA FOR USER MAP REGIYISTERS SPC 2 XIF * SUBROUTINE TO CONVERT CHARACTER COUNT TO WORDS * CALLING SEQUENCE: * LDA + = WORDS, - = CHARS * JSB CHTW * (A) = + WORD COUNT, (B) = SAME AS AT CALL * CHTW NOP SSA,RSS ALREADY HAVE COUNT IN WORDS? JMP CHTW,I YES, RETURN CMA,INA CONVERT INA ROUNDED ARS WORDS JMP CHTW,I RETURN TO CALLER SPC 2 * SUBROUTINE TO SET UP THE "XQT" TABLE POINTERS. * THIS TABLE CONTAINS POINTERS TO THE ORIGINAL REQUEST'S * EQT. IT IS USED WHEN THE DRIVER IS ENTERED VIA THE * "RESERVED" LU, AND PROVIDES CONVENIENT ACCESS TO THE * ORIGINAL REQUEST'S EQT. * SXEQT NOP ENTRY/EXIT LDA SZXQT SET UP LOOP COUNTER STA CNTR LDA EQT9,I GET ORIGINAL REQUEST'S EQT ADDRESS LDB @XQT LOAD ADDRESS OF XQT TABLE L1 EQU * LOOP STA B,I SET ADDRESS INA INB BUMP POINTERS ISZ CNTR DONE? JMP L1 NO, CONTINUE LDA XQT13,I LOAD EQT EXTENSION ADDRESS JSB SEXT SET ADDRESSES OF EXTENSION AREA JMP SXEQT,I YES, RETURN TO CALLER SPC 2 * SUBROUTINE TO SET UP THE "EXT" TABLE POINTERS * ON ENTRY, (A) = ADDRESS OF EXTENSION WORD 1 * ON RETURN, SEQN = ADDRESS OF 1ST EXTENSION WORD * 2 2ND * 3 3RD * ETC. SEXT NOP STA SEQN INA STA CCODE INA STA NTRY INA STA MAP1 INA STA MAP2 JMP SEXT,I SPC 2 A EQU 0 B EQU 1 OPATN EQU 1734B OPERATOR ATTENTION FLAG INTBA EQU 1654B EQTA EQU 1650B DRT EQU 1652B LUMAX EQU 1653B EQT1 EQU 1660B EQT2 EQU 1661B EQT3 EQU 1662B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT8 EQU 1667B EQT9 EQU 1670B EQT10 EQU 1671B P EQT11 EQU 1672B EQT12 EQU 1771B EQT13 EQU 1772B EQT14 EQU 1773B EQT15 EQU 1774B SPC 2 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B37 OCT 37 B40 OCT 40 B77 OCT 77 D11 DEC 11 EQTSZ DEC 15 SIZE OF EQUIPMENT TABLE ENTRY BIT15 OCT 100000 M1 DEC -1 M2 DEC -2 M3 DEC -3 M6 DEC -6 M9 DEC -9 MB400 OCT -400 NSCDL DEC -20 LIMIT OF ATTEMPTS TO SCHEDULE LUQUE LUPTO DEC -5 RE-TRY DELAY FOR ATTEMPT TO SCHEDULE LUQUE LUQUE ASC 3,LUQUE NAME OF 'LUQUE' * * WARNING: DO NOT DISTURB THE ORDER OF ENTRIES IN * THE "CONTINUATION JUMP" AND "ORIGINAL REQUESTOR'S * EQT POINTERS" TABLES. * * "CONTINUATION JUMP TABLE" * CTBLE DEF *,I DEF LISTX 1: RE-TRY LUQUE SCHEDULE DEF IODUN 2: I/O COMPLETION DEF MTMOT 3: MASTER TIME-OUT CTABL ABS CTBLE-* NEG. LENGTH OF CONTINUATION TABLE * * END OF "CONTINUATION JUMP" TABLE * * "ORIGINAL REQUESTOR'S EQT POINTERS" TABLE * * WARNING: DO NOT DISTURB ORDER OF ENTRIES IN THIS TABLE. * * THIS TABLE OVERLAYS THE CODE THAT FINDS THE RESERVED EQT * @XQT DEF XQT1 ADDRESS OF INTERNAL TABLE XQT1 EQU OVRLY POINTER TO ORIGINAL REQUEST'S EQT WORD 1 XQT2 EQU XQT1+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 2 XQT3 EQU XQT2+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 3 XQT4 EQU XQT3+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 4 XQT5 EQU XQT4+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 5 XQT6 EQU XQT5+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 6 XQT7 EQU XQT6+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 7 XQT8 EQU XQT7+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 8 XQT9 EQU XQT8+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 9 XQT10 EQU XQT9+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 10 XQT11 EQU XQT10+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 11 XQT12 EQU XQT11+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 12 XQT13 EQU XQT12+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 13 XQT14 EQU XQT13+1 )pPOINTER TO ORIGINAL REQUEST'S EQT WORD 14 XQT15 EQU XQT14+1 POINTER TO ORIGINAL REQUEST'S EQT WORD 15 SZXQT ABS XQT1-XQT15-1 NEGATIVE OF SIZE OF XQT TABLE SEQN EQU XQT15+1 ADDRESS OF EQT EXTENSION WORD # 1 CCODE EQU SEQN+1 ADDRESS OF EQT EXTENSION WORD # 2 NTRY EQU CCODE+1 ADDRESS OF EQT EXTENSION WORD # 3 MAP1 EQU NTRY+1 ADDRESS OF EQT EXTENSION WORD # 4 MAP2 EQU MAP1+1 ADDRESS OF EXT EXTENSION WORD # 5 .EXTZ ABS MAP2+1-SEQN NEGATIVE SIZE OF EQT EXTENSION * CHECK EQU OVREN-1-MAP2 WILL GENERATE AN ERROR IF OVERLAY * AREA EXCEEDED * * * END OF "ORIGINAL REQUESTOR'S EQT POINTERS" TABLE * .REQL ABS DREQL IDADR NOP FNMBR DEC 25834 MAP SET UP SECURITY CODE ZBIT OCT 10000 "Z" BIT IWPTO EQU ZBIT "I WILL PROCESS TIME-OUT" BIT SEQN# OCT 0 SEQUENCE NUMBER * EQT SPEQT NOP HOLDS ADDRESS OF "RESERVED" EQT TEMP NOP TEMP2 NOP * * NOTE: DO NOT CHANGE ORDER OF "VLU", "RLU" OR "RNODE" * VLU NOP RLU NOP RNODE NOP * CNTR NOP @VLU DEF VLU END m 2N 91750-18111 2013 S C0122 &EXECM              H0101 xASMB,Q,C HED EXECM: 'EXEC' REQUEST PROCESSOR * (C) HEWLETT-PACKARD CO. 1980 * NAM EXECM,19,30 91750-16111 REV.2013 801008 ALL SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** SPC 1 * * NAME: EXECM DS/1000 'EXEC' REQUEST MONITOR * SOURCE: 91750-18111 * RELOC: 91750-16111 * PGMR: C. HAMILTON [07/21/78] * MDF'D: GAB [02/06/79] FOR EXTENDED INSTR REPLACE W/JSB'S * MDF'D: JDH [02/16/79] FOR DS REQUEST EQUATED OFFSETS. * MDF'D: CCH [10/08/80] FOR 91750 * SPC 2 EXT #ATCH,CLRQ,DTACH,LUTRU,PGMAD EXT $LIBR,$LIBX,$OPSY,EXEC,RMPAR,XLUEX EXT #EXHC,#EXTC,#GETR,#GRPM,#NODE,#PLOG,#RPB EXT #NQUE,#RQUE,#RSAX,#SKEY,#SLAV EXT .CAX,.DSX,.STX,.STY A EQU 0 B EQU 1 SUP SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) V #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L]. #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP EXECM JSB RMPAR RETRIEVE THE DEF *+2 SCHEDULING DEF SAVCL c PARAMETER(S). * FIRST JSB CONFG CONFIGURE: 1RST TIME; 'NOP' THEREAFTER. * CLA ESTABLISH PARAMETERS STA RQB+#PGN TO REQUEST THE ADDRESS OF THE JSB PSTAT ID SEGMENT FOR THIS PROGRAM. * LDA TEMP SAVE THE ID SEGMENT ADDRESS STA XEQT FOR SCHEDULE/TERMINATION VALIDATION. LDA SAVCL GET CLASS NUMBER. CCE ALR,ERA REMOVE BUFFER-SAVE BIT(#14) FROM CLASS. STA PURCL SAVE FOR CLASS-PURGE ROUTINE. * * WAITS IN GENERAL WAIT QUEUE, UNTIL A NEW REQUEST ARRIVES, * OR UNTIL A CLASS READ/WRITE/CONTROL REQUEST COMPLETES. * GET JSB DTACH DETACH FROM A POSSIBLE SCB ASSOCIATION. DEF *+1 * CLA PREPARE FOR A TEST OF STA RQB+#STR RECEIVED BUFFER, IN ORDER TO IDENTIFY STA RQB+#SEQ NEW REQUESTS OR I/O COMPLETIONS. * JSB #GETR PERFORM A CLASS 'GET', DEF *+7 IN ORDER TO UN-OBTRUSIVELY AWAIT DEF SAVCL ARRIVAL OF REQUESTS & I/O COMPLETION. RQBAD DEF RQB SPECIFY: REQUEST BUFFER ADDRESS. DEF MAXRQ SPECIFY: REQUEST LENGTH. DABFA DEF DABUF SPECIFY: DATA BUFFER ADDRESS. DEF DBMAX SPECIFY: MAXIMUM DATA BUFFER SIZE. DEF SAVA SPECIFY: STATUS RETURN LOCATION. JMP CLNUP * BAD CLASS: TRY TO CLEAN UP * * STA REQLN = ACTUAL LENGTH OF HEADER. STB SAVB = ACTUAL LENGTH OF DATA. JSB .STX SAVE THE RETURNED REQUEST CODE DEF SAMRC FROM THE LAST CLASS I/O REQUEST. JSB .STY RETRIEVE THE CLASS BUFFER ADDRESS DEF #SKEY AND SAVE FOR USE AS A SEARCH KEY. * LDA L#MHD PREPARE FOR A STA RPLYL MINIMUM-LENGTH REPLY. CLA SET =0, TO PREPARE STA DALEN FOR REPLY W/O DATA. STA XMERQ INITIALIZE ERROR QUALIFIER =0(SYSTEM). * SKP LDA RQB+#SEQ SAVE THE LOCAL STA TEMP SEQUENCE NU(nMBER, TEMPORARILY. * JSB #RSAX SEARCH THE SLAVE LIST, DEF *+4 IN ORDER TO IDENTIFY THIS DEF D5 'GET' BUFFER AS AN I/O DEF RQB+#SEQ COMPLETION, OR AS A DEF RQB+#STR NEW REQUEST. SSB WAS THIS A NEW REQUEST? JMP RWCMP NO--ASSUME AN I/O COMPLETION. * STA RQB+#SEQ YES, SAVE ORIG. SEQ. NO. FOR LOGGING. STB TCBAD SAVE TCB ADDRESS FOR INTER. WRITE-READ. JSB PLOG EXAMINE NEED FOR REQUEST LOGGING. * LDA L#MHD FORM A NEGATIVE VALUE CMA,INA FOR THE MINIMUM REQUEST LENGTH. LDB REQLN GET THE CURRENT REQUEST LENGTH. ADA B COMPUTE: REQLN-MINIMUM. CMB,INB COMPUTE DIFFERENCE BETWEEN SUPPLIED ADB L#IBL AND MAXIMUM REQUEST LENGTHS. SSA,RSS IF LESS THAN MINIMUM, SSB OR GREATER THAN MAXIMUM, THEN JMP CLNUP THE REQUEST IS UNACCEPTABLE. * LDA RQB+#ICD GET REQUEST CODE PARAMETER FROM CALLER. AND B377 REMOVE THE FLAG (BIT#12). STA RCODE SAVE THE REQUEST CODE FOR LATER USE. CPA D99 SPECIAL REQUEST FOR PROGRAM STATUS? JMP PGMST YES--GO TO ACCOMODATE THE CALLER. * STA B NO.SAVE REQUEST CODE FOR VALIDITY CHECK. SZB IF REQUEST CODE=0--REJECT: ERROR "DS06"! ADB UPLIM FORM A NEGATIVE TABLE INDEX. SSB,RSS 0 < REQUEST CODE < 27 ? JMP ERDS6 NO! OUT OF RANGE--ERROR: "DS06". * IOR BIT15 INCLUDE NO-ABORT BIT(#15), STA EXCOD AND CONFIGURE REQUEST CODE FOR CALL. * ADB TABAD COMPUTE PRE-PROCESSOR ADDRESS. JMP B,I GO TO EXECUTE THE PRE-PROCESSING. * SKP * ERROR PROCESSING SECTION. * ERS01 DLD "RS" "RS01": SESSION SCB DOES NOT EXIST! JMP XMERR ERDS6 LDB "06" "DS06": ILLEGAL REQUEST CODE. JMP GETDS ERDS8 LDB "08" "DS08": INSUFFICIENT RESOURCES. GETDS LDOA "DS" JMP XMERR ERIO1 LDB "01" "IO01": IMPROPER OR MISSING PARAMETER. JMP GETIO ERI12 LDB "12" "IO12": LU NOT DEFINED FOR THIS SESSION. GETIO LDA "IO" JMP XMERR ERSC1 LDB "01" "SC01": MISSING SCHEDULING PARAMETER. JMP GETSC ERSC2 LDB "02" "SC02": ILLEGAL SCHEDULING PARAMETER. JMP GETSC ERSC5 LDB "05" "SC05": PROGRAM NOT DEFINED. GETSC LDA "SC" * XMERR STA TEMP SAVE REGISTER, TEMPORARILY. LDA BIT5 SET ERROR QUALIFIER FIELD (BITS #7-4) STA XMERQ TO 2: EXECM SIMULATED ERROR. LDA TEMP RETRIEVE ASCII ERROR INFORMATION. CPB DM1 IF THIS IS A PROGRAM STATUS ERROR, CLE,RSS THEN AVOID SETTING THE ASCII ERROR FLAG. ERRTN CCE ERROR RETURN. JMP DONE * XMERQ NOP QUALIFIER: 0-SYSTEM,40B-EXECM,100B-#RQUE. * "01" ASC 1,01 "02" ASC 1,02 "05" ASC 1,05 "06" ASC 1,06 "08" ASC 1,08 "12" ASC 1,12 "DS" ASC 1,DS "IO" ASC 1,IO "RS" ASC 2,RS01 "SC" ASC 1,SC * SKP * REPLY PROCESSING SECTION. * DONE DST RQB+#EC1 STORE REGISTERS IN WORDS 5&6 OF REPLY. DONE0 CLA,SEZ,RSS IF THIS IS A NORMAL RETURN, JMP CLEAR GO TO CLEAR THE REPLY-ERROR INDICATOR. STA DALEN ELSE, PREPARE FOR REPLY SANS DATA. LDB L#MHD ESTABLISH THE STB RPLYL MINIMUM-LENGTH REPLY. * CLEAR LDA #NODE GET THE LOCAL NODE NUMBER. ELA,CLE,RAR INCLUDE ASCII-ERROR FLAG (BIT#15). STA RQB+#ENO STORE THE ERROR INDICATOR--IF ANY. SSA,RSS ANY ERRORS DETECTED? JMP SRPLY NO, SIMPLY SEND THE REPLY. * LDA RQB+#ECQ YES. REMOVE THE OLD AND UPMSK ERROR QUALIFIER INFORMATION IOR XMERQ AND INCLUDE NEW QUALIFIER. STA RQB+#ECQ CONFIGURE THE QUALIFIER WORD. * SRPLY LDB RQBAD GET THE REPLY BUFFER ADDRESS. ADB RPLYL COMPUTE THE NEXT AVAILABLE LOCATION. LDA $OPSY GET THE OP-SYSTEM IDENTIFIER, STTA B,I AND RETURN AS LAST WORD OF REPLY. ISZ RPLYL INCLUDE IDENTIFIER IN REPLY LENGTH. * JSB #SLAV PROCESS THE SLAVE'S REPLY. DEF *+4 DEF RPLYL HEADER LENGTH. DEF DABUF DATA BUFFER ADDRESS. DEF DALEN DATA BUFFER LENGTH. JMP CLNUP * ERROR: TRY TO CLEAN UP * JMP CLNP0 O.K.: RELEASE BUFFER & AWAIT NEXT ONE. * HED EXECM: READ/WRITE/CONTROL REQUESTS * (C) HEWLETT-PACKARD CO.1980 * RWC JSB ATCHS ATTACH SCB & GET TRUE LU. RC=1,2,3 * LDA RQB+#CWX GET THE CALLER'S CONTROL WORD. ALF,ELA POSITION INTERACTIVE BIT(#11) TO . * LDA RCODE GET THE REQUEST CODE. LDB RQB+#BFL GET BUFFER LENGTH STB DALEN AND CONFIGURE CALL WITH DATA LENGTH. SEZ,RSS IS THE INTERACTIVE BIT(#11) SET? JMP RWCTL NO. CHECK FOR READ, WRITE OR CONTROL. * CPA D1 YES. IS THE CALL PROPERLY SPECIFIED? JMP INTER YES. DO WRITE PORTION OF REQUEST. JMP ERDS6 NO. REQUEST IS INVALID: "DS06"! * INTER ISZ RCODE CONVERT REQUEST CODE TO 'WRITE(2)'. LDA RQB+#PM2 GET WRITE LENGTH FROM OPT. PRAM. #2 STA DALEN INITIALIZE WRITE LENGTH FOR <#RQUE>. SSA IF CHARACTERS WERE SPECIFIED, ARS CONVERT TO A NEGATIVE WORD COUNT. SSA,RSS IF CHARACTERS--SKIP: ALREADY CONVERTED. CMA,INA VERIFY THAT THE ADA SAVB SPECIFIED LENGTH IS SSA CONTAINED WITHIN RECEIVED BUFFER; JMP ERIO1 ELSE, IT'S A PARAMETER ERROR! * LDB TCBAD POINT TO THE THIRD WORD ADB D2 OF THE TRANSACTION CONTROL BLOCK. DMS2 LDA B,I RETRIEVE THE LOCAL SEQUENCE NUMBER. NOP [CONTAINS XLA B,I IN DMS ENVIRONMENT] CPA RQB+#SEQ IF TCB APPEARS TO BE UNCHANGED, CLA,RSS JMP CLNUP ELSE, ITS PROBABLY BEEN DELETED. * STA RQB+#PM1 AVOID THE SPECIFICHATION OF STA RQB+#PM2 ERRONEOUS OPTIONAL PARAMETERS. * LDA D16 INDICATE A 20 MINUTE TIMEOUT. ADB DM1 POINT TO 2ND WORD OF TCB: TIME COUNTER. JSB $LIBR D0 NOP DMS1 STA B,I MODIFY SLAVE TCB TIME VALUE (WD #2). NOP [CONTAINS XSA B,I IN DMS ENVIRONMENT] JSB $LIBX DEF *+1 DEF RWCTL * SKP RWCTL LDA RCODE GET REQUEST CODE LDB RQB+#CWX AND USER'S CONTROL WORD. BLF,CLE,ERB POSITION Z-BIT(#12) TO . CLB,SEZ CLEAR AND TEST FOR Z BUFFER. LDB DABFA Z BUFFER, SO GET DATA BUF. POINTER. SEZ TEST AGAIN FOR Z BUFFER; IF SET, CPA D2 THEN TEST FOR A WRITE REQUEST. ADB RQB+#ZOF GET PARAMETER OR COMPUTE Z BUF. ADDR. STB RQB+#ZOF SAVE PARAMETER OR Z BUF POINTER. IOR D16N FORM A CLASS REQUEST CODE STA EXCOD FROM THE CALLER'S REQUEST VALUE. * LDB $OPSY GET OP-SYSTEM IDENTIFIER. CPB DM31 IF THIS IS AN RTE-L OPERATING SYSTEM, JMP LSWCH GO SELECT APPROPRIATE CALLING SEQUENCE. CPA D19N IT'S RTE-M OR RTE-IV. CONTROL REQUEST? JMP CONT4 YES. GO EXECUTE A CLASS CONTROL REQUEST. * JSB XLUEX RC=1,2 (M,IV) DEF *+8 REQUEST ALLOCATION OF A CLASS BUFFER: DEF D17N CLASS READ (NO ABORT: 100021B) DEF CONW1 CONWORDS (LU =0 + FLAGS, ETC.) DEF DABUF DATA BUFFER ADDRESS. DEF DALEN DATA BUFFER LENGTH. DEF RQB+#ZOF Z BUF. POINTER OR OPTIONAL PARAM. DEF RQB+#ZLN Z BUF. LENGTH OR OPTIONAL 2ND PARAM. DEF #EXTC TEMPORARY CLASS (NO-WAIT). JMP ERRTN SYSTEM-DETECTED ERROR--TELL CALLER. * SSA IF THE REQUEST WAS NOT PROPERLY QUEUED, JMP ERDS8 THEN TELL CALLER: RESOURCE PROBLEM! JMP SAVRQ GO SAVE REQUEST AND START I/O OPERATION. * CONT4 JSB XLUEX RC=3 (M,IV) DEF *+7 REQUEST ALLOCATION OCF A CLASS BUFFER: DEF D19N CLASS CONTROL (NO ABORT: 100023B) DEF CONW1 CONWORDS (LU =0 + FLAGS, ETC.) DEF RQB+#PRM OPTIONAL PARAMETER. DEF #EXTC TEMPORARY CLASS (NO WAIT). DEF RQB+#PM1 2ND OPTIONAL PARAMETER. DEF RQB+#PM2 3RD OPTIONAL PARAMETER. JMP ERRTN SYSTEM-DETECTED ERROR: TELL CALLER! * SSA IF REQUEST WAS NOT PROPERLY QUEUED, JMP ERDS8 THEN TELL CALLER: RESOURCE PROBLEM! * CLA PREVENT DATA OVERLAY JMP SDLEN GO SET PARAM. AND SAVE REQUEST. * SKP * LSWCH CPA D19N IF THIS IS AN RTE-L CONTROL REQUEST JMP CONTL GO EXECUTE THE SPECIAL CALLING SEQUENCE. * JSB XLUEX RC=1,2 (RTE-L) DEF *+10 REQUEST ALLOCATION OF A CLASS BUFFER: DEF D17N CLASS READ (NO ABORT: 100021B) DEF CONW1 CONWORDS (LU =0 + FLAGS, ETC.) DEF DABUF DATA BUFFER ADDRESS. DEF DALEN DATA BUFFER LENGTH. DEF RQB+#ZOF Z BUF. ADDRESS OR OPTIONAL PARAMETER. DEF RQB+#ZLN Z BUF. LENGTH OR 2ND OPTIONAL PARAMETER. DEF #EXTC TEMPORARY CLASS (NO WAIT). DEF ZERO (OPTIONAL PARAMETER IV--NOT USED) DEF RQB+#KEY KEYWORD (RN)--IF ANY. JMP ERRTN SYSTEM-DETECTED ERROR: TELL CALLER! * SSA IF THE REQUEST WAS NOT PROPERLY QUEUED, JMP ERDS8 THEN TELL CALLER: RESOURCE PROBLEM. JMP SAVRQ GO SAVE REQUEST AND START I/O OPERATION. * CONTL JSB XLUEX RC=3 (RTE-L) DEF *+10 REQUEST ALLOCATION OF A CLASS BUFFER: DEF D19N CLASS CONTROL (NO ABORT: 100023B). DEF CONW1 CONWORDS (LU =0 + FLAGS, ETC.) DEF RQB+#PRM OPTIONAL PARAMETER. DEF #EXTC TEMPORARY CLASS (NO WAIT). DEF RQB+#PR2 2ND OPTIONAL PARAMETER. DEF RQB+#ZOF Z BUF. ADDRESS OR 3RD OPTIONAL PARAMETER. DEF RQB+#ZLN Z BUF. LENGTH OR 4TH OPTIONAL PARAMETER. DEF ZERO (OPTIONAL PARAMETER IVd--NOT USED). DEF RQB+#KEY KEYWORD (RN)--IF ANY. JMP ERRTN SYSTEM-DETECTED ERROR: TELL CALLER. * SSA IF THE REQUEST WAS NOT PROPERLY QUEUED, JMP ERDS8 THEN TELL CALLER: RESOURCE PROBLEM. * LDA RQB+#PR2 ENSURE RTE-L PROCESSING OF 2ND PARAM. SDLEN STA DALEN SET PARAMETER FOR REQUEUEING. JMP SAVRQ GO SAVE REQUEST AND START I/O OPERATION. * SKP SAVRQ JSB #GETR PERFORM A ZERO LENGTH 'GET' DEF *+4 IN ORDER TO OBTAIN A SEARCH KEY. DEF #EXTC TEMPORARY CLASS (NO WAIT/BUFFER SAVE). DEF * DUMMY BUFFER ADDRESS. DEF ZERO NO DATA IS TO BE TRANSFERRED. JMP RLTMP SYSTEM DETECTED ERROR. * JSB .STY RETRIEVE CLASS BUFFER ADDRESS(IN S.A.M.) DEF #SKEY SAVE AS SEARCH KEY. * JSB EXEC POST THE SEARCH KEY AND THE REQUEST DEF *+8 IN THE HOLDING CLASS FOR SAFE KEEPING. DEF D20N CLASS WRITE-READ (NO ABORT). DEF ZERO LU =0: MAILBOX OPERATION. DEF #SKEY FIRST WORD IS SEARCH KEY. DEF SAVLN LENGTH OF PARTIAL REQUEST + SEARCH KEY. DEF ZERO OPTIONAL PARAMETERS DEF ZERO ARE NOT REQUIRED. DEF #EXHC REQUEST HOLDING CLASS(NO WAIT). JMP RLTMP SYSTEM DETECTED ERROR: REPORT IT! * SSA IF THE REQUEST WAS NOT PROPERLY QUEUED, JMP RLTMP CLEAN UP AND INFORM THE CALLER. * LDA RCODE GET CURRENT REQUEST CODE. LDB RQB+#PRM PREPARE FOR CONTROL REQUEST REQUEUEING. CPA D3 IF PROCESSING A CONTROL REQUEST, THEN STB DABUF MOVE OPTIONAL PRAM. #1 FOR OVERLAY. * JSB #RQUE TRANSFER THE DEF *+10 QUEUED REQUEST DEF EXCOD ONTO THE DEF RQB+#CNW SPECIFIED DEVICE. DEF DABUF OVERLAY DATA (EXCEPT FOR RC=3), IN ORDER DEF DALEN TO SET CORRECT LENGTH INTO CLASS HEADER. DEF RQB+#ZOF Z BUFFER/OPTvIONAL PRAM.3. DEF RQB+#ZLN Z LENGTH/OPTIONAL PRAM.4. DEF SAVCL SPECIFY COMPLETION VIA CLASS. DEF #EXTC OBTAIN BUFFER FROM TEMPORARY CLASS. DEF RQB+#KEY PASS KEYWORD(RN)--IF ANY. JMP RLT&H ERROR: CLEAN UP & TELL CALLER. * JMP CLNP0 RELEASE CURRENT REQUEST & AWAIT ANOTHER. * SKP RLT&H DST RQB+#EC1 SAVE ERROR CODE FROM <#RQUE>. LDA BIT6 SET ERROR QUALIFIER (BITS#7-4) =4, STA XMERQ TO INDICATE <#RQUE> AS ERROR SOURCE. * JSB #NQUE FIND THE RECENTLY-SAVED REQUEST BUFFER. DEF *+9 DEF DM30 SEARCH WITHIN THE DATA BUFFER. DEF ZERO LU =0: CLASS TO CLASS REQUEUEING. DEF #SKEY SEARCH KEY= CLASS BUFFER ADDRESS. DEF DM1 1'S COMPLEMENT: 1 WORD SEARCH FOR WORD#1. DEF ZERO IGNORE THE NON-EXISTENT DEF ZERO Z BUFFER SPECIFICATIONS. DEF EXTCL REQUEUE BUFFER TO TEMPORARY CLASS. DEF #EXHC BUFFER CAN BE FOUND IN HOLD CLASS. NOP IGNORE ERRORS (THIS IS ERROR RECOVERY). * RLTMP JSB EXEC DO ZERO-LENGTH 'GETS' DEF *+5 UNTIL THE CLASS IS 'CLEAN'. DEF D21N DEF EXTCL DEF * DEF ZERO JMP ERTST ERROR, JUMP OUT NOW--SOMETHING IS AMISS! CCE,INA,SZA ALL BUFFERS RELEASED? [E=1,FOR ERRORS] JMP RLTMP NO, CONTINUE RELEASING THEM. * ERTST CPA XMERQ YES. WAS ERROR DETECTED BY <#RQUE> ? JMP ERDS8 NO, RETURN DS08: RESOURCE PROBLEM! JMP DONE0 YES. ERROR CODES ARE ALREADY SET. * SKP * READ/WRITE/CONTROL CLASS-COMPLETION PROCESSING * RWCMP JSB #RQUE LOCATE THE SAVED REQUEST BUFFER. DEF *+9 DEF DM30 SEARCH WITHIN THE DATA BUFFER. DEF ZERO LU =0: CLASS TO CLASS REQUEUEING. DEF #SKEY SEARCH KEY= CLASS BUFFER ADDRESS. DEF DM1 1'S COMPLEMENT: 1 WORD SEARCH FOR WORD#1. DEF ZERO IGNORE THE NON-E9XISTENT DEF ZERO Z BUFFER SPECIFICATIONS. DEF EXHCL REQUEUE THE LOCATED REQUEST DEF EXHCL ONTO THE HEAD OF THE HOLDING CLASS. JMP CLNP0 REQUEST NOT LOCATED: CLEANUP. * JSB EXEC RETRIEVE PART OF THE ORIGINAL REQUEST. DEF *+5 DEF D21N DEF EXHCL FROM HEAD OF HOLDING CLASS. DEF #SKEY PASS REQUEST DATA DIRECTLY DEF SAVLN INTO <#SLAV'S> REQUEST BUFFER. JMP CLNP0 CLEAN UP (CANNOT REPLY SANS NODE NO.) * CLE LDB SAMRC GET THE I/O COMPLETION CODE. CPB D3 IF IT IS A CONTROL REQUEST, JMP FINIS THEN GO TO PREPARE THE REPLY. [=0] * LDA RQB+#CWX GET THE CALLER'S CONTROL WORD. ALF,ELA POSITION WRITE-READ BIT(#11) TO . LDA RQB+#BFL GET THE CALLER'S DATA-LENGTH VALUE. CPB D1 IF A 'READ' HAS COMPLETED, THEN JMP LENCK GO TO PROCESS THE REPLY DATA-LENGTH. * CLB,SEZ,CLE,INB,RSS IF NORMAL WRITE-COMPLETION, JMP FINIS GO TO PREPARE THE REPLY. * STA DALEN WRITE-READ: SAVE READ LENGTH FOR <#RQUE>, STB RCODE AND INITIALIZE 'RCODE' FOR 'REQUE'. JMP RWCTL PROCESS A 'READ' FOR SPECIFIED DEVICE. * LENCK LDB SAVB GET THE TRANSMISSION LOG: +CHARS/+WORDS CLE,SSA,RSS IF CHARACTERS WERE SPECIFIED, SKIP; JMP SETLN ELSE, GO TO SAVE THE WORD COUNT. * SLB,BRS CONVERT CHARACTER COUNT TO WORDS, AND INB IF ODD ADD ONE TO THE WORD COUNT. SETLN LDA RQB+#CNW IF THE USER'S LOGICAL UNIT NO. AND B377 FOR THE REQUESTED READ OPERATION WAS SZA,RSS LU #0 (THE 'BIT BUCKET'), THEN RETURN CLB ONLY TRANSMISSION LOG WITHOUT DATA. STB DALEN SAVE THE REPLY DATA-LENGTH FOR <#SLAV>. * FINIS DLD SAVA GET THE REGISTERS FOR CALLER. JMP DONE GO COMPLETE THE REPLY.[=0: NO ERRORS] * SPC 2 HED EXECM: TERMINATION/SCHEDULE/STATUS REQUESTS *(C) HEWLETT-PACKARD CO.1980* * * PROGRAM SCHEDULE, TIMED EXECUTION, AND PROGRAM TERMINATION * PKILL LDA $OPSY PROGRAM TERMINATION. RC=6 CPA DM31 IF ENVIRONMENT IS RTE-L, THEN JMP ERDS6 TERMINATION OF A SON IS NOT SUPPORTED! * SCHED JSB ATCHS GO TO ATTACH A POSSIBLE SCB. * JSB PSTAT GO TO GET PROGRAM STATUS. RC=10,12 SZA ANY ATTEMPT TO CPA XEQT REMOTELY CONTROL JMP ERSC5 IS UN-ACCEPTABLE! ERROR: "SC05". * LDB RCODE GET THE REQUEST CODE. CPB D6 PROGRAM TERMINATION REQUEST? JMP *+2 YES. SKIP TO DETERMINE LINEAGE. JMP SCHD0 NO. IT'S A NORMAL SCHEDULE REQUEST. * LDA TEMP+3 GET THE FATHER'S I.D. SEGMENT ADDRESS. CPA XEQT OUR OFFSPRING? JMP SCHD0 YES, WE CAN HONOR THE REQUEST. JMP PASON NO. MUST HAVE BEEN THE SIRE. * SCHD0 LDA L#PGN GET THE MINIMUM BUFFER SIZE. LDB RTNDF GET THE DEFAULT RETURN POINTER. ADA REQLN SUBTRACT MINIMUM FROM ACTUAL SIZE. ADB A COMPUTE THE ACTUAL RETURN ADDRESS, STB RTNAD AND CONFIGURE THE RETURN POINTER. SZA,RSS ANY ADDITIONAL PARAMETERS? JMP SCHD2 NO. GO CLEAR REMAINDER OF CALL BUFFER. SSA WERE WE SUPPLIED WITH ENOUGH PARAMETERS? JMP ERSC1 NO. * ERROR: SC01 ! * JSB .CAX YES. SAVE ADDITIONAL PARAMETER COUNT. LDA UPRDF = ADDRESS OF NEXT USER-PARAMETER LDB RTNDF =ADDRESS OF NEXT CALL-BUFFER LOCATION. SCHD1 STA B,I STORE PARAM ADDR INTO CALL BUFFER. INA ADVANCE PARAMETER POINTER. INB ADVANCE CALL BUFFER POINTER. JSB .DSX ALL PARAMETERS PROCESSED? JMP SCHD1 NO. PROCESS THE NEXT ONE. * CLA PREPARE TO CLEAR REST OF CALL BUFFER. SCHD2 CPB LASTA LAST CALL BUFFER LOCATION CLEARED? J JMP SCHD3 YES. GO TO COMPLETE THE CALL. STA B,I NO. CLEAR THE LOCATION. INB ADVANCE THE CALL BUFFER POINTER, AND JMP SCHD2 GO TO CLEAR THE NEXT LOCATION. * SKP SCHD3 LDA STRAD+1 GET THE STRING-SIZE POINTER--IF ANY. SZA,RSS PASSING A STRING TO THE PROGRAM? JMP SCHD4 NO. BYPASS DATA BUFFER RECOVERY. LDA SAVB YES. GET THE DATA BUFFER SIZE. CMA,INA,SZA,RSS FORM A NEGATIVE VALUE. ANY DATA? JMP ERSC2 NO--IMPROPER PARAMETERS! * LDB DBMAX GET MAXIMUM DATA BUFFER SIZE. ADB A IF THE TRANSMITTED DATA BUFFER SSB EXCEEDS THE ALLOWABLE SIZE, JMP ERSC2 THEN THE REQUEST CANNOT BE PROCESSED! * LDA DABFA GET THE LOCAL DATA BUFFER ADDRESS. STA STRAD ESTABLISH STRING BUFFER ADDRESS IN CALL. * SCHD4 DLD ERRIN LOAD THE ERROR-DETECTION INSTRUCTIONS. DST RTNAD,I STORE THEM AT END OF CALLING SEQUENCE. * * THE CONFIGURED 'EXEC' CALLING SEQUENCE IS EXECUTED BELOW. * JSB EXEC BUFFER FOR ASSEMBLING EXEC REQS. RTNAD DEF PR3AD RETURN POINTER (CONFIGURED). DEF EXCOD REQUEST CODE (SUPPLIED BY CALLER) DEF RQB+#CNW POINTER TO FIRST REQUEST PARAMETER. PR3AD NOP CONFIGURED POINTERS (7-MAX.) TO NOP USER-SUPPLIED CALLING-PARAMETERS, NOP WHICH RESIDE IN THE REQUEST BUFFER. NOP UN-USED CALLING-SEQUENCE LOCATIONS ARE NOP DYNAMICALLY CHANGED TO 'NOP'. STRAD NOP STRING-BUFFER ADDRESS--IF ANY. NOP STRING-LENGTH POINTER--IF ANY. NOP [ ERROR-DETECTION INSTRUCTIONS: WILL BE NOP POSITIONED TO FOLLOW LAST POINTER ] ENDBF JMP DONE REQUEST COMPLETED. =0:NORMAL;=1:ERROR * SPC 2 * * TIME REQUEST PROCESSING RC=11 * STIME LDA L#TYR GET THE REPLY SIZE. STA RPLYL SE5T THE REPLY LENGTH * JSB EXEC REQUEST CURRENT SYSTEM TIME. DEF *+4 DEF EXCOD RCODE = 11 (SIGN IS SET). DEF RQB+#TMS TIME IS RETURNED TO REPLY BUFFER. DEF RQB+#TYR SO IS THE YEAR. CCE,RSS RETURN ERROR-INFO TO THE CALLER! CLE ALL IS WELL, SO JMP DONE RETURN THE TIME DATA. SKP * I/O OR PARTITION STATUS-REQUEST PROCESSING * PARST EQU * RC=25 ISTAT LDA L#ST3 GET THE REPLY SIZE. RC=13 STA RPLYL SET THE LENGTH OF THE REPLY LDA RCODE GET THE REQUEST CODE. CPA D25 IF REQUEST IS FOR PARTITION STATUS, JMP STPAR GO TO COMPLY. * JSB ATCHS ATTACH A POSSIBLE SCB, AND GET TRUE LU. * LDB $OPSY IF EXECUTING IN AN CPB DM31 RTE-L OPERATING SYSTEM, THEN JMP LSTAT USE SPECIAL I/O STATUS PROCESSING. * JSB XLUEX REQUEST STATUS FOR THE I/O DEVICE. DEF *+6 DEF EXCOD RCODE = 13 (SIGN IS SET). DEF RQB+#CNW CONWORD (EXTENDED LU FORMAT) DEF RQB+#ST1 RETURN- EQT WORD#5 DEF RQB+#ST2 RETURN- EQT WORD#4 DEF RQB+#ST3 RETURN- LOGICAL UNIT STATUS CCE,RSS 'EXEC' ERROR-INFO RETURNED TO CALLER. CLE NO ERROR JMP DONE RETURN TO CALLER WITH STATUS INFO. * STPAR JSB EXEC PROCESS A PARTITION STATUS REQUEST DEF *+6 DEF EXCOD RCODE = 25 (SIGN IS SET) DEF RQB+#CNW REFERENCE TO PARTITION NUMBER. DEF RQB+#ST1 RETURN- FIRST PAGE NUMBER. DEF RQB+#ST2 RETURN- NUMBER OF PAGES. DEF RQB+#ST3 RETURN- PARTITION STATUS. CCE,RSS ERROR DETECTED. CLE NO ERROR JMP DONE RETURN TO CALLER WITH STATUS INFO. * LSTAT JSB XLUEX REQUEST DEVICE STATUS FROM RTE-L. DEF *+7 DEF EXCOD RCODE =13 (SIGN IS SET). DEF RQB+#CNW CONWORD (EXTENDED LU FORMAT). DEF RQXB+#ST1 RETURN: DVT WORD #6. DEF RQB+#ST2 RETURN: IPT WORD #6. DEF DABUF RETURN: $DVTP, OR $DVTP BUFFER ADDRESS. DEF RQB+#ZLN RETURN: $DVTP+1, OR BUFFER LENGTH. CCE,RSS RETURN FOR SYSTEM-DETECTED ERROR. CLE NORMAL RETURN. SEZ IF AN ERROR WAS DETECTED, JMP DONE RETURN WITH ERROR CODES. * DST RQB+#EQ5 SAVE REGISTERS, TEMPORARILY. LDA RQB+#CWX GET THE USER'S CONTROL WORD #2. ALF,SLA WAS EXTENSIVE $DVTP INFO REQUESTED? JMP ZRQST YES, GO TO PROCESS RETURN OF DATA. * LDA DABUF NO, GET RETURNED $DVTP WORD #1, LDB RQB+#ZLN AND $DVTP WORD #2. DST RQB+#ST3 RETURN BOTH IN REPLY BUFFER. JMP DONE0 BYPASS UPDATE, AND SEND REPLY. * ZRQST LDA RQB+#ZLN RETRIEVE USER'S REQUEST LENGTH VALUE. SSA,RSS IF NEGATIVE, SKIP TO MAKE POSITIVE; JMP ZWRDS ELSE, GO CONFIGURE REPLY LENGTH. ARS CONVERT TO NEGATIVE WORDS, AND CMA,INA FINALLY, TO POSITIVE WORDS. ZWRDS STA DALEN CONFIGURE REPLY DATA LENGTH. CMA,INA SET RETURNED REGISTERS TO STA B NEGATIVE LENGTH: SIGNALS DATA RETURNED. JMP DONE GO TO SEND THE REPLY. * SKP * * PASS CURRENT REQUEST FROM STREAM 5 TO STREAM 3. * PASON JSB CLTCB GO TO CLEAR RECORD FROM STREAM. STA RQB+#SEQ REPLACE THE ORIGINAL SEQUENCE NUMBER. LDA RQB+#STR GET THE STREAM WORD RC=6,9,23,24 XOR D6 CONVERT TO STREAM-3 . STA RQB+#STR REPLACE STREAM TYPE IN REQUEST BUFFER. LDA D2 INDICATE AN OVERLAY REQUEST STA RPLYL FOR THE TWO MODIFIED WORDS. * JSB #RQUE RE-QUEUE DEF *+9 THE REQUEST DEF D20N DEF ZBIT DEF DABUF DEF DALEN DEF RQB DEF RPLYL DEF #GRPM TO CLASS DEF SAVCL FROM CLASS CCE,RSS ERROR: SKIP TO INFORM ORIGINATOR. JMP GET GO TO AWAIT NEXT REQUEST/COMPLETION. * DST RQB+#EC1 SAVE ERROR CODE FROM <#RQUE>. LDA BIT6 SET ERROR QUALIFIER (BITS#7-4) =4, STA XMERQ TO INDICATE <#RQUE> AS ERROR SOURCE. JMP DONE0 GO TO RETURN ERROR TO ORIGINATOR [E=1]. * SKP * THE FOLLOWING PROGRAM-STATUS REQUEST PROCESSING IS SUPPORTED * >>>>>>>>>>>>>>>> IN DS/1000 NETWORKS--ONLY! <<<<<<<<<<<<<<<< * PGMST LDA L#KST ESTABLISH REPLY LENGTH TO RC=99 STA RPLYL INCLUDE ONE RETURN PARAMETER. JSB PSTAT GO TO GET THE PROGRAM'S STATUS. SZA DOES THE PROGRAM EXIST? JMP GETST YES. GO TO PROCESS THE STATUS. CCB NO. SET =-1 FOR ERROR INDICATION, STB RQB+#KST AND SAVE FOR RETURN TO CALLER. JMP GETDS GO TO RETURN THE ERROR INFORMATION. * GETST LDA B GET THE STATUS WORD. AND D15 ISOLATE THE STATUS. RAL,ERA INCLUDE THE 'SEGMENT' FLAG. STA RQB+#KST SAVE FOR RETURN TO THE CALLER. CLB,CLE =0 FOR RETURN TO CALLER. JMP DONE RETURN THE INFO TO THE CALLER. * HED EXECM: PROCESSING SUBROUTINES.* (C) HEWLETT-PACKARD CO. 1980 * * REMOTE SESSION PROCESSOR: ATTACH TO SESSION CONTROL BLOCK & TRANSLATE LU. * ATCHS NOP ENTER: = DON'T CARE. LDA RQB+#SID GET SESSION ID WORD FROM HEADER. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR CALL. * JSB #ATCH ATTACH TO THE SESSION CONTROL BLOCK. DEF *+2 DEF TEMP CPA DM1 JMP ERS01 ERROR: RS01 SCB NOT FOUND! * LDA RCODE GET USER'S REQUEST CODE. CPA D13 STATUS REQUEST? JMP GETRU YES. GO TO TRANSLATE THE LOGICAL UNIT. * AND DM4 IF THE REQUEST CODE IS NOT SZA READ, WRITE, OR CONTROL, JMP ATCHS,I THEN, LU TRANSLATION IS NOT REQUIRED. | * GETRU LDB RQB+#ICD GET REQUEST CODE PARAMETER. BLF POSITION 'DLUEX' FLAG TO LSB. LDA RQB+#CNW GET USER'S CONTROL WORD. AND B377 ISOLATE 8-BIT LOGICAL UNIT FIELD. SLB,RSS IF THIS IS A STANDARD CONWORD, AND B77 THEN LOGICAL UNIT FIELD IS 6 BITS WIDE. STA TEMP SAVE THE LU FOR A CALL TO 'LUTRU'. XOR RQB+#CNW ISOLATE REMAINDER OF SINGLE-WORD CONWORD. SLB IF THIS IS A SINGLE-WORD CONWORD, SKIP; LDA RQB+#CWX ELSE, GET SECOND PART FROM USER, STA RQB+#CWX CONFIGURE WORD#2 OF CONWORD(S), STA CONW2 AND CONWORD #2 FOR 'XLUEX' CALL. SLB,RSS IF THIS WAS NOT A 'DLUEX' REQUEST, JMP UNMAP THEN, GO TO TRANSLATE THE LOGICAL UNIT. * LDA RQB+#CNW GET WORD #1 OF CONWORD PAIR. SSA IF USER DOES NOT DESIRE LU TRANSLATION, JMP ATCHS,I THEN NO FURTHER PROCESSING IS REQUIRED. * UNMAP JSB LUTRU TRANSLATE THE USER'S DEF *+3 LOGICAL UNIT NUMBER DEF TEMP FROM HIS KNOWN REFERENCE DEF TEMP+1 TO THE ACTUAL SYSTEM LU NUMBER. * LDA TEMP+1 GET THE ACTUAL LOGICAL UNIT NUMBER. CPA DM1 IF 'LUTRU' RETURNED A -1, THEN JMP ERI12 THE LU IS NOT DEFINED FOR THIS SESSION! * IOR BIT15 SET SIGN FOF WORD #1: ALREADY UN-MAPPED. STA RQB+#CNW CONFIGURE ACTUAL LU INTO CONTROL WORD. JMP ATCHS,I RETURN: = MEANINGLESS. * SKP * CLNUP JSB CLTCB ELIMINATE RECORD OF OFFENDING REQUEST. JMP CLNP0 COMPLETE THE CLEAN UP PROCESS. * SPC 3 CLTCB NOP ENTRY/EXIT: TCB-CLEARING PROCESSOR. JSB #RSAX GO TO THE TCB-MANAGEMENT PROCESSOR DEF *+4 TO CLEAR THE RECORD OF THE CURRENT DEF D7 SLAVE-STREAM ENTRY - WHICH IS DEF RQB+#SEQ IDENTIFIED BY IT'S SEQUENCE NUMBER- DEF RQB+#STR AND STREAM NO. SSB,RSS IF THE OPERATION WAS SUCCESSFUL, JMP CLTCB,I RETURN TO CALLER. [= ORIG. SEQ. NO.] * CLNP0 LDB $OPSY GET OP-SYSTEM IDENTIFIER. CPB DM31 IF THIS IS AN RTE-L SYSTEM, JMP CLRTN SKIP BLOCK-SIZE RESET OPERATION. * JSB #RQUE RESET THE POSSIBLE DEF *+9 NEGATIVE BLOCK-SIZE WORD, DEF D20N BEFORE ATTEMPTING TO DEF ZBIT RELEASE THE CLASS BUFFER. DEF * DEF D0 DEF * DEF D0 DEF DM1 DEF PURCL NOP ERROR--IGNORE. * CLRTN JSB EXEC RETURN THE CURRENT CLASS BUFFER. DEF *+5 DEF D21N CLASS GET. DEF PURCL CLASS/BUFFER RELEASE/SAVE CLASS. DEF * DUMMY DATA-BUFFER ADDRESS. DEF D0 DATA NOT DESIRED. NOP JMP GET RETURN TO AWAIT A NEW REQUEST/COMPLETION. * SPC 3 PSTAT NOP PROGRAM STATUS SUBROUTINE. JSB PGMAD DEF *+6 DEF RQB+#PGN PROGRAM 'NAME' IS IN REQUEST BUFFER. DEF TEMP RETURNED SPEC'D ID SEGMENT ADDRESS. DEF TEMP+1 RETURNED PROGRAM STATUS. DEF TEMP+2 RETURNED ID SEGMENT TYPE. DEF TEMP+3 RETURNED FATHER ID SEGMENT. JMP PSTAT,I RETURN. * SKP PLOG NOP REQUEST BUFFER LOGGING ROUTINE. LDB #PLOG GET THE REQUEST-LOGGER'S CLASS NO. SZB,RSS IS LOGGING DESIRED? JMP PLXIT NO. RETURN TO NORMAL PROCESSING. * STB PSTAT YES. SAVE THE CLASS NO. LOCALLY. * JSB EXEC COPY DEF *+8 THE DEF D20N REQUEST & DATA DEF ZBIT BUFFERS, DEF DABUF IN THE DEF SAVB EXPECTED DEF RQB FORMAT, DEF REQLN TO THE DEF PSTAT LOGGER'S NOP CLASS. * PLXIT LDA TEMP RESTORE THE LOCAL STA RQB+#SEQ SEQUENCE NO. TO REQUEST BUFFER. JMP PLOG,I CONTINUE NORMAL PROCESSING. 7 * SKP DM1 DEC -1 DM4 DEC -4 DM30 DEC -30 DM31 DEC -31 D1 DEC 1 D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D7 DEC 7 D13 DEC 13 D15 DEC 15 D16 DEC 16 D25 DEC 25 D16N OCT 100020 D17N OCT 100021 D19N OCT 100023 CLASS-CONTROL--NO ABORT D20N OCT 100024 CLASS WRITE-READ--NO ABORT. D21N OCT 100025 D99 DEC 99 PROGRAM STATUS REQUEST CODE. B77 OCT 77 B377 OCT 377 BIT5 OCT 40 BIT6 OCT 100 BIT12 OCT 10000 * MAINTAIN ORDER OF 'BIT15', 'CONW1', AND 'CONW2'. BIT15 OCT 100000 CONW1 EQU BIT15 WORD #1 OF DUAL CONWORD (LU=0). CONW2 NOP #2 OF DUAL CONWORD (FLAGS, ETC.) EXCOD NOP REQUEST CODE WITH NO-ABORT FLAG (BIT#15). RCODE NOP CURRENT REQUEST CODE. ZBIT EQU BIT12 DOUBLE-BUFFER BIT(#12). REQLN NOP REQUEST BUFFER LENGTH. SAMRC NOP RETURNED I/O REQUEST CODE. TCBAD NOP TCB ADDRESS. * RPLYL NOP REPLY LENGTH (CONFIGURED). DALEN NOP BUFFER LENGTH/CONTROL PARAMETER EXHCL NOP HOLD CLASS W/O BUFFER SAVE BIT. EXTCL NOP TEMP CLASS W/O BUFFER SAVE BIT. LASTA DEF ENDBF RTNDF DEF PR3AD UPRDF DEF RQB+#PMS UPMSK OCT 177400 XEQT NOP CONFIGURED ID ADDRESS OF . ZERO EQU D0 * * * * DO NOT CHANGE ORDER OF NEXT 4 STATEMENTS * * * * ERRIN CCE,RSS CONFIGURED-'EXEC'-REQUEST CLE ERROR-DETECTION INSTRUCTIONS. SAVA NOP REGISTER STORAGE FOR SAVB NOP AND FOR . * * * * * * * * * * * * * * * * * * * * * * * * * * * SKP * * PRE-PROCESSOR 'JUMP' TABLE. * LOW1 DEF RWC RCODE 1 = READ REQ DEF RWC RCODE 2 = WRITE REQ DEF RWC RCODE 3 = CONTROL DEF ERDS6 RCODE 4 = UNDEFINED(DISC ALLOC) DEF ERDS6 RCODE 5 = UNDEFINED (PKG.TRK.REL) DEF PKILL RCODE 6 = PROGRAM TERMINATION DEF ERDS6 RCODE 7 = UNDEFINED(PRG.SUSPEND) DEF ERDS6 RCODE 8 =" UNDEFINED(SEG.LOAD) DEF PASON RCODE 9 = SCHEDULE W/WAIT DEF SCHED RCODE 10= PROGRAM SCHED(WON'T WAIT) DEF STIME RCODE 11= TIME REQUEST DEF SCHED RCODE 12= EXECUTION TIME DEF ISTAT RCODE 13= I/O STATUS DEF ERDS6 RCODE 14= UNDEFINED (STRING GET) DEF ERDS6 RCODE 15= UNDEFINED (GLOBAL TRK. ALLOC.) DEF ERDS6 RCODE 16= UNDEFINED (GLOBAL TRK. RLS.) DEF ERDS6 RCODE 17= UNDEFINED (CLASS READ) DEF ERDS6 RCODE 18= UNDEFINED (CLASS WRITE) DEF ERDS6 RCODE 19= UNDEFINED (CLASS CONTROL) DEF ERDS6 RCODE 20= UNDEFINED (CLASS WRITE-READ) DEF ERDS6 RCODE 21= UNDEFINED (CLASS GET) DEF ERDS6 RCODE 22= UNDEFINED (SWAP CONTROL) DEF PASON RCODE 23= QUEUE-SCHEDULE W/WAIT DEF PASON RCODE 24= QUEUE-SCHEDULE W/O WAIT DEF PARST RCODE 25= PARTITION STATUS DEF ERDS6 RCODE 26= UNDEFINED (MEMORY SIZE RTE-IV) TABAD DEF *,I * UPLIM ABS LOW1-* REQUEST CODE LIMIT-VALUE: -(MAX. RCODE+1) * DBMAX ABS #DBS CONSTANT: MAXIMUM DATA BUFFER SIZE. L#MHD ABS #MHD MINIMUM REPLY LENGTH L#IBL ABS #IBL+1 MAXIMUM REQ LENGTH. L#TYR ABS #TYR+1 RC=11 (TIME REQUEST) REPLY LENGTH. L#ST3 ABS #ST3+1 I/O OR PARTITION STATUS REPLY LENGTH. L#KST ABS #KST+1 RC=99 (PROGRAM STATUS) REPLY LENGTH. MAXRQ ABS #DLW MAXIMUM REQUEST LENGTH. SAVLN ABS #BFL+2 MAXIMUM HOLD-CLASS REQUEST LENGTH. L#PGN ABS -#PGN-3 -(MINIMUM REQUEST LENGTH) FOR RC=10. SPC 1 DABUF BSS #DBS DATA BUFFER RQB EQU #RPB REQUEST BUFFER (EXTERNAL) SAVCL NOP CLASS NO. W/BUFFER-SAVE & CLASS-SAVE PURCL NOP CLASS NO. W/CLASS-SAVE ONLY. TEMP BSS 4 * HED EXECM: INITIAL CONFIGURATION * (C) HEWLETT-PACKARD CO. 1980 ORG DABUF CONFIGURATION: EXECUTED ON FIRST ENTRY. * CONFG NOP LDA $OPSY GET THE SYSTEM SPECIFICATION. AND D2 ISOLATE THE DMS BIT(#1). ߬SZA,RSS IF THIS IS NOT A DMS SYSTEM, JMP NODMS THEN NO NEED TO MODIFY CODE; DLD XSAI CHANGE THE 'STA B,I' INSTRUCTION DST DMS1 TO DMS'S 'XSA B,I' EQUIVALENT. DLD XLAI CHANGE THE 'LDA B,I' INSTRUCTION DST DMS2 TO DMS'S 'XLA B,I' EQUIVALENT. NODMS JSB DIRCT GET A DIRECT ADDRESS FOR THE DEF RTNDF CONFIGURED-CALL RETURN POINTER. JSB DIRCT GET A DIRECT ADDRESS FOR THE DEF UPRDF POINTER INTO THE REQUEST BUFFER. JSB DIRCT GET A DIRECT ADDRESS FOR THE DEF RQBAD POINTER TO THE REQUEST BUFFER. JSB DIRCT GET A DIRECT ADDRESS FOR THE DEF DABFA POINTER TO THE DATA BUFFER. * JSB CLRQ CLEAR AND DEF *+3 RELEASE DEF D2NA DEF #EXHC HOLDING CLASS. NOP [IGNORE ERRORS] * JSB CLRQ REQUEST A DEF *+3 NEW HOLDING CLASS DEF D1NA FOR USE BY DEF #EXHC IN TEMPORARY REQUEST STORAGE. JMP TERM ERROR!! WE CANNOT PROCEED! * LDA #EXHC GET THE RETURNED CLASS NUMBER. IOR CLCD1 INCLUDE NO-WAIT/SAVE BUFFER BITS, STA #EXHC AND CONFIGURE HOLDING CLASS WORD. XOR CLCD2 FORM NO-WAIT/SAVE CLASS PARAMETER, STA EXHCL AND CONFIGURE THE CLASS CLEANUP WORD. * JSB CLRQ CLEAR AND DEF *+3 RELEASE DEF D2NA DEF #EXTC TEMPORARY CLASS. NOP [IGNORE ERRORS] * JSB CLRQ REQUEST A DEF *+3 NEW TEMPORARY CLASS DEF D1NA FOR USE BY DEF #EXTC IN DETERMINING BUFFER ADDRESS. JMP TERM ERROR!! WE CANNOT PROCEED! * LDA #EXTC GET RETURNED CLASS NUMBER. IOR CLCD1 INCLUDE NO WAIT/SAVE BUFFER BITS, STA #EXTC AND CONFIGURE TEMP. CLASS WORD. XOR CLCD2 FORM NO-WAIT/SAVE CLASS PARAMETER, STA EXTCYSL AND CONFIGURE CLASS CLEANUP WORD. * CLB NO NEED TO GO STB FIRST THRU THIS AGAIN. JMP CONFG,I GO TO START OPERATIONS. * CLCD1 OCT 140000 NO WAIT/SAVE BUFFER. CLCD2 OCT 060000 NO WAIT/SAVE CLASS. D1NA OCT 140001 D2NA OCT 140002 XLAI XLA B,I 'XLA' INSTRUCTION. XSAI XSA B,I 'XSA' INSTRUCTION. * DIRCT NOP DIRECT ADDRESS TRACK-DOWN ROUTINE. LDA DIRCT,I GET LOCATION OF DEF INSTRUCTION. STA B SAVE, TEMPORARILY. LDA A,I TRACK DOWN RAL,CLE,SLA,ERA A JMP *-2 DIRECT ADDRESS. STA B,I ESTABLISH DIRECT ADDRESS, AS REQUESTED. ISZ DIRCT SET RETURN FOR P+2, JMP DIRCT,I AND RETURN TO THE CALLER. * TERM JSB EXEC CALL IT QUITS! DEF *+2 WE CANNOT OBTAIN DEF D6 SUFFICIENT RESOURCES! * ORR SIZE * END EXECM ʙ 3O 91750-18112 2013 S C0122 &EXECW              H0101 ASMB,Q,C HED EXECW: SCHEDULE-WITH-WAIT PROCESSOR *(C) HEWLETT-PACKARD CO. 1980* NAM EXECW,19,30 91750-16112 REV.2013 800507 ALL SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME: EXECW * SOURCE: 91750-18112 * RELOC: 91750-16112 * PGMR: C. HAMILTON [07/28/77] * * * * * IS THE DS/1000 MONITOR, WHOSE FUNCTION IS TO PROCESS ALL * REQUESTS, WHICH ARE FORWARDED TO THIS NODE VIA SLAVE STREAM #3. ALL OF * THESE REQUESTS WILL HAVE BEEN ORIGINATED THROUGH A USER'S REQUEST TO THE * USER-INTERFACE MODULE. REQUESTS PROCESSED BY ARE * HANDLED ON A 'FIRST COME, FIRST SERVED' BASIS! THUS, IF IS * 'WAITING' FOR COMPLETION OF A PREVIOUSLY-SCHEDULED PROGRAM, A NEW * REQUEST CANNOT BE HONORED, UNTIL THE PREVIOUS REQUEST HAS COMPLETED. * * THE CURRENT USER'S NODE NUMBER WILL BE STORED IN #CNOD, IN . * ( WHEN IS INACTIVE, #CNOD WILL CONTAIN -1 ) * * NOTE: SPECIAL PROCESSING IS PROVIDED FOR THE RTE-M&L ABSOLUTE * LOADER (SEE INFORMATION FOR SUBROUTINE 'APLCK'). * * THOSE REQUESTS WHICH ARE ACCEPTABLE FOR PROCESSING VIA * MAY BE CLASSIFIED UNDER THE FOLLOWING 'EXEC' REQUEST CODES: * * 6 - TERMINATE A PROGRAM (PREVIOUSLY SCHEDULED VIA ) * ** NOTE: NOT SUPPORTED IN RTE-L ENVIRONMENT REJECTED: DS06! * * * 9 - SCHEDULE A PROGRAM WITH 'WAIT' (REPLY RETURNED UPON COMPLETION) * * 23 - QUEUE-SCHEDULE A PROGRAM WITH 'WAIT' (SCHEDULE WHEN AVAILABLE) * (REPLY RETURNED UPON COMPLETION OF SCHEDULED PROGRAM) * * * NOTE: FOR RC=9,23 PARAMETERS RETURNED FROM THE SCHEDULEE-VIA 'PRTN' OR * 'PRTM'-WILL BE PASSED TO THE CALLER. [ SETS =-1, * TO INFORM THAT PARAMETERS HAVE BEEN RETURNED.] * ALSO, IF REQUEST CODE BIT #11=1, THE SCHEDULED PROGRAM MAY BE * CLONED, BY THE #SCSM ROUTINE. * * 24 - QUEUE-SCHEDULE A PROGRAM IMMEDIATELY (SCHEDULE WHEN AVAILABLE) * (REPLY RETURNED AS SOON AS PROGRAM IS SCHEDULED) SKP * * ERRORS, ORIGINATING IN (ERROR QUALIFIER =3): * * "DS06" - ILLEGAL REQUEST CODE (NOT 6,9,23,24) * * "DS08" - INSUFFICIENT MEMORY FOR 'STRING BUFFER', OR NOT DORMANT. * * "RS01" - NO REMOTE SESSION SCB. * "SC01" - MISSING SCHEDULING PARAMETER. * "SC02" - ILLEGAL SCHEDULING PARAMETER. * "SC05" - ATTEMPT TO CONTROL , OR UNDEFINED PROGRAM. * * "XXNN" - [ RTE SYSTEM-ORIGINATED ERRORS, ERROR QUALIFIER =0 ] SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERRO"bR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L]. #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP * EXT #ATCH,#CNOD,#GET,#LNOD,#NODE,#RPB,#SCSM,#SLAV EXT $LIBR,$LIBX,$OPSY,DTACH,EXEC,RMPAR,PGMAD EXT .CAX,.DSX,.MVW,.CBT A EQU 0 B EQU 1 RQB EQU #RPB SUP SPC 2 EXECW JSB RMPAR RETRIEVE THE DEF *+2 SCHEDULING DEF SAVCL PARAMETER(S). * CLB LDA $OPSY GET THE SYSTEM SPECIFICATION. AND D4 ISOLATE THE RTE-M&L BIT(#2). SZA IF NOT RTE-M OR L, SKIP STB SCHD0 ELSE, PREVENT PROCESSING. * STB DABUF CLEAR NAME BUFFER, WORD #1. JSB PGMAD GO TO DEF *+3 OBTAIN DEF DABUF DEF XEQT ID ADDRESS. * LDB RQBAD GET A JMP *+2 DIRECT LDB B,I ADDRESS RBL,CLE,SLB,ERB FOR THE JMP *-2 REQUEST STB RQBAD BUFFER. * * CALL TO 'GET' A NEW REQUEST. * GET JSB DTACH DETACH FROM A POSSIBLE SCB ASSOCIATION. DEF *+1 * JSB #GET WE WAIT FOR A REQUEST TO ARRIVE DEF *+6 DEF SAVCL MONITOR'S CLASS RQBAD DEF RQB REQUEST BUFFER ADDRESS. DEF L#DLW MAXIMUM REQUEST LENGTH. DABFA DEF DABUF DATA BUFFER ADDRESS. DEF DBMAX MAXIMUM DATA BUFFER SIZE. JMP GET IGNORE INITIAL ERRORS! * DST SAVA = REQUEST LENGTH; = DATA LENGTH. LDA L#MHD INITIALIZE FOR A STA RPLYL MINIMUM-LENGTH REPLY. * SKP * * EXAMINE AND VERIFY THE REQUEST CODE (VALID CODES: 6,9,23,24) * LDA RQB+#ICD GET THE REQUEST CODE. AND CLNMS EXCLUDE THE 'CLONE-OK' BIT (#11). CPA D6 TERMINATION REQUEST? JMP PKILL YES, GO TO KILL THE PROGRAM. CPA D9 SCHEDULE WITH WAIT? JMP SCHED YES. GO TO SCHEDULE & WAIT. CPA D23 QUEUE-SCHEDULE WITH WAIT? JMP SCHED YES--THAT'S ACCEPTABLE. CPA D24 QUEUE-SCHEDULE WITHOUT WAIT? JMP SCHED YES--ACCEPT THAT REQUEST, ALSO. * ERDS6 DLD DS06 ERROR "DS06": BAD REQUEST CODE. JMP ERRTN RETURN ERROR-CODE TO CALLER. ERS01 DLD RS01 "RS01": NO REMOTE SESSION SCB. JMP ERRTN ERSC1 DLD SC01 ERROR "SC01": MISSING PARAMETER. JMP ERRTN ERSC2 DLD SC02 ERROR "SC02": INVALID PARAMETER. JM5aP ERRTN RETURN ERROR-CODES TO CALLER. ERSC5 DLD SC05 ERROR "SC05": IMPROPER PROGRAM REFERENCE. JMP ERRTN ERDS8 DLD DS08 ERROR "DS08": INSUFFICIENT RESOURCES. * ERRTN CCE ERROR RETURN. DST RQB+#EC1 CONFIGURE REPLY BUFFER WITH ERROR CODES. LDA RQB+#ECQ REMOVE THE OLD AND UPMSK ERROR QUALIFIER INFORMATION; IOR B60 INCLUDE THE EXECW QUALIFIER (3), STA RQB+#ECQ RESTORE THE MODIFIED WORD, AND JMP SNODE GO ESTABLISH NODE OF DETECTION. * SCDON CLB,CLE SCHEDULE-RETURN (NO PARAMETERS). * DONE DST RQB+#EC1 STORE REGISTERS IN WORDS 5&6 OF REPLY. SNODE LDA #NODE GET THE LOCAL NODE NUMBER, AND ELA,CLE,RAR INCLUDE ASCII-ERROR FLAG (BIT#15). STA RQB+#ENO STORE THE ERROR INDICATOR--IF ANY. LDA DM1 RESET #CNOD =-1, TO INDICATE JSB STCND THAT IS INACTIVE. * JSB NCLON GO TO REMOVE THE CLONE--IF ANY. * * CALL <#SLAV> TO INDICATE, TO THE USER, THAT THE REQUEST IS COMPLETE. * LDB RQBAD GET THE REPLY BUFFER ADDRESS. ADB RPLYL COMPUTE THE NEXT AVAILABLE LOCATION. LDA $OPSY GET THE OP-SYSTEM IDENTIFIER, STA B,I AND RETURN IT AS LAST WORD OF REPLY. ISZ RPLYL INCLUDE IDENTIFIER IN REPLY LENGTH. * SKP JSB #SLAV TRANSMIT DEF *+4 THE REPLY DEF RPLYL BACK TO THE ORIGINAL DEF DABUF REQUESTOR'S DEF D0 NODE. NOP IGNORE ERRORS--WE CAN DO NOTHING! JMP GET RETURN FOR THE NEXT REQUEST/COMPLETION. * SKP * PROGRAM COMPLETION, SCHEDULE W/WAIT, & QUEUE-SCHEDULEING RC=6,9,23,24 * PKILL LDB $OPSY PROGRAM TERMINATION. CPB DM31 IF ENVIRONMENT IS RTE-L, THEN JMP ERDS6 TERMINATION OF A SON IS NOT SUPPORTED. * SCHED IOR BIT15 ADD NO-ABORT BIT(#15) TO REQUEST CODE, STA RCODE AND SAVE FOR THE CALL TO 'EXEC'. c LDA RQB+#SID GET SESSION ID WORD FROM REQUEST. AND B377 ISOLATE DEST. SESSION ID (BITS# 7-0). STA TEMP SAVE SESSION ID FOR CALL. JSB #ATCH ATTACH TO THE SESSION CONTROL BLOCK. DEF *+2 DEF TEMP CPA DM1 JMP ERS01 ERROR: 'RS01' SCB NOT FOUND! * JSB CLONE CREATE A CLONE PROGRAM--IF REQUESTED. * JSB PGMAD GO TO GET THE SCHEDULEE'S STATUS. DEF *+6 THE PROGRAM OF INTEREST RQNAM DEF RQB+#PGN IS NAMED IN THE REQUEST BUFFER. DEF TEMP RETURNED: ID ADDRESS DEF TEMP+1 RETURNED: PROGRAM STATUS DEF TEMP+2 RETURNED: ID SEGMENT TYPE DEF TEMP+3 RETURNED: FATHER'S ID ADDRESS SZA ANY ATTEMPT TO CPA XEQT REMOTELY-CONTROL JMP ERSC5 IS UN-ACCEPTABLE! ERROR: "SC05". * LDB RCODE GET THE REQUEST CODE. ELB,CLE,ERB REMOVE THE NO-ABORT BIT(#15). CPB D6 PROGRAM TERMINATION REQUEST? JMP CKLIN YES. SKIP TO DETERMINE LINEAGE. JMP SCHD0 NO. IT'S A NORMAL SCHEDULE REQUEST. * CKLIN LDA TEMP+3 GET THE FATHER'S ID SEGMENT ADDRESS. CPA XEQT OUR OFFSPRING? JMP SCHD0+1 YES, WE CAN HONOR THE REQUEST. JMP ERSC5 NO. WE CANNOT PROCESS THE REQUEST. * SCHD0 JSB APLCK CHECK FOR [NOP: RTE-II/III/IV] LDA SAVA GET THE REQUEST LENGTH. ADA N#FNO IF THE LENGTH [AFTER APLCK COMPENSATION] SSA,RSS EXCEEDS MAX, THEN JMP ERSC2 IT IS AN INVALID REQUEST! * LDA L#MIN GET THE MINIMUM BUFFER SIZE. CMA,INA NEGATE. LDB RTNDF GET THE DEFAULT RETURN POINTER. ADA SAVA SUBTRACT THE MINIMUM FROM ACTUAL SIZE. ADB A COMPUTE THE ACTUAL RETURN ADDRESS, STB RTNAD AND CONFIGURE THE RETURN POINTER. SZA,RSS ANY ADDITIONAL PARAMETERS? JMP SCHD2 NO. GO CLEAR REMAINDER OF CALL BUFFER. * SSA Ƀ WERE WE SUPPLIED WITH ENOUGH PARAMETERS? JMP ERSC1 NO. * ERROR: SC01 ! * JSB .CAX YES. SAVE ADDITIONAL PARAMETER COUNT. LDA PR3DF = ADDRESS OF NEXT USER-PARAMETER LDB RTNDF =ADDRESS OF NEXT CALL-BUFFER LOCATION. SCHD1 STA B,I STORE PARAM ADDR INTO CALL BUFFER. INA ADVANCE PARAMETER POINTER. INB ADVANCE CALL BUFFER POINTER. JSB .DSX ALL PARAMETERS PROCESSED? JMP SCHD1 NO. PROCESS THE NEXT ONE. * CLA PREPARE TO CLEAR REST OF CALL BUFFER. SCHD2 ADB D2 ADVANCE POINTER PAST ERROR INSTRUCTIONS. CPB LASTA LAST CALL BUFFER LOCATION CLEARED? JMP SCHD3 YES. GO TO COMPLETE THE CALL. STA B,I NO. CLEAR THE LOCATION. INB ADVANCE THE CALL BUFFER POINTER, AND JMP SCHD2+1 GO TO CLEAR THE NEXT LOCATION. * SCHD3 LDA STRAD+1 GET THE STRING-SIZE POINTER--IF ANY. SZA,RSS PASSING A STRING TO THE PROGRAM? JMP SCHD4 NO. BYPASS DATA-BUFFER SET-UP. LDA DABFA GET LOCAL DATA BUFFER ADDRESS, STA STRAD AND ESTABLISH STRING-POINTER IN CALL. SCHD4 DLD ERRIN LOAD THE ERROR-DETECTION INSTRUCTIONS. DST RTNAD,I STORE THEM AT END OF CALLING SEQUENCE. LDA RQB+#SRC GET THE SOURCE-NODE. JSB STCND ESTABLISH CURRENT USER'S NODE IN . LDB DM1 PREPARE FOR RETURN-PARAMETER CHECKING. * * THE CONFIGURED 'EXEC' CALLING SEQUENCE IS EXECUTED BELOW: * JSB EXEC BUFFER FOR ASSEMBLING 'EXEC' REQUESTS. RTNAD DEF PR3AD RETURN POINTER (CONFIGURED). DEF RCODE REQUEST CODE (SUPPLIED BY CALLER) DEF RQB+#PGN POINTER TO FIRST REQUEST PARAMETER. PR3AD NOP CONFIGURED POINTERS (7-MAX.) TO NOP USER-SUPPLIED CALLING-PARAMETERS, NOP WHICH RESIDE IN THE REQUEST BUFFER. NOP UN-USED CALLING-SEQUENCE LOCATIONS ARE NOP DYNAMICALLYp CHANGED TO 'NOP'. STRAD NOP STRING-BUFFER ADDRESS--IF ANY. NOP STRING-LENGTH POINTER--IF ANY. NOP [ ERROR-DETECTION INSTRUCTIONS: WILL BE NOP POSITIONED TO FOLLOW LAST POINTER ] ENDBF CPA DM1 REJECTING A STRING-PASSING REQUEST? JMP ERDS8 YES, SKIP TO RETURN "DS08". SEZ NO. WAS A SYSTEM-LEVEL ERROR DETECTED? JMP DONE YES. RETURN THE ERROR CODES TO CALLER! * CPB DM1 IF NO PARAMETERS WERE RETURNED, JMP SCDON THEN RETURN TO CALLER WITH =0; STA STCND ELSE, SAVE THE STATUS TEMPORARILY. * LDA B SOURCE=RETURN-PARAMETERS IN I.D.SEGMENT. LDB RTPRM DESTN.=EIGHTH WORD OF REPLY BUFFER. JSB .MVW MOVE THE PARAMETERS TO THE REPLY BUFFER. DEF D5 NOP * LDA L#RPM SET THE STA RPLYL REPLY LENGTH. LDA STCND RECOVER THE PROGRAM STATUS. CCB,CLE INDICATE: PARAMETERS RETURNED--NO ERROR. JMP DONE COMPLETE THE REQUEST PROCESSING. * * SESSION MONITOR INTERFACING ROUTINE: CLONE A PROGRAM. * CLONE NOP CREATE A CLONE, CLA IF THE CLONE-OK BIT(#11) OF RC IS SET. JSB #SCSM CALL THE CLONE ESTABLISHMENT ROUTINE. JMP ERSC5 CANNOT BE DONE: ERROR 'SC05'! * LDA RQNAM GET REQ. BUFFER ADDRESS OF PGM. NAME, LDB SVNAM AND SAVE-BUFFER ADDRESS, TOO. JSB .MVW MOVE THE CLONE DEF D3 PROGRAM NAME NOP TO A SAFE PLACE. * JMP CLONE,I RETURN. * NCLON NOP LIQUIDATE A CLONE PROGRAM. LDA SVNAM GET ADDRESS OF SAVED PGM. NAME. JSB #SCSM GO TO ELIMINATE THE CLONE. JMP NCLON,I RETURN. * SVNAM DEF SAVBF SAVBF BSS 3 SAVE BUFFER FOR CLONE'S NAME. * SKP * SET #CNOD IN : + NODE # = CURRENT CALLER; -1 = INACTIVE. * STCND NOP JSB $LIBR D0 NOP STA /#CNOD SET INTO #CNOD, IN . JSB $LIBX DEF STCND RETURN. * * SPECIAL PROCESSING FOR IN RTE-M OR L ENVIRONMENT: * * IF NOT SCHEDULING , RETURN; ELSE, CHECK STATUS. * IF NOT DORMANT, REJECT "DS08"; ELSE, STORE SECURITY CODE AND * CARTRIDGE REFERENCE NO. INTO I.D. SEGMENT WORDS #27,28 * IN AN 'M', OR, IN THE 2ND SCHEDULE PARAMETER AND #ACRN IN * , RESPECTIVELY, IN AN 'L'. * STORE REQUEST'S SOURCE-NODE INTO #CNOD IN , AND ALSO STORE * FILE-LOCATION NODE INTO #LNOD IN . * APLCK NOP ADA D12 POINT TO I.D. SEGMENT WORD #13 (NAME). RAL FORM A BYTE ADDRESS STA B FOR THE PROGRAM'S I.D. SEGMENT "NAME". * LDA APLBA GET THE REFERENCE BYTE ADDRESS. JSB .CBT IF THIS IS AN SCHEDULE REQUEST, DEF D5 NOP JMP APSET THEN GO TO PROCESS IT'S PARAMETERS; JMP APLCK,I ELSE, NO FURTHER SPECIAL JMP APLCK,I PROCESSING IS REQUIRED. * APSET LDA TEMP+1 GET THE I.D. SEGMENT STATUS WORD. AND B17 ISOLATE CURRENT STATUS. SZA IF IT IS NOT AVAILABLE, JMP ERDS8 THEN, NOTHING MORE CAN BE DONE! * LDA SAVA COMPENSATE FOR THE CPA L#FNO THREE ADDITIONAL ADA DM3 REQUEST-PARAMETERS, USED TO STA SAVA SPECIFY DOWN-LOADING. * LDA $OPSY CPA DM31 L-SERIES ? JMP APSE1 YES, HANDLE EXTRA PARAMETERS * CLE,ERB CONVERT FROM BYTE, TO WORD ADDRESS. ADB D12 POINT TO I.D. SEGMENT WORD #27. LDA RQB+#IBF GET THE SECURITY CODE. JSB $LIBR NOP STA B,I SET SECURITY CODE INTO I.D. WORD #27. CLE,INB LDA RQB+#IBL GET THE CARTRIDGE REFERENCE NUMBER. STA B,I SET CRN INTO I.D. SEGMENT WORD #28. * LDB RQB+#FNO GET LOCATION-NODE FOR THE RELOC. FILE. STB #LNOD SET ,B@<#LNOD IN , FOR . JSB $LIBX DEF APLCK RETURN. * APSE1 LDA RQB+#IBF GET SECURITY CODE STA RQB+#PMS+1 MAKE IT SECOND PRAM. DLD RQB+#IBL GET CRN & NODE # DST DABUF SAVE IN DATA BUFFER. LDA D2 INSERT STRING LENGTH STA RQB+#IBL INTO REQUEST BUFFER. ADA SAVA COMPENSATE FOR STA SAVA STRING PASSING. JMP APLCK,I RETURN TO MAIN PROCESSING. * * APLBA DBL *+1 REFERENCE-NAME BYTE ADDRESS. ASC 3,APLDR * SKP DM31 DEC -31 DM3 DEC -3 DM1 DEC -1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D9 DEC 9 D12 DEC 12 B17 OCT 17 D23 DEC 23 D24 DEC 24 B60 OCT 60 B377 OCT 377 CLNMS OCT 173777 BIT #11 EXCLUSION MASK. BIT15 OCT 100000 DS06 ASC 2,DS06 DS08 ASC 2,DS08 RS01 ASC 2,RS01 SC01 ASC 2,SC01 SC02 ASC 2,SC02 SC05 ASC 2,SC05 RCODE NOP REQUEST CODE FOR CALL TO 'EXEC'. RPLYL NOP RTPRM DEF RQB+#RPM PR3DF DEF RQB+#PMS RTNDF DEF PR3AD DBMAX ABS #DBS MAXIMUM DATA BUFFER SIZE. LASTA DEF ENDBF L#FNO ABS #FNO+1 MAXIMUM 'APLDR' REQUEST LENGTH. L#MIN ABS #PGN+3 N#FNO ABS -#FNO-1 L#RPM ABS #RPM+5 L#DLW ABS #DLW L#MHD ABS #MHD TEMP BSS 4 UPMSK OCT 177400 XEQT NOP CONFIGURED ID ADDRESS: . * * * * DO NOT CHANGE ORDER OF NEXT SIX STATEMENTS * * * * ERRIN CCE,RSS CLE SAVA NOP NOP SAVCL NOP DABUF BSS #DBS DATA BUFFER. * * * * * * * * * * * * * * * * * * * * * * * * * * * * BSS 0 [ SIZE OF ] * END EXECW yB 4D 91750-18113 2013 S C0122 &FCHEK              H0101 nzASMB,Q,C HED FCHEK: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. NAM FCHEK,7 91750-1X113 REV.2013 790326 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FCHEK * EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS EXT D$ERR,D$RQB,D$IPM,D$NPM,D$SPM SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: FCHEK *SOURCE: 91750-18113 * RELOC: 91750-1X113 * PGMR: DMT LST ************************ FCHEK ************************* * * * SOURCE: 91750-18113 * * * * BINARY: 91750-1X113 * * * * PROGRAMMER: JIM HARTSELL * * * * DATE: AUGUST 13, 1975 * * * *--------------------------------------------------------* * * * MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING * * MARCH 26, 1979. * * * ********************************************************** SPC 2 FCHEK NOP ENTRY POINT. CLA STA PRAMS CLEAR OLD PARAM ADDRESSES. STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 STA PRAMS+4 LDA FCHEK STA ENTRY JMP BEGIN * PRAMS NOP FILE NUMBER. NOP ERROR CODE. NOP TRANSMISSION LOG. NOP BLOCK # (DBL-WORD). NOP # RECORDS IN BAD BLOCK. * ENTRY NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA B16 JSB D$STW FCHEK CODE = 16 OCTAL. * * MOVE USER PARAMS TO REQUEST BUFFER. * LDA N1 MOVE FNUM. JSB D$PRM * LDA N5 SET UP PARAMETER MASK. STA TEMP LDA DPRAM STA TEMP1 CLA,RSS LOOP RAL LDB TEMP1,I SZB IOR B1 SET BIT IF PARAM SPECIFIED. ISZ TEMP1 ISZ TEMP JMP LOOP JSB D$STW STORE MASK IN REQUEST. * * REQUEST BUFFER READY. SEND TO QUEX'S CLASS, * AND WAIT FOR REPLY. * JSB D3KMS SHIP REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * JMP RTPRM NORMAL RETURN. (A) = STATUS. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. * * PASS RETURN PARAMETERS TO CALLER. * RTPRM STA STAT SAVE STATUS WORD FOR RETURN. * LDB D$RQB IF REPLY PARAM NOT RETURNED, ADB B7 STORE ZERO IN PARAM SLOT. LDA B,I REPLY BYTE COUNT. ADB B7 STB TEMP POINTER TO LAST PARAM. INA ARS REPLY WORD COUNT. ADA N7 # PARAM WORDS TO CLEAR. SSA,RSS JMP RTP ALL PARAMS RETURNED. LOOP1 CLB STB TEMP,I LDB TEMP ADB N1 STB TEMP INA,SZA JMP LOOP1 * RTP LDB D255 SET UP FOR IMPOSSIBLE ERROR, LDA D$ERR AND CHECK DS ERROR CODE. SZA,RSS JMP RTPM1 NO ERROR POSTED. * CPA "DS" DS ERR OR: IMPOSSIBLE ERROR? RSS JMP POST YES. * DLD D$ERR ERROR CODE IS "DSXX". PERFORM MAPPING. LDA B LDB D254 CPA "01" JMP POST MAP "DS01" TO DECIMAL 254. LDB D245 CPA "05" JMP POST MAP "DS05" TO DECIMAL 245. LDB D216 CPA "06" JMP POST MAP "DS06" TO DECIMAL 216. LDB D255 IMPOSSIBLE ERROR. POST LDA D$RQB STORE DS ERROR IN REPLY BUFFER. ADA D9 STB A,I * RTPM1 LDB D$RQB INITIALIZE: ADB D9 (B) = ADDR OF 1ST REPLY VALUE. LDA DPRAM INA (A) = ADDR OF 1ST RETURN PARAM ADDR. JSB D$IPM * LDA N2 PASS ERROR CODE, TLOG. CCB JSB D$NPM * LDA N2 PASS BLKNUM (2 WORDS). JSB D$SPM * CCA PASS NUMREC (1 WORD). JSB D$SPM * LDA STAT RESTORE STATUS WORD. JMP ENTRY,I RETURN. SPC 3 * * CONSTANTS AND WORKING STORAGE. * A EQU 0 B EQU 1 B1 OCT 1 B7 OCT 7 B16 OCT 16 D9 DEC 9 D216 DEC 216 D245 DEC 245 D254 DEC 254 D255 DEC 255 N1 DEC -1 N2 DEC -2 N5 DEC -5 N7 DEC -7 BIT15 OCT 100000 STAT NOP TEMP NOP TEMP1 NOP "DS" ASC 1,DS "01" ASC 1,01 "05" ASC 1,05 "06" ASC 1,06 * BSS 0 SIZE OF FCHEK * END D 5= 91750-18114 2013 S C0122 &FCLOS              H0101 yASMB,Q,C HED FCLOS: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. NAM FCLOS,7 91750-1X114 REV.2013 790326 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FCLOS,FRDSK,FRLAB,FWLAB,FSPAC,FPOIN,FCNTL ENT FSTMD,FRNAM,FRLAT,FLOCK,FUNLK * EXT D$RQB,D$NWD EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS EXT D$ERR,D$NWD,D$ASC,D$IPM,D$SPM SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: FCLOS *SOURCE: 91750-18113 * RELOC: 91750-1X113 * PGMR: DMT LST ************************* FCLOS ************************* * * * SOURCE: 91750-18113 * * * * BINARY: 91750-1X113 * * * * PROGRAMMER: JIM HARTSELL * * * * DATE: AUGUST 13, 1975 * * * *---------------------------------------------------------* * * * MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING * * MARCH 26, 1979. * * * *********************************************************** SPC 2 A EQU 0 B EQU 1 SUP SPC 3 FCLOS NOP FCLOSE. SJSB ENTRY OCT 203 * FRDSK NOP FREADSEEK. JSB ENTRY OCT 501 * FRLAB NOP FREADLABEL. JSB ENTRY OCT 1001 * FWLAB NOP FWRITELABEL. JSB ENTRY OCT 1101 * FSPAC NOP FSPACE. JSB ENTRY OCT 1302 * FPOIN NOP FPOINT. JSB ENTRY OCT 1401 * FCNTL NOP FCONTROL. JSB ENTRY OCT 1703 * FSTMD NOP FSETMODE. JSB ENTRY OCT 2002 * FRNAM NOP FRENAME. JSB ENTRY OCT 2101 * FRLAT NOP FRELATE. JSB ENTRY OCT 2202 * FLOCK NOP FLOCK. JSB ENTRY OCT 2302 * FUNLK NOP FUNLOCK. JSB ENTRY OCT 2401 * * ALL ENTRY POINTS CONVERGE HERE. * ENTRY NOP LDA ENTRY,I SAVE FUNCTION CODE. ALF,ALF RAL,RAL AND B77 STA FCN LDA ENTRY,I SAVE # OF INITIAL PARAMS. AND B77 CMA,INA STA NUM CLA CLEAR OLD PARAM ADDRESSES. STA PRAMS STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 LDA ENTRY GET ADDR OF USER'S JSB + 1. ADA N2 LDA A,I STA RETRN SET UP FOR .ENTR CALL. JMP BEGIN * PRAMS NOP NOP NOP NOP * RETRN NOP COMMON ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS * CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA FCN JSB D$STW STORE FUNCTION CODE IN REQUEST. * * MOVE USER PARAMS TO REQUEST BUFFER. * LDA NUM MOVE INITIAL PARAMETERS. JSB D$PRM * * PERFORM SPECIAL HANDLING FOR CERTAIN FILE CALLS. * LDA FCN CPA B5 JMP vF5 FREADSEEK. CPA B10 JMP F11 FREADLABEL. CPA B11 JMP F11 FWRITELABEL. CPA B14 JMP F5 FPOINT. CPA B21 JMP F21 FRENAME. JMP SEND * F5 LDA N2 FREADSEEK: JSB D$NWD MOVE RECNUM. JMP SEND * F11 CLA FWRITELABEL AND FREADLABEL: LDA PRAMS+2,I JSB D$STW STORE TCOUNT (+WORDS). CLA (A) CLEARED IN CASE NO PARAM. LDA PRAMS+3,I JSB D$STW STORE LABELID. * LDA DPRAM SET UP PARAMETER MASK. STA TEMP LDA N4 MAX. NUMBER OF PARAMS. STA TEMP1 CLA,RSS MSK RAL SHIFT ACCUMULATED BITS. LDB TEMP,I SEE IF PARAM GIVEN. SZB IOR B1 YES. SET THE BIT. ISZ TEMP ISZ TEMP1 JMP MSK LOOP TILL DONE. * JSB D$STW STORE MASK. LDA FCN DONE IF FREADLABEL. CPA B10 JMP SEND LDA PRAMS+1 FWRITELABEL. SZA,RSS JMP SEND NO TARGET ADDRESS. CLA CLEARED IN CASE NO PARAM. LDA PRAMS+2,I SZA,RSS JMP SEND TCOUNT IS ZERO OR NOT GIVEN. SSA ARS NEG BYTES. MAKE NEG WORDS. SSA,RSS CMA,INA POS WORDS. MAKE NEG WORDS. JSB D$NWD STORE LABEL. JMP SEND * F21 LDA PRAMS+1 FRENAME: LDB N14 SZA SKIP IF NO FILE NAME. JSB D$ASC STORE NEW FILE NAME. * * REQUEST BUFFER READY. SEND TO QUEX'S CLASS, * AND WAIT FOR REPLY. * SEND JSB D3KMS SHIP REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * * PASS ANY RETURN PARAMETERS TO USER. * STA TEMP SAVE STATUS WORD. * LDA FCN CHECK TYPE OF CALL. CPA B10 JMP FF10 CPA B17 JMP FF17 CPA B22 RSS JMP RET * LDB D$RQĀB FRELATE: ADB D9 LDA B,I PASS JMP RETRN,I (A) = INT-OR-DUP WORD. * FF17 LDB D$RQB FCONTROL: ADB D9 LDB B,I GET RETURN PARAMETER. LDA PRAMS+2 SZA STB A,I PASS TO CALLER. JMP RET * FF10 LDA PRAMS+1 IF NO TARGET ADDR, SZA,RSS JMP RET DON'T PASS LABEL. LDA DPRAM FREADLABEL: INA LDB D$RQB ADB D9 JSB D$IPM INITIALIZE PARAM PASSERS. * LDA D$RQB DETERMINE # WORDS IN LABEL. ADA B7 LDA A,I ADA N1 # BYTES -1 (DELETE STATUS WORD). ARS # WORDS. CMA,INA NEG. # WORDS. SZA SKIP IF NO LABEL RETURNED. JSB D$SPM PASS N-WORD PARAM. * RET LDA TEMP RESTORE STATUS WORD. * JMP RETRN,I RETURN TO USER. (A) = STATUS. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP RETRN,I RETURN. SKP * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B5 OCT 5 B7 OCT 7 B10 OCT 10 B11 OCT 11 B14 OCT 14 B17 OCT 17 B21 OCT 21 B22 OCT 22 B77 OCT 77 N1 DEC -1 N4 DEC -4 D9 DEC 9 N2 DEC -2 N14 DEC -14 BIT15 OCT 100000 TEMP NOP TEMP1 NOP FCN NOP NUM NOP * END K 6? 91750-18116 2013 S C0122 &FCOPY              H0101 |ASMB,C,Q HED FCOPY: 91750-1X116 REV 2013 (C) HEWLETT-PACKARD CO. 1980 NAM FCOPY,7 91750-1X116 REV 2013 800429 ALL SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * NAME: FCOPY * SOURCE: 19750-18116 * RELOC: 19750-1X116 * PGMR: DAN GIBBONS * *************************************************************** SPC 3 * FCOPY IS THE GENERAL FILE TRANSFER UTILITY. * IT WILL TRANSFER ANY FILE WITH RECORD LENGTHS <= 128 WORDS * FROM ANY DISK IN THE NETWORK TO ANY OTHER DISK IN THE NETWORK. * * THE CALLING SEQUENCE IS : * JSB FCOPY * DEF *+6 TO *+12 * DEF ORIGIN FILE NAME * DEF ORIGIN CRN VECTOR * DEF DESTINATION FILE NAME * DEF DESTINATION CRN VECTOR * DEF IERR * DEF ORIGIN FILE SECU (OPTIONAL) * DEF DEST FILE TYPE (OPTIONAL) * DEF DEST FILE SIZE (OPTIONAL) * DEF DEST FILE REC-SIZE (OPTIONAL) * DEF TRANSFER MODE (OPTIONAL) * DEF DEST FILE SECU (OPTIONAL) * * IN CASE OF DUPLICATE DESTINATION FILE NAME, * THE FIRST 2 CHARACTERS OF THE NAME WILL BE CHANGED * TO "..". IF THIS NAME IS ALSO EXISTING THERE WILL BE * AN ERROR RETURN. * * NEGATIVE VALUES FOR DESTINATION FILE SIZE PARAMETER * ARE NOT ALLOWED SINCE A LINE FAILURE BEFORE * TRUNCATION AT 'DCLOS' TIME WOULD RESULT IN GOBBLING * ALL THE REMAINING SPACE ON THE REMOTE DISC. A -6 * ERROR CODE (NO ROOM) IS RETURNED IF THIS IS ATTEMPTED. * * IF TRANSFER MODE PARAMETER IS GIVELN AND IS NON- * ZERO, THE DESTINATION FILE WILL BE CREATED AS USUAL * BUT BOTH FILES WILL BE OPENED AS TYPE 1'S. THIS WILL * NORMALLY RESULT IN INCREASED LINE EFFICIENCY SINCE * VARIABLE RECORD LENGTH FILES WILL THEN BE TRANSFERRED * IN 128 WORD DATA BLOCKS RATHER THAN RECORD BY RECORD. * !!!CAUTION!!! * THIS METHOD SHOULD BE USED ONLY IF THE SOURCE FILE * HAS NO EXTENTS. EXTENTS ARE NOT COPIED TO * THE DESTINATION FILE WHEN FILES ARE OPENED AS TYPE 1 * FILES. FAILURE TO OBSERVE THIS WARNING WILL NOT CAUSE * A RETURNED ERROR CODE, BUT WILL NEVERTHELESS RESULT * IN A CORRUPT DESTINATION FILE. * * * ERROR CODES : * IERR > 0 :WARNING * IERR = 0 :NO ERROR * IERR < 0 :ERROR; CALL DSERR TO FIND ERROR NODE * * WARNINGS : * IERR = 1 DUPLICATE FILE NAME, CORRECTED * SPC 3 ENT FCOPY EXT .ENTR EXT DCRET,DOPEN,DREAD,DWRIT,DCLOS EXT DPURG EXT DLOCF EXT IFBRK EXT #RQB,#NODE SPC 3 SUP SKP * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) Io;S * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * SRCFL NOP SOURCE FILE NAME SRCCR NOP SOURCE CRN VECTOR DSTFL NOP DESTINATION FILE NAME DSTCR NOP DESTINATION CRN VECTOR IERR NOP ERROR PARAMETER ISEC1 NOP ORIGIN FILE SECU ITYP2 NOP DEST FILE TYPE ISIZ2 NOP DEST FILE SIZE IREC2 NOP DEST FILE REC-SIZE IMODE NOP TRANSFER MODE ISEC2 NOP DESTINATION FILE SECU SPC 2 FCOPY NOP ENTRY POINT JSB .ENTR DEF SRCFL * * CLA STA IERR,I CLEAR THE ERROR CODE LDA DSTFL,I TRANSFER THE DESTINATION STA DSTFN FILE NAME ISZ DSTFL (WE DONT WANT TO CHANGE DLD DSTFL,I THE USER'S CODE EVEN IF WE DST DSTFN+1 HAVE TO CHANGE THE DEST FILE NAME) LDA ISEC1 SET ISEC1 TO SZA VALUE IF GIVEN, LDA A,I ELSE TO STA ISEC1 ZERO. * LDB D1 GET OPEN OPTION JSB OPENO OPEN ORIGIN FILE * LOOK JSB DLOCF USE THIS TO FIND THE TYPE, DEF *+10 SIZE & RECORD SIZE OF THE FILE DEF ODCB TO BE TRANSFERED DEF YERR DEF NOP DEF NOP DEF NOP DEF ISIZE # OF SECTORS OF THE FILE RETURNED HERE DEF NOP DEF FLTYP FILE TYPE DEF ISIZE+1 RECORD SIZE * LDA ISIZ2 SZA,RSS DEST SIZE GIVEN? JMP FC01 NO LDA A,I YES, GET IT SSA NEGATIVE VALUES JMP M6ERR NOT ALLOWED. ALS CONVERT TO SECTORS SZA IF NOT ZERO, OVERRIDE STA ISIZE ORIG FILE SIZE. * FC01 LDA IREC2 SZA,RSS DEST REC-SIZE GIVEN? JMP FC02 NO LDA A,I YES, GET IT SZA IF NOT ZERO, OVERRIDE STA ISIZE+1 ORIG REC-SIZE. * FC02 LDB FLTYP IF ITYP2 IS NOT CLA GIVEN OR IS ZERO, LDA ITYP2,I DEFAULT TO ORIGIN TYPE. SZA LDB A STB ITYP2 * LDA ISIZE DCRET NEEDS # OF BLOCS, SO WE HAVE CLE,ERA TO DIVIDE ISIZE BY 2 SEZ INCREMENT A IF ISIZE WAS ODD INA STA ISIZE SAVE THE # OF BLOCS * CLA (IN CASE ISEC2 NOT SPECIFIED) LDA ISEC2,I SET ISEC2 TO SPECIFIED VALUE STA ISEC2 OR TO 0. * JSB DCRET CREATE THE DESTINATION FILE DEF *+8 DEF DDCB DESTINATION DCB DEF YERR DEF DSTFN DEST. FLAME DEF ISIZE DEF ITYP2 FILE TYPE DEF ISEC2 DEST SECURITY CODE DEF DSTCR,I DEST. CRN * SSA,RSS HOW WAS IT ? JMP CLOSE OK, GO CLOSE BOTH FILES CPA MD2 DUPLICATE FILE NAME ? JMP RETRY YES, TRY WITH ANOTHER NAME LDB D1 FILE CLOSE OPTION JMP ERROR GET OUT * CLOSE JSB CLOSO CLOSE BOTH ORIG JSB CLOSD AND DEST FILES. * * NOW OPEN BOTH FILES * LDB D1 GET DEFAULT OPEN OPTION CLA PROTECT AGAINST IMODE = 0 LDA IMODE,I SZA IMODE GIVEN AND NON-ZERO? LDB D5 YES, USE TYPE 1 OPEN OPTION STB IMODE SAVE OPEN OPTION JSB OPENO OPEN ORIGIN FILE * LDB IMODE GET OPEN OPTION BACK JSB OPEND OPEN DEST FILE * * IF ORIG IS TYPE 1, OR IF WE HAVE OPENED IT AS A TYPE 1, WE * WANT A 128 WORD BUFFER. OTHERWISE, WE WANT A 129 WORD BUFFER * SO WE CAN CHECK FOR BUFFER OVERFLOW. * LDA D129 LDB FLTYP GET ORIG TYPE CPB D1 TYPE 1? JMP DECR YES LDB IMODE GET OPEN OPTION CPB D5 TYPE 1 OPEN OPTION? DECR ADA MD1 YES, USE 128 WORD BUFR LENGTH STA BUFL SET BUFL FOR DREAD CALL SPC 3 * FILES SET UP, TRANSFER DATA * MOVE JSB DREAD READ FROM ORIGIN DEF *+6 DEF ODCB DEF YERR DEF BUF DATA BUFFER DEF BUFL DATA BUFFER LENGTH DEF LEN * SSA,RSS HOW WAS IT ? JMP WRT OK CPA MD12 NOT TOO GOOD. EOF ? JMP EOF YES LDB D2 THIS MUST BE AN ERROR, CLOSE OPTION JMP ERROR REPORT ERROR * EOF LDA MD1 FAKE LEN=-1 WITH NO ERROR STA LEN * WRT LDA LEN CPA D129 BUFFER OVERFLOW? RSS YES, ERROR JMP WRT1 NO, CONTINUE LDA MD4 SET ILLEGAL RECORD SIZE ERROR CODE LDB D2 JMP LOCER REPORT LOCALLY DETECTED ERROR * WRT1 JSB DWRIT WRITE THE BUFFER INTO THE FILE DEF *+5 DEF DDCB DEF YERR DEF BUF DEF LEN BUFFER LENGTH * SZA,RSS HOW WAS IT ? JMP TST OK qERR LDB D2 CLOSE OPTION JMP ERROR * TST JSB IFBRK DOES THE DEF *+1 OPERATOR SSA WANT OUT? JMP BREAK YES LDA LEN DID WE REACH INA THE END SZA OF FILE JMP MOVE NO SPC 3 * * TRANSFER ALL DONE, CLOSE THE FILES AND GO BACK TO CLASS * JSB CLOSD FIRST CLOSE THE DEST FILE JSB CLOSO NOW CLOSE THE ORIG FILE JMP EXIT RETURN TO USER SPC 2 M6ERR CLB INDICATE THAT NO FILES ARE OPEN LDA MD6 GIVE -6 ERROR JMP LOCER SPC 3 * BREAK SET. CLOSE ORIGIN FILE, PURGE DESTINATION. * BREAK LDA MD100 SET "BREAK" ERROR CODE LDB D2 * LOCER STA #RQB+#EC2 LOCALLY DETECTED ERROR. SIMULATE LDA "DS" ERROR IN REQ/RPY BUFFER SO USER STA #RQB+#EC1 CAN RETRIEVE ERROR INFO BY CALLING LDA #NODE DSERR. STA #RQB+#ENO CLA STA #RQB+#ECQ * LDA #RQB+#EC2 RETRIEVE ERROR CODE SPC 3 * ERROR PROCESSING * ERROR STB STATS SAVE STATUS STA IERR,I SAVE ERROR VALUE LDA #RQB+#EC1 SAVE THE ERROR CODES FROM THE STA $EC1 CURRENT REQ/RPY BUFFER. THEY LDA #RQB+#EC2 WILL BE RESTORED LATER SO USER STA $EC2 CAN CALL DSERR. LDA #RQB+#ENO STA $ENO LDA #RQB+#ECQ STA $ECQ SZB,RSS JMP ERXIT NO FILES ARE OPEN, SO JUST EXIT * JSB DCLOS CLOSE ORIGIN DEF *+3 DEF ODCB DEF YERR * * ISZ STATS RSS JMP ERXIT ONLY THE ORIGIN WAS OPEN * JSB DPURG DEST. ALSO CREATED, GET RID OF IT DEF *+6 DEF DDCB DEF YERR DEF DSTFN DEST FILE NAME DEF ISEC2 DEST FILE ISECU DEF DSTCR,I DEST CRN * ERXIT LDA $EC1 RESTORE THE ERROR CODES IN STA #RQB+#EC1 THE REQ/RPY BUFFER TO ALLOW LDA $EC2 U USER TO CALL DSERR. STA #RQB+#EC2 LDA $ENO STA #RQB+#ENO LDA $ECQ STA #RQB+#ECQ EXIT CLB CLEAR OPTIONAL STB ISEC1 PARAM ADR LOCS STB ITYP2 FOR NEXT CALL STB ISIZ2 AND EXIT. STB IREC2 STB IMODE STB ISEC2 JMP FCOPY,I SPC 3 * WE COME HERE IF THE DESTINATION FILE NAME IS A * DUPLICATE NAME. WE WILL TRY THE CREATION AGAIN * AFTER REPLACING THE FIRST TWO CHARACTERS OF THE * REQUESTED FILE NAME BY "..". IF THIS NAME IS ALSO * DUPLICATE, WE WILL QUIT. * RETRY LDA .. STA DSTFN BUILD THE NEW FILE NAME * JSB DCRET DEF *+8 DEF DDCB DEF YERR DEF DSTFN NEW FILE NAME DEF ISIZE DEF ITYP2 FILE TYPE DEF ISEC2 DEST ISECU DEF DSTCR,I DEST ICR * SSA,RSS HOW WAS IT ? JMP TELIT THIS TIME IT'S OK LDA MD2 STILL BAD, GIVE A DUPLICATE DESTINATION LDB MD1 CLOSE OPTION JMP LOCER FILE NAME ERROR RETURN * TELIT LDA D1 WRNG CODE FOR DUPLICATE FILE NAME STA IERR,I SPC 3 * ALL OK GO BACK TO WORK * JMP CLOSE SPC 2 * * OPEN ORIGIN FILE. ENTER WITH B = OPEN OPTION. * NO RETURN IF ERROR. * OPENO NOP STB TEMP SET OPEN OPTION * JSB DOPEN OPEN ORIGIN FILE DEF *+7 DEF ODCB ORIGIN DCB DEF YERR DEF SRCFL,I SOURCE FILE NAME DEF TEMP OPEN OPTION DEF ISEC1 ISECU FOR ORIGIN DEF SRCCR,I SOURCE CRN * SSA,RSS HOW WAS IT ? JMP OPENO,I ALL OK CLB FILE CLOSE OPTION JMP ERROR GET OUT SPC 2 * * OPEN DESTINATION FILE. ENTER WITH B = OPEN OPTION. * NO RETURN IF ERROR. * OPEND NOP STB TEMP SET OPEN OPTION * JSB DOPEN OPEN DEST FILE DEF *+7 DEF DDCB DEF YERR DEF DSTFN p0.* DEST FILE NAME DEF TEMP OPEN OPTION DEF ISEC2 SECURITY CODE DEF DSTCR,I DEST CRN ARRAY * SSA OK? JMP ERR NO, ERROR JMP OPEND,I YES, RETURN SPC 2 * * CLOSE DESTINATION FILE. NO RETURN IF ERROR. * CLOSD NOP * JSB DCLOS CLOSE THE DESTINATION FILE DEF *+3 DEF DDCB DEF YERR * SSA,RSS HOW WAS IT ? JMP CLOSD,I OK, CONTINUE LDB D2 CLOSE OPTION JMP ERROR SPC 2 * * CLOSE ORIGIN FILE. NO RETURN IF ERROR. * CLOSO NOP * JSB DCLOS NOW CLOSE THE ORIGIN FILE DEF *+3 DEF ODCB DEF YERR * SSA,RSS HOW WAS IT ? JMP CLOSO,I OK, RETURN LDB D1 CLOSE OPTION JMP ERROR SPC 2 SPC 3 * CONSTANTS AND BUFFERS * A EQU 0 B EQU 1 D1 DEC 1 D2 DEC 2 D5 DEC 5 D129 DEC 129 MD1 DEC -1 MD2 DEC -2 MD4 DEC -4 MD6 DEC -6 MD12 DEC -12 MD100 DEC -100 ISIZE BSS 2 FILE-SIZE/RECORD-SIZE FLTYP NOP NOP NOP LEN NOP STATS NOP ODCB BSS 4 DDCB BSS 4 BUF BSS 129 BUFL NOP .. ASC 1,.. YERR NOP DSTFN REP 3 NOP TEMP NOP "DS" ASC 1,DS * $EC1 NOP LOCAL STORAGE FOR $EC2 NOP REQ/RPY BUFFER INFO. $ENO NOP $ECQ NOP SPC 3 END C0 7 D 91750-18117 2013 S C0122 &FINFO              H0101 yASMB,Q,C HED FINFO: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. NAM FINFO,7 91750-1X117 REV.2013 790326 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FINFO * EXT D$RQB EXT .ENTR,D$INI,D$RFH,D$STW,D$PRM,D3KMS EXT D$ERR,D$IPM,D$NPM,D$SPM SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: FINFO *SOURCE: 91750-18117 * RELOC: 91750-1X117 * PGMR: DMT LST ************************* FINFO ************************* * * * SOURCE: 91750-18117 * * * * BINARY: 91750-1X117 * * * * PROGRAMMER: JIM HARTSELL * * * * DATE: AUGUST 13, 1975 * * * *---------------------------------------------------------* * * * MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING * * MARCH 26, 1979. * * * *********************************************************** SPC 2 B EQU 1 SUP SPC 2 FINFO NOP ENTRY POINT. LDA DPRAM CLEAR OLD PARAM ADDRESSES. STA ENTRY LDB COUNT CLA STA ZENTRY,I ISZ ENTRY INB,SZB JMP *-3 LDA FINFO STA ENTRY JMP BEGIN COUNT DEC -20 * PRAMS NOP FILE NUMBER. NOP FILE NAME ARRAY (14 WORDS). NOP FOPTIONS. NOP AOPTIONS. NOP RECORD SIZE. NOP DEVICE TYPE. NOP LOGICAL DEVICE #. NOP HARDWARE ADDRESS. NOP FILE CODE. NOP RECORD POINTER (DBL-WORD). NOP END-OF-FILE (DBL-WORD). NOP FILE LIMITS (DBL-WORD). NOP # RECORDS XF (DBL-WORD). NOP # PHYS I/O XF (DBL-WORD). NOP BLOCK SIZE. NOP EXTENT SIZE. NOP NUMBER OF EXTENTS. NOP USER LABELS. NOP CREATOR ID (4 WORDS). NOP LABEL ADDRESS (DBL-WORD). * ENTRY NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR * SKP * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA B15 JSB D$STW FINFO CODE = 15 OCTAL. * * MOVE USER PARAMS TO REQUEST BUFFER. * CCA MOVE FNUM. JSB D$PRM * * SET UP DBL-WORD PARAMETER MASK FOR 20 PARAMS: BIT 3 OF 1ST WORD * REPRESENTS THE FILNUM PARAM; BIT 0 OF 2ND WORD REPRESENTS * LABADDR. IF A BIT IS SET, THAT PARAMETER WAS SPECIFIED IN * THE CALLING SEQUENCE. * LDA DPRAM ADDR OF 1ST PARAM ADDRESS. LDB N4 CHECK 1ST 4 PARAMS FOR MASK(1). JSB BTMSK BUILD MASK WORD 1. JSB D$STW STORE WORD 1 OF MASK IN REQUEST. LDA DPRAM ADA B4 ADDR OF 5TH PARAM ADDRESS. LDB N16 CHECK LAST 16 PARAMS FOR MASK(2). JSB BTD(MSK BUILD MASK WORD 2. JSB D$STW STORE WORD 2 OF MASK IN REQUEST. * * REQUEST BUFFER READY. SEND TO QUEX'S CLASS, * AND WAIT FOR REPLY. * JSB D3KMS SHIP REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * * PASS RETURN PARAMETERS TO THE CALLER IF PARAM SPECIFIED. * STA TEMP SAVE STATUS WORD. * LDB D$RQB IF REPLY PARAM NOT RETURNED, ADB B7 STORE ZERO IN PARAM SLOT. LDA B,I REPLY BYTE COUNT. ADB D44 STB TEMP1 POINTER TO LAST PARAM. INA ARS REPLY WORD COUNT. ADA N44 # PARAMS WORDS TO CLEAR. SSA,RSS JMP RTP ALL PARAMS RETURNED. LOOP CLB STB TEMP1,I LDB TEMP1 ADB N1 STB TEMP1 INA,SZA JMP LOOP * RTP LDA DPRAM INITIALIZE: INA (A) = ADDR OF 1ST RETURN PARAM ADDR. LDB D$RQB ADB D9 (B) = ADDR OF 1ST REPLY VALUE. JSB D$IPM * LDA N14 RETURN FILE NAME (14 WORDS). JSB D$SPM * LDA N7 RETURN FOPTIONS THRU FILECODE. CCB (SINGLE WORD VALUES) JSB D$NPM * LDA N5 RETURN RECPT THRU PHYSCOUNT. LDB N2 (DOUBLE WORD VALUES) JSB D$NPM * LDA N4 RETURN BLKSIZE THRU USERLABELS. CCB (SINGLE WORD VALUES) JSB D$NPM * LDA N4 RETURN CREATORID. JSB D$SPM (4-WORD VALUES) * LDA N2 RETURN LABADDR. JSB D$SPM * LDA TEMP RESTORE STATUS WORD. JMP ENTRY,I RETURN TO USER. (A) = STATUS. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP ENTRY,I RETURN. * * SUBROUTINE TO BUILD PARAMETER BIT MASK. * (A) = ADDR OF 1ST PARAM. * (B) = # PARAMS. * BTMSK NOP STA TEMP SAVE PARAM ADDR. STB TEMP1 SAVE # PARAMS. CLA,RSS TRESET BIT MASK WORD. MSK RAL SHIFT ACCUMULATED BITS. LDB TEMP,I SEE IF PARAM GIVEN. SZB IOR B1 YES. SET THE BIT. ISZ TEMP ISZ TEMP1 JMP MSK LOOP FOR N PARAMS. JMP BTMSK,I RETURN. (A) = BIT MASK. SPC 4 * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B4 OCT 4 B7 OCT 7 B15 OCT 15 D9 DEC 9 D44 DEC 44 N1 DEC -1 N2 DEC -2 N4 DEC -4 N5 DEC -5 N7 DEC -7 N14 DEC -14 N16 DEC -16 N44 DEC -44 BIT15 OCT 100000 TEMP NOP TEMP1 NOP * END  8A 91750-18118 2013 S C0122 &FLOAD              H0101 xzASMB,L,R,C HED FLOAD 91750-16118 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM FLOAD,7 91750-16118 REV.2013 800430 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ********************************************** * *FLOAD SUBROUTINE TO DO FORCED DOWN LOAD OF * ABSOLUTE PROGRAM TO RTE-M OR L SYSTEM. * * NAME: FLOAD * SOURCE: 91750-18118 * RELOC: 91750-16118 * PGMR: JERRY BELDEN * *WRITTEN BY: LARRY POMATTO AUGUST 74 * *MODIFIED BY: JEAN-PIERRE D. BAUDOUIN JULY 76 * DAN GIBBONS FEB 77 * JDH FOR DS REQUEST EQUATED OFFSETS 790220 * GAB FOR 91750 ON 790607 * *********************************************** SPC 1 SUP * EXT #MAST,.ENTR,#TILT,#RQB EXT .MVW SPC 1 ENT FLOAD SPC 1 B EQU 1 RQB EQU #RQB SPC 1 * * CALLING SEQUENCE * JSB FLOAD * DEF *+6 TO *+10 * DEF PROGRAM FILE NAME * DEF CRN * DEF FILE NODE # (=>0) * DEF DESTINATION NODE * DEF ERROR CODE * DEF FILE SECURITY CODE (OPTIONAL) * DEF PARTITION # (OPTIONAL) * DEF PARTITION SIZE IN PAGES (OPTIONAL) * DEF 3 WORD ERROR MESSAGE BUFR (OPTIONAL) SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * *  * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV XXXX 790531 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXE SCM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #BFL EQU #CNW+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #PRM EQU #CNW+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24) (5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW/ EQU #MHD+12 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP FNAM NOP CRN NOP FNOD NOP FLU NOP FERCD NOP ISECU NOP PNUM NOP PSIZE NOP FERMG NOP SPC 2 ENTRY POINT FLOAD NOP JSB .ENTR PRMSA DEF FNAM * LDA FERCD ERROR RETURN SPECIFIED? SZA,RSS JMP EXIT NO, GET OUT QUICK * LDA FLU,I GET DESTINATION STA RQB+#DST * * LDA D3 SET STREAM TYPE STA RQB+#STR LDA D9 SET ICODE FOR STA RQB+#ICD SCHED-WITH-WAIT. * LDA APNAM MOVE "APLDR" NAME LDB PNAMA JSB .MVW DEF D3 NOP * LDA FNAM MOVE THE FILE NAME LDB NAMA JSB .MVW DEF D3 NOP * LDA CRN,I STA RQB+#PMS+6 * LDA FNOD,I STA RQB+#PMS+7 * CLA (IN CASE ISECU MISSING) LDB ISECU,I SET ISECU OR 0 STB RQB+#PMS+5 INTO REQST BUFR. * * FORMAT 1ST APLDR SCHED PARAM * LDB PNUM,I SET FUNCTION CODE TO 1 IF BOTH CLE,SZB,RSS PNUM & PSIZE ARE MISSING OR 0, LDB PSIZE,I ELSE 2. INCLUDE REMOTE BIT & LDA REM1 SET INTO REQST BUFR. SZB CCE,INA STA RQB+#PMS * * FORMAT 2ND APLDR SCHED PARAM * CLA,SEZ,RSS WERE PNUM & PSIZE MISSING? JMP SETP2 YES, SET SCHED PARAM TO ZERO LDA PSIZE,I NO, SET PNUM INTO BITS 0-5, ALF,ALF PSIZE INTO BITS 10-14. ALS,ALS IOR PNUM,I SETP2 STA RQB+#PMS+1 * JSB #MAST CALL MSTER TO SEND REQ DEF *+7 DEF CNWD DEF C.FN1 LENGTH OF RQBUF DEF * DUMMY DATA BUFR ADR DEF D0 NO DATA ASSOCIATED WITH REQST DEF D0 OR REPLY. DEF C.FN1 MAX REQST-REPLY LENGTH JMP LNERR LINE ERROR SPC 2 LDA RQB+#RPM GET APLDR ERROR CODE STA FERCD,I PASS IT TO USER STA RQB+#EC2 SET UP ERROR  LDA ASDS FOR A STA RQB+#EC1 POSSIBLE LDA RQB+#DST DSERR STA RQB+#ENO CALL LDA FERMG SEE IF WE MOVE OPTIONAL NAME SZA,RSS JMP EXIT NO LDA ERRA LDB FERMG PASS THE ERROR MESSAGE BACK TO THE USER JSB .MVW DEF D3 NOP JMP EXIT RETURN SPC 3 LNERR DST ERMS SAVE ERROR MESSAGE FROM A & B REG. CPA ASDS IS IT A "DSXX"ERROR ? JMP DSER YES JSB CLR NO, SYSTEM ERROR. CLEAR PARAM AREA LDB MSER FOR NEXT TIME & ABORT USER. LDA ERADD GET MESSAGE @ AND ERROR @ JSB #TILT WE DO NOT RETURN FROM THIS JSB * * WE WILL DECODE THE XX PART OF THE ERROR MESSAGE * AND MAP IT AS A NEGATIVE ERROR CODE FOR THE USER * & PASS THE ASCII ERROR MESSAGE TO USER IF WANTED. * DSER LDA ERMS+1 GET THE XX PART AND B17 GET VALUE OF THE LS DIGIT STA LCHAR SAVE LDA ERMS+1 GET VALUE AGAIN ALF,ALF SWAP CHARACTERS AND B17 GET UPPER CHARACTER'S VALUE MPY D10 WEIGHT IT ADA LCHAR WE NOW HAVE THE ERROR # CMA,INA MAKE IT <0 ADA DM50 MAP IT STA FERCD,I PASS IT TO THE USER * LDA FERMG IF THE USER WANTS IT WE WILL PASS HIM SZA,RSS THE ERROR MESSAGE JMP EXIT HE DOES NOT WANT IT, RETURN DLD ERMS GET THE MESSAGE DST FERMG,I PASS IT ISZ FERMG ISZ FERMG STEP TO LAST WORD LDA BLNK GET AN ASCII DOUBLE BLANK STA FERMG,I PASS IT * EXIT JSB CLR CLEAR PARAM AREA FOR NEXT TIME JMP FLOAD,I RETURN TO USER CLR NOP SUBR TO CLEAR PARAM AREA LDA DM9 CLEAR THE PARAMETER STA CNTR AREA BEFORE RETURNING. CLA LDB PRMSA CLR1 STA B,I INB ISZ CNTR JMP CLR1 JMP CLR,I RETURN SPC 3 D9 DEC 9 v$"D10 DEC 10 C.FN1 ABS #FNO+1 D0 DEC 0 D3 DEC 3 DM9 DEC -9 DM50 DEC -50 B17 OCT 17 REM1 OCT 100001 REMOTE BIT / FUNC = 1 LCHAR NOP MSER DEF ERMS ERMS BSS 2 PNAMA DEF RQB+#PGN NAMA DEF RQB+#PMS+2 ERRA DEF RQB+#RPM+1 APNAM DEF *+1 ASC 3,APLDR BLNK ASC 1, ASDS ASC 1,DS ERADD NOP CNWD OCT 140000 D65MS CONWD (NO ABORT, LONG TIMEOUT) CNTR EQU ERMS USE AS COUNTER BEFORE EXIT END $ 9 D 91750-18119 2013 S C0122 &FOPEN              H0101 ASMB,Q,C HED FOPEN: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. NAM FOPEN,7 91750-1X119 REV.2013 790328 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FOPEN,D$RFH * EXT .ENTR,D3KMS,D$INI,D$STW,D$3BF EXT D$PRM,D$NWD,D$ASC,D$RQB,D$ERR SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: FOPEN *SOURCE: 91750-18119 * RELOC: 91750-1X119 * PGMR: DMT LST ************************* FOPEN ************************* * * * SOURCE: 91750-18119 * * * * BINARY: 91750-1X119 * * * * PROGRAMMER: JIM HARTSELL * * * * DATE: AUGUST 7, 1975 * * * *---------------------------------------------------------* * * * MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING * * MARCH 26, 1979. * * * *********************************************************** SPC 2 A EQU 0 B EQU 1 SPC 2 FOPEN NOP ENTRY POINT. LDA DPRAM CLEAR OLD PARAM ADDRESSES. STA ENTRY LDB COUNT CLA STA ENTRY,I  ISZ ENTRY INB,SZB JMP *-3 LDA FOPEN STA ENTRY JMP BEGIN COUNT DEC -13 * PRAMS NOP FILE NAME (BYTE ARRAY) NOP FOPTIONS NOP AOPTIONS NOP RECORD SIZE NOP DEVICE SPECS (BYTE ARRAY) NOP FORMS MESSAGE (BYTE ARRAY) NOP # USER LABELS NOP BLOCK FACTOR NOP # BUFFERS NOP FILE SIZE (DBL-WORD) NOP # EXTENTS NOP INITALLOC NOP FILE CODE * ENTRY NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRESSES OF USER PARAMS. DPRAM DEF PRAMS CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR * * BUILD THE REQUEST BUFFER. BEGIN WITH SETUP OF * 8-WORD FIXED FORMAT HEADER FOR RFA, THEN "RFA " IN * THE NEXT TWO WORDS. * LDA DPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET CLASS, STREAM, & "RFA ". * CLA,INA JSB D$STW FOPEN CODE = 1. * * MOVE USER CALL PARAMETERS TO REQUEST BUFFER. * LDA N9 MOVE DUMMY,FOPTN,AOPTN,RECSZ, JSB D$PRM DUMMY,DUMMY,ULABL,BLCKF,NUMBF. * LDA N2 MOVE FILE SIZE JSB D$NWD (DOUBLE-WORD PARAM). * LDA N3 MOVE NUMXT,INALC,FLCOD. JSB D$PRM * * SET UP PARAMETER MASK FOR 13 PARAMS: BIT 12 REPRESENTS THE * FILENAME PARAM; BIT 0 REPRESENTS FILECODE. IF A BIT IS SET, * THAT PARAMETER WAS SPECIFIED IN THE CALLING SEQUENCE. * LDA DPRAM POINTER TO PARAM ADDRESSES. STA TEMP LDA N13 MAX. OF 13 PARAMS. STA TEMP1 CLA,RSS MSK RAL SHIFT ACCUMULATED BITS. LDB TEMP,I SEE IF PARAM GIVEN. SZB IOR B1 YES. SET THE BIT. ISZ TEMP ISZ TEMP1 JMP MSK LOOP FOR 13 PARAMS. STA TEMP SAVE PRELIMINARY MASK. -* * FOR ASCII PARAMETERS, CHECK WHETHER A FILLER OF ZERO * WAS GIVEN TO SPECIFY NO PARAMETER. * CLA CLEAR (A) IN CASE PARAM NOT SPECIFIED. CLB INITIALIZE RESET MASK. LDA PRAMS,I GET 1ST WORD OF FILE NAME (ASCII). SZA,RSS LDB B10K NO FILE NAME. SET BIT 12. CLA CLEARED IN CASE NO PARAM. LDA PRAMS+4,I GET 1ST WORD OF DEV NAME. SZA,RSS ADB B400 NO DEV NAME. SET BIT 8. CLA CLEARED IN CASE NO PARAM. LDA PRAMS+5,I GET 1ST WORD OF FORMMSG. SZA,RSS ADB B200 NO FORMMSG. SET BIT 7. CMB COMPLIMENT (B), LDA TEMP GET THE PRELIMINARY MASK, AND B AND CLEAR REQUIRED BITS. * JSB D$STW STORE MASK IN REQUEST. INA STA NBYTS * * MOVE ASCII STRINGS TO REQUEST BUFFER. * CLA CLEAR BYTE POINTERS IN REQUEST. LDB D$RQB ADB D11 STA B,I FILE NAME POINTER. ADB B4 STA B,I DEV NAME POINTER. INB STA B,I FORMMSG POINTER. * LDA PRAMS CHECK IF FILE NAME SPECIFIED. LDB A,I SZA SZB,RSS JMP SEND NO NAME. LDB D$RQB GET ADDR OF FLNAME BYTE ADB D11 POINTER IN RQBUF. LDA NBYTS REPLACE DUMMY VALUE WITH ADA N1 STA B,I BYTE POINTER TO ASCII STRING. LDA PRAMS MOVE FILE NAME ASCII STRING LDB N14 JSB D$ASC TO REQUEST BUFFER. INA STA NBYTS * LDA PRAMS+4 CHECK IF DEV NAME SPECIFIED. LDB A,I SZA SZB,RSS JMP FRMSG NO NAME. GO CHECK FORMMSG. LDB D$RQB ADB D15 LDA NBYTS REPLACE DUMMY VALUE WITH ADA N1 STA B,I BYTE POINTER TO ASCII STRING. LDA PRAMS+4 MOVE DEVICE NAME. LDB N4 MAX WORDS (NEG). JSB D$ASC INA STA NBYTS * FRMSG LDA PRAMS+m{5 CHECK IF FORMMSG SPECIFIED. LDB A,I SZA SZB,RSS JMP SEND NO FORMMSG. LDB D$RQB ADB D16 LDA NBYTS REPLACE DUMMY VALUE WITH ADA N1 STA B,I BYTE POINTER TO ASCII STRING. LDA PRAMS+5 MOVE FORMS MESSAGE. LDB N25 MAX WORDS (NEG). JSB D$ASC * * REQUEST BUFFER READY: D3KMS WILL WRITE IT TO QUEX'S * I/O CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET * IS COMPLETED WHEN THE REPLY ARRIVES. D3KMS WILL RETURN * WITH A-REG = STATUS WORD (FILE NUMBER). * SEND JSB D3KMS SHIP THE REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO ABORT. JMP ABERR ERROR RETURN. * AND B377 ISOLATE FILE NUMBER IN A-REG. JMP ENTRY,I RETURN TO USER. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP ENTRY,I FILE NUMBER = 0. SPC 3 * * D$RFH - COMMON SUBROUTINE FOR ALL RFA CALLS TO 3000. * SET UP FRONT END OF REQUEST BUFFER. * D$RFH NOP LDA B7 STORE MESSAGE CLASS = 7. STA D$3BF LDA B20 STORE STREAM TYPE = 20 OCTAL. STA D$3BF+2 LDA "RF" JSB D$STW STORE "RFA ". LDA "A" JSB D$STW JMP D$RFH,I RETURN. SPC 4 * * CONSTANTS AND WORKING STORAGE. * B1 OCT 1 B4 OCT 4 B7 OCT 7 B20 OCT 20 B377 OCT 377 B200 OCT 200 B400 OCT 400 B10K OCT 10000 D11 DEC 11 D15 DEC 15 D16 DEC 16 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N9 DEC -9 N13 DEC -13 N14 DEC -14 N25 DEC -25 "RF" ASC 1,RF "A" ASC 1,A BIT15 OCT 100000 NBYTS OCT 0 TEMP NOP TEMP1 NOP * END  :C 91750-18120 2013 S C0122 &FREAD              H0101 vqASMB,Q,C HED FREAD: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. NAM FREAD,7 91750-1X120 REV.2013 790412 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT FREAD,FRDIR * EXT .ENTR,D3KMS,D$INI,D$RFH,D$STW,D$PRM EXT D$ERR SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: FREAD *SOURCE: 91750-18120 * RELOC: 91750-1X120 * PGMR: DMT LST ************************* FREAD ************************* * * * SOURCE: 91750-18120 * * * * BINARY: 91750-1X120 * * * * PROGRAMMER: JIM HARTSELL * * * * DATE: AUGUST 14, 1975 * * * *---------------------------------------------------------* * * * MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING * * MARCH 26, 1979. * * * *********************************************************** SPC 2 A EQU 0 B EQU 1 SUP SKP FREAD NOP FREAD. JSB ENTRY B3 OCT 3 * FRDIR NOP FREADDIR. JSB ENTRY OCT 4 * ENTRY NOP CLA . CLEAR OLD PARAM ADDRESSES. STA PRAMS STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 LDA ENTRY,I SAVE FUNCTION CODE. STA FCN LDA ENTRY SET UP FOR .ENTR CALL. ADA N2 LDA A,I STA RETRN JMP BEGIN * PRAMS NOP FILE NUMBER. NOP BUFFER ADDRESS NOP BUFFER LENGTH NOP RECORD NUMBER. * RETRN NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRS OF USER PARAMS. DPRAM DEF PRAMS * CLA CLEAR ERROR CODE FOR FCHEK. CLB DST D$ERR SKP * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA FCN JSB D$STW FREAD CODE = 3, FRDIR = 4. * * MOVE USER PARAMS TO REQUEST BUFFER. * CCA JSB D$PRM MOVE FNUM. * LDA PRAMS+1 IF NO TARGET ADDR, SZA,RSS STA PRAMS+2 ZERO TCOUNT ADDR. CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+2,I STORE USER BUFFER LEN IN "TCOUNT". JSB D$STW + = WORDS, - = BYTES. * LDA FCN IF FREADDIR, STORE RECNUM. CPA B3 JMP SEND CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+3,I JSB D$STW LDA PRAMS+3 GET SECOND SZA WORD OF INA RECNUM. LDA A,I JSB D$STW * * SEND REQUEST TO 3000 BY WRITING TO QUEX'S CLASS, * AND WAIT FOR THE REPLY. * SEND JSB D3KMS DEF *+6 DEF BIT15 DEF 0 DEF 0 DEF PRAMS+1,I DEF PRAMS+2,I JMP ABERR ERROR RETURN. * * B-REG CONTAINS NUMBER OF BYTES RECEIVED FROM 3000. CLA CLEAR A-REG IN CASE NO PARAM. LDA PRAMS+2,I GET USER'S TCOUNT. SSA,RSS IF SIGN BIT NOT SET, CLE,ERB CHANGE BYTES TO WORDS. LDA B A-REG GEyk TS LENGTH. JMP RETRN,I NORMAL RETURN. SPC 2 * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP RETRN,I RETURN. SPC 3 N2 DEC -2 BIT15 OCT 100000 FCN NOP * BSS 0 SIZE OF FREAD. * END  ;C 91750-18121 2013 S C0122 &FWRIT              H0101 ASMB,Q,C HED FWRIT: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. NAM FWRIT,7 91750-1X121 REV.2013 790328 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 ENT FWRIT,FWDIR,FUPDT * EXT .ENTR,D3KMS,D$INI,D$RFH,D$STW,D$PRM,D$ERR SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: FWRIT *SOURCE: 91750-18121 * RELOC: 91750-1X121 * PGMR: DMT LST ************************* FWRIT ************************* * * * SOURCE: 91750-18121 * * * * BINARY: 91750-1X121 * * * * PROGRAMMER: JIM HARTSELL * * * * AUGUST 13, 1975 * * * *---------------------------------------------------------* * * * MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING * * MARCH 26, 1979. * * * *********************************************************** SPC 2 A EQU 0 B EQU 1 SUP SPC 2 FWRIT NOP FWRITE. JSB ENTRY B6 OCT 6 * FWDIR NOP FWRITEDIR. JSB ENTRY OCT 7 * FUPDT NOP FUPDATE. JSB ENTRY B12 OCT 12 * ENTRY NOP LDA ENTRY,I SAVE FUNCTION CODE. STA FCN CLA CLEAR OLD PARAM ADDRESSES. STA PRAMS STA PRAMS+1 STA PRAMS+2 STA PRAMS+3 LDA ENTRY SET UP FOR .ENTR CALL. ADA N2 LDA A,I STA RETRN JMP BEGIN * PRAMS NOP FILE NUMBER NOP BUFFER ADDRESS NOP BUFFER LENGTH NOP CONTROL WORD OR RECNUM. * RETRN NOP ENTRY POINT. BEGIN JSB .ENTR GET ADDRS OF USER PARAMS. DPRAM DEF PRAMS * CLA CLEAR ERROR CODE FOR FCHECK. CLB DST D$ERR * * BUILD FRONT END OF REQUEST BUFFER. * LDA DPRAM ADDR OF 1ST PARAM TO SEND. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB D$RFH SET UP FIXED FORMAT. * LDA FCN JSB D$STW FWRIT = 6, FWDIR = 7, FUPDT = 12. * * MOVE USER PARAMS TO REQUEST BUFFER. * CCA JSB D$PRM MOVE FNUM. * LDA PRAMS+1 IF NO TARGET ADDR, SZA,RSS STA PRAMS+2 CLEAR TCOUNT ADDR. CLA LDA PRAMS+2,I JSB D$STW STORE TCOUNT. * LDA FCN IF UPDATE, NO MORE PARAMS. CPA B12 JMP SEND * CLA CLEAR (A) IN CASE NO PARAM. LDA PRAMS+3,I JSB D$STW MOVE CONTROL WORD OR RECNUM. * LDB FCN IF FWRITE, CPB B6 JMP SEND DONE WITH APPENDAGE. * LDA PRAMS+3 FOR FWRITEDIR, STORE SZA WORD TWO OF RECNUM. INA LDA A,I JSB D$STW * * * SEND REQ AND DATA TO 3000 BY WRITING TO QUEX'S CLASS. * SEND JSB D3KMS SHIP REQUEST BUFFER TO QUEX, DEF *+4 AND WAIT FOR REPLY. DEF BIT15 DEF PRAMS+1,I DEF PRAMS+2,I JMP ABERR ERROR RETURN. JMP RETRN,I NORMAL RETURN. * ABERR DST D$ERR STORE CODE FOR FCHEK RETRIEVAL. CLA JMP RETRN,I + RETURN. SPC 3 * N2 DEC -2 BIT15 OCT 100000 FCN NOP * BSS 0 SIZE OF FOPEN * END rB <D 91750-18122 2013 S C0122 &GET              H0101 J]ASMB,R,L,C HED GET 91750-16122 * (C) HEWLETT-PACKARD CO 1980 NAM GET,7 91750-1X122 REV.2013 800805 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT GET,ACEPT,REJCT,FINIS EXT EXEC EXT .ENTR,PGMAD EXT #SLAV,#LDEF,#PLOG EXT .MVW EXT #LOGR,#GETR EXT #RPB RQB EQU #RPB SPC 5 * * NAME: GET * SOURCE:91750-18122 * RELOC: 91750-1X122 * PGMR: CHUCK WHELAN * DATE: DEC 22,1976 * * MODIFICATION FOR 91750: * MODIFIED 790206 BY GAB, JSB'S REPLACE EXTENDED INSTR'S. * MODIFIED 790220 BY JDH, DS REQUEST EQUATED OFFSETS. * MODIFIED 790531 BY DWT FOR PHASE FOUR (RELOCATION OF RQB). * MODIFIED 790609 BY DWT FOR PHASE FIVE (REMOVE O/S DEPENDENCE). * MODIFIED 800805 BY DMT TO INCREASE LENGTH OF FINIS WRITE TO PTOPM. * SPC 5 * PROGRAM-TO-PROGRAM SLAVE-SIDE SUBROUTINES * * THESE LIBRARY SUBROUTINES CONTAIN THE FOUR ENTRY POINTS (GET, * ACEPT, REJCT, AND FINIS) THAT MAY BE CALLED BY SLAVE PROGRAM * COMMUNICATING WITH A MASTER PROGRAM. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPP}ERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV(, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END HED "GET" PROCESSING * (C) HEWLETT-PACKARD CO ICLAS NOP IERR NOP IFUN NOP ITAG NOP IL NOP DBUFR DEF ZERO OPTIONAL DATA BUFFER DBUFL DEF ZERO OPTIONAL DATA LENGTH SPC 3 * ENTRY HERE SIGNIFIES THAT THE USER SUBROUTINE HAS COMPLETED THE * PROCESSING OF THE LAST CALL AND WISHES TO INTERROGATE HIS I/O * CLASS TO DETERMINE IF THERE ARE ANY MORE REQUESTS * TO BE PROCESSED. IF MORE REQUESTS HAVE BEEN QUEUED ON THE * CLASS THE ONE ON THE TOP OF THE STACK WILL BE PASSED TO THE * USER.IF THERE ARE NO OUTSTANDING REQUESTS THE USER * WILL BE I/O SUSPENDED UNTIL A REQUEST IS RECEIVED * BY THE MONITOR AND PLACED IN THE USER'S I/O CLASS. * GET NOP * SAVE INPUT PARAMETERS JSB .ENTR PICK UP THE PARAMETERS PASSED DEF ICLAS LDB GET RETURN ADDR STB EXIT LDB IERR SET UP ERROR PRAM ADDR STB ERRM1 CLA CLEAR "DATA TRANSFERRED" FLAG STA DTRFL * LDA IL WAS LAST REQUIRED SZA,RSS PARAMETER SUPPLIED? JMP ERPAR NO--ERROR CLA,INA LDB ERCOM CPB M47 COMM ERROR OCCURRED LAST XACTION? STA NEXT YES, RESET SEQ INDICATOR CPA NEXT CHECK FOR LEGAL SEQUENCE RSS JMP ERSEQ TAKE ERROR EXIT IF SEQUENCE ERR STA ERCOM * LDA ICLAS,I SET UP THIS USER'S I/O CLASS STA CLASX IOR B6000 SAVE BUFFER STA CLASS * JSB #GETR ISSUE GET ON I/O CLASS DEF *+6  DEF CLASS DEF RQB DEF C#PLW DEF DBUFR,I (OPTIONAL) DATA BUFFER ADDRESS DEF DBUFL,I (OPTIONAL) DATA BUFFER LENGTH JMP ERRAC ERROR RETURN * LDA RTAGA ADDR OF TAGS IN REQUEST LDB ITAG ADDR OF USER TAG AREA JSB .MVW MOVE TAG FIELD TO USER AREA DEF K20 NOP * * PASS FUNCTION CODE BACK TO "GET" CALLER LDA RQB+#FCD GET FUNCTION CODE AND =B377 STA IFUN,I RETURN RECEIVED FUNCTION CODE * LDB RQB+#PCB+2 DATA BUFFER LENGTH RAR,SLA,RAL SKIP UNLESS READ OR WRITE STB IL,I RETURN LENGTH TO CALLER * CPA K3 IS THIS A "PWRIT"? JSB GETW YES, CHECK IF USER WANTS DATA NOW. JSB CLSAM YES, CLEAR CLASS BUFFER * ISZ NEXT SET SEQ INDICATOR CLB RETURN "NO ERROR" FLAG STB IERR,I TO THE USER JMP DONE RETURN TO USER SPC 2 * THIS LITTLE SUBROUTINE IS CALLED BY THE "GET" ROUTINE * ONLY WHEN A "PWRIT" REQUEST HAS BEEN RECEIVED. IT * SETS A FLAG INDICATING THAT DATA HAS ALREADY BEEN * TRANSFERRED AT THE "GET" ROUTINE CALL, WHICH IS USED BY * THE "ACEPT" ROUTINE. IF NO DATA WAS TRANSFERRED, THE FLAG * WILL CONTAIN A ZERO, OTHERWISE THE LENGTH OF THE DATA * TRANSFERRED, AND THE CLASS BUFFER IS RELEASED. GETW NOP CHECK IF USER WANTS DATA TRANSFERRED NOW LDA DBUFL,I IF DATA TRANSFER LENGTH > 0, STA DTRFL SET "DATA TRANSFERRED AT GET" FLAG SZA,RSS WAS DATA TRANSFERRED? ISZ GETW NO, SO DON'T RELEASE THE SAM BUFFER JMP GETW,I RETURN HED "ACCEPT" PROCESSING * (C) HEWLETT-PACKARD CO AITAG NOP AIERR NOP AIBUF NOP * * ENTRY HERE SIGNIFIES THAT THE LAST REQUEST EXAMINED * WAS AN ACCEPTABLE ONE AND THE REQUEST WAS TO BE HONORED * * THE ACTION TO BE ACCOMPLISHED FOR AN ACCEPT REQUEST * VARIES AS TO THE TYPE OF REQUEST WHICH WAS LAST RECEIVED * ACCEPT REQUESTS ARE PERFORMED FOR ALL FOUR MASTER REQUESTS * EXIT EQU * ACEPT NOP JSB .ENTR PICK UP CALLING PARAMETERS FROM DEF AITAG THE USER * * * CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB * LDA AITAG LDB AIERR JSB PUTAG * LDA RQB+#FCD FUNCTION CODE FROM REQUEST RAR,SLA,RAL SKIP IF OPEN OR CONTROL(DO REQ ONLY) RSS JMP ACPFG * LDB DTRFL WAS DATA ALREADY TRANSMITTED SZB AT THE "GET" ? JMP ACPFG YES, JUST SEND HEADER IN REPLY LDB AIBUF SZB,RSS WAS DATA BUFFER SPECIFIED JMP ERPAR NO, INSUFFICIENT PARAMS STB SLADR SET DATA ADDRESS IN SV CALL STB GTADR ALSO IN GET CALL CPA K2 IS THIS A "PREAD" JMP AREAD YES, JUMP * * REQUEST IS A "PWRIT", DATA IS ALREADY IN SYSTEM AVAILABLE MEMORY, * SIMPLY MOVE DATA TO USERS BUFFER & CLEAR CLASS BUFFER * JSB #GETR JSB #GETR TO DO THE MOVE DEF *+6 DEF CLASS DEF RQB DEF K1 MIN HEADER LENGTH GTADR DEF DUMMY DATA AREA ADDRESS DEF RQB+#PCB+2 DATA LEN TO GET JMP ERRAC ERROR RETURN JMP ACPFG * AREAD LDA RQB+#PCB+2 DOING "PREAD", SEND STA DLEN DATA WITH THE REPLY. * ACPFG LDA BIT14 SET ACCEPT FLAG IN PARMB DVR IOR RQB+#FCD STA RQB+#FCD SAVE FUNC CODE WITH ACEPT OR REJCT SET * LDB DTRFL WAS DATA BUFFER SZB ALREADY TRANSFERRED? JMP ACPFF --YES: SAM BUFFER ALREADY RELEASED AND K7 ISOLATE FUNCTION CODE CPA K3 WAS IT A "PWRIT" JSB CLSAM YES, CLASS BUFFER STILL MUST BE CLEARED * ACPFF EQU * LDA RQB+#STR REQUEST STREAM WORD IOR BIT14 SET REPLY BIT STA RQB+#STR * CLA STA RQB+#EC2 STA RQB+#ENO * JSB #SLAV DO CALL TO DRIVER THRU #SLAV DEF *+4 DEF C#PLW SLADR DEF DUMMY \ DEF DLEN JMP ERRAC COMMUNICATION ERROR * LDA ERRM1,I RETRN STA ERCOM SAVE RETURN STATUS CLB,INB STB NEXT SET SEQUENCE IND. FOR "GET" NEXT * DONE EQU * LDB @ZERO STB DBUFR STB DBUFL CLB STB IL INITIALIZE FOR PARAM CK NEXT TIME STB AIERR STB JIERR JMP EXIT,I RETURN FROM ACEPT/REJCT TO CALLER * ERRAC LDA M47 ERROR STATUS= -47 STA ERRM1,I JMP RETRN HED "REJECT" PROCESSING * (C) HEWLETT-PACKARD CO JITAG NOP JIERR NOP * * ENTRY HERE IS SIMILAR TO THAT FOR THE ACCEPT OPTION * EXCEPT THE REQUEST HAS BEEN DETERMINED NOT TO BE VALID (FOR * SOME USER-DEFINED REASON) AND MUST BE REJECTED. AGAIN THE LOGIC * IS BROKEN UP INTO FOUR SUBCLASSES ACCORDING TO THE TYPE * OF REQUEST BEING REJECTED * REJCT NOP JSB .ENTR PICK UP USER PARAMETERS DEF JITAG LDB REJCT PICK UP RETURN ADDR STB EXIT * * CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB * LDA JITAG LDB JIERR JSB PUTAG * CLA SET #SLAV CALL FOR STA DLEN "NO DATA" LDA BIT15 GET "REJCT" BIT JMP DVR NOW SEND REPLY & EXIT HED "FINISH" PROCESSING * (C) HEWLETT-PACKARD CO FINIS NOP LDA ZERO STA NAME JSB PGMAD GET THIS PGMS ID SEGMENT ADDR DEF *+2 DEF NAME STA RQB+#PCB & STORE IN REQUEST * CLA,INA STA NEXT RESET SEQUENCE INDICATOR * * SET FUNCTION CODE REPLY FLAG & ACCEPT/REJECT FLAG LDA HCODE STA RQB+#FCD SET "FINIS" FUNCTION CODE * * SEND IT TO THE MONITOR * SO THIS PROGRAM CAN BE REMOVED FROM THE ACTIVE LIST * LDB #LDEF ADB K6 POINT TO P TO P HEADER ADDR LDB 1,I GET HEADER ADDR INB POINT TO CLASS WORD LDA 1,I GET "PTOPM" CLASS RAL,CLE,ERA CLEAR OFF SIGN BIT STA PTOP * JSB EXEC SEND THE REQUEST TO PTOPM DEF *+8 DEF K20 DEF CONWD Z BIT, LU=0 DEF DUMMY DEF ZERO NO DATA DEF RQB DEF L#PCB LENGTH OF "FINIS" REQUEST DEF PTOP * ISZ FINIS JMP FINIS,I RETURN HED UTILITY SUBROUTINES/DATA AREA * (C) HEWLETT-PACKARD CO * * THIS SUBROUTINE CHECKS FOR CALL ERRORS & RETURNS A MODIFIED * REQUEST TO THE MASTER PROGRAM * PUTAG NOP STB ERRM1 SAVE ERROR FLAG ADDR SZB,RSS SKIP IF ERROR DEF WAS PASSED JMP ERPAR OTHERWISE ERROR IN CALL LDB NEXT CHECK SEQUENCE CPB K2 CLB,RSS OK JMP ERSEQ ERROR, NOT TIME FOR ACEPT/REJCT STB ERRM1,I CLEAR ERROR FLAG LDB RTAGA ADDR OF TAG FIELD IN REQUEST JSB .MVW MOVE TAG FIELD INTO REQUEST DEF K20 NOP LDA ZERO STA NAME JSB PGMAD SET ID SEGMENT ADDR OF THIS SLAVE PGM DEF *+2 DEF NAME STA RQB+#PCB INTO 1ST WORD OF PCB LDA CLASX SET SLAVE PGMS CLASS # STA RQB+#PCB+1 INTO 2ND WORD OF PCB CLB SET #SLAV CALL FOR STB DLEN "NO DATA" JMP PUTAG,I RETURN SPC 3 * * SUBROUTINE TO DO A DUMMY GET TO CLEAR THE CLASS BUFFER CLSAM NOP LDA #PLOG SZA,RSS DOING REQUEST LOGGING? JMP CLAR NO LDB CLASS JSB #LOGR JMP CLAR ERROR RETURN JMP CLSAM,I * CLAR LDA CLASS GET SLAVE PGMS CLASS NO ALR,RAR CLEAR "SAVE BUFFER" FLAG STA CLASS * JSB EXEC DO DUMMY GET TO CLEAR THE BUFFER DEF *+5 DEF K21 DEF CLASS DEF DUMMY DEF ZERO JMP CLSAM,I RETURN * SPC 3 ERSEQ LDA M46 -46 = SEQUENCE ERROR RSS ERPAR LDA M40 -40 = INSUFFICIENT PARAMETERS STA ERRM1,I RETURN ERROR TO USER JMP DONE SPC 3 * * DATA AR0.*EA * DTRFL NOP "DATA TRANSFERRED AT 'GET'" FLAG CLASS NOP CLASX NOP DLEN NOP NEXT DEC 1 ERCOM NOP ERRM1 NOP CONWD OCT 10000 BIT14 OCT 40000 BIT15 OCT 100000 B6000 OCT 60000 @ZERO DEF ZERO ZERO OCT 0 K1 DEC 1 K2 DEC 2 K3 DEC 3 K6 DEC 6 K7 DEC 7 K20 DEC 20 K21 DEC 21 HCODE OCT 205 "FINIS" GENERATES A "PCLOS" PTOP OCT 100004 M46 DEC -46 M47 DEC -47 M40 DEC -40 RTAGA DEF RQB+#TAG * DUMMY NOP NAME ASC 3, * * DEFINE REQUEST BUFFER C#PLW ABS #PLW L#PCB ABS #TAG END 0 = J 91750-18123 2013 S C0122 &GNODE              H0101 x}ASMB,R,L,C NAM GNODE,7 91750-1X123 REV 2013 800110 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: GNODE * SOURCE: 91750-18123 * RELOC: 91750-16123 * PGMR: CHUCK WHELAN * APRIL 25,1977 * * RETURN LOCAL NODAL ADDRESS TO CALLER * ENT GNODE * EXT #NODE * GNODE NOP LDB GNODE INB LDB 1,I GET PARAMETER ADDRESS LDA #NODE STA 1,I RETURN NODE # TO CALLER LDB GNODE,I JMP 1,I * END & >D 91750-18124 2013 S C0122 &GRPM              H0101 YASMB,R,Q,C HED GRPM 91750-16214 REV 2013 * (C) HEWLETT-PACKARD CO. 1979 NAM GRPM,17,4 91750-16124 REV 2013 800616 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 EXT EXEC,#RSAX,#RQUE,#RTRY EXT #NODE,#GRPM,$TIME,#PLOG EXT #NULL,#LDEF,#QCLM,#BREJ EXT #TBRN,#QRN,#LEVL,#RSM,#MHCT EXT PGMAD,RNRQ,DTACH EXT #INCV,#OTCV,#NRVS,#GETR,#PUTR,#PUTD EXT #MAPP,#UP,#UPDA,#DOWN ENT #GBUF * SUP * * NAME: GRPM * SOURCE: 91750-18124 * RELOC: 91750-16124 * PGMR: CHUCK WHELAN * DATE: 17 DEC 76 * MODIFICICATION FOR 91750: * MODIFIED BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S * MODIFIED BY JDH [790216] FOR DS REQUEST EQUATED OFFSETS. * MODIFIED BY CCH [790328] TO ELIMINATE REFERENCE TO . * MODIFIED BY DWT [790416] FOR PHASE ONE (#INCV). * MODIFIED BY DWT [790424] FOR PHASE TWO (#NRVS). * MODIFIED BY DWT [790430] FOR PHASE THREE (DRIVER STATUS CHANGE & * DEBUG LOGGING) * MODIFIED BY DWT [790606] FOR PHASE FIVE (REMOVE O/S DEPENDENCE). * MODIFIED BY LAW [790614] TO FIX 'QCLM' CLASS-WRITE CODE. * MODIFIED BY DWT [790727] TO SUPPORT REMOTE SESSION MONITOR. * MODIFIED BY DWT [790803] TO SUPPORT MESSAGE ACCOUNTING. * MODIFIED BY DWT [790803] TO SUPPORT REROUTING. * * * * GRPM IS THE GENERAL REQUEST PRE-PROCESS MODULE FOR DS/1000. * IT PROCESSES INCOMING REQUESTS AND OUTGOING COMPLETIONS. * * I INCOMING REQUESTS * * 1. HANGS ON A GET ON ITS CLASS NUMBER, AND WHEN * SATISFIED, MOVES THE REQUEST INTO ITS LOCAL BUFFER. * 2. IF THE RqfEQUEST IS NOT DESTINED FOR THE LOCAL NODE, * THE REQ/DATA IS RETHREADED FOR OUTPUT TO THE * APPROPRIATE LU ON "GRPM"S CLASS NUMBER. * 3. IF LOCAL AND A NEW REQUEST, DOES THE FOLLOWING: * A) IF NO TCBS ARE AVAILABLE, SETS THE REPLY FLAG * AND REMOTE BUSY FLAG AND RETURNS THE REQUEST TO * THE ORIGINATOR BY RETHREADING THE REPLY FOR OUTPUT ON * "GRPM"S CLASS. * B) IF SYSTEM IS GOING QUIESCENT, OR THE MONITOR IS * IN AVAILABLE MEMORY SUSPEND (STATE 4), THE "BUSY" * FLAG IS SET IN THE REQUEST AND THE ENTIRE TRANSACTION * IS RETURNED TO THE ORIGINATOR. * C) OTHERWISE, CALLS "#RSAX" TO CREATE THE SLAVE TCB. * D) DETERMINES THE MONITORS CLASS NUMBER FROM "RES" * TABLE AND RETHREADS THE REQ/DATA TO THAT CLASS. * IF THE MAXIMUM QUEUE DEPTH LIMIT FOR THAT MONITOR IS * EXCEEDED BY THIS RE-THREAD, THE ENTIRE REQUEST IS RETURNED * TO THE ORIGINATOR (AS DESCRIBED ABOVE), WITH A "DS08" * ERROR. * 4. IF LOCAL AND A REPLY, DOES THE FOLLOWING: * A) IF "BUSY" FLAG IS SET, CLEARS IT AND RETHREADS * THE REQUEST TO RTRY SO AFTER A DELAY IT CAN * BE REATTEMPTED. HOWEVER, IF IT IS A LOCAL * REQUEST, DS08 IS RETURNED IMMEDIATELY. * B) CALLS #RSAX TO SEARCH FOR THE MASTER TCB. * C) IF FOUND, RETHREADS THE REQ/DATA ON THE MASTER'S * CLASS #. * 5. IF #PLOG IS NON-ZERO, COMPLETED WRITE CLASS BUFFERS * ARE RETHREADED TO PLOG, OTHERWISE THEY ARE DEALLOCATED. * 6. WHEN DONE, "GRPM" RETURNS TO ITS GET. * * II OUTGOING LINE COMPLETIONS * * GRPM PROCESSES COMPLETION STATUS OF ALL COMMUNICATION REQUEST/DATA * WRITE OPERATIONS (EXCEPT PROGL). IF AN OPERATION IS SUCCESSFUL * AND PLOG IS ENABLED, THE REQUEST IS RETHREADED TO PLOG'S CLASS, * IF NOT, THE CLASS BUFFER IS DEALLOCATED.  * ON REMOTE OR LOCAL BUSY ERRORS, GRPM CHECKS THE RETRY COUNT IN * THE STREAM WORD OF THE REQUEST. IF ALL RETRIES HAVE BEEN * EXHAUSTED, IT IS TREATED AS A LINE ERROR AND A DS08 IS RETURNED. * IF ANOTHER RETRY IS POSSIBLE, THE ABSOLUTE SYSTEM TIME AT WHICH * THE RETRY SHOULD BE ATTEMPTED IS COMPUTED AND STORED IN THE * EQT5 STATUS SAVE AREA IN THE CLASS HEADER. THE CLASS BUFFER IS * THEN RETHREADED ON "RTRY"S CLASS. * PARITY OR LINE TIMEOUT ERRORS ARE RETRIED 3 TIMES BY RETHREADING * TO "RTRY". IF ALL 4 TRIES FAIL, A DS02 ERROR IS RETURNED. IF * A "STOP RECEIVED" CONDITION IS DETECTED, A DS01 ERROR IS RETURNED. * ALL LINE ERRORS HAVE THE ERROR CODE AND THE LOCAL NODE NUMBER * STORED IN THE ERROR FIELD IN THE REQUEST. * IF THE REQUEST WAS A REPLY, THE CLASS BUFFER IS SIMPLY * CLEARED OR THE REQUEST IS RETHREADED TO PLOG (IF ENABLED). * IF A NON-REPLY, AND THE ORIGINATOR IS NOT THE LOCAL NODE, THE * REPLY FLAG IS SET, AND THE REQUEST IS SENT BACK TO THE ORIGINATOR. * IF THE ORIGINATOR IS LOCAL, THE REPLY IS RETHREADED ON THE * MASTER REQUESTORS CLASS. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP GRPM EQU * JSB DTACH DETACH FROM DINIT'S SESSION DEF *+1 IF NECESSARY * * WAIT ON #GRPM * GRGET JSB #GETR DEF *+8 DEF #GRPM @RQBF DEF RQBUF DEF MINHE MIN HEADER LEN NEEDED BY GRPM DEF K0 DEF K0 DEF STATS DEF LLU JSB ERR1 STA RQLEN STORE ACTUAL HEADER LEN STB DALEN STORE DATA LENGTH ISZ MSGCT UP MESSAGE COUNT NOP (AFTER 65K MSGS, THIS INSTR SKIPPED) * * CHECK DEBUG LOGGING OPTION * LDA #PLOG SZA,RSS LOGGING ENABLED? JMP PRGET NO, GO PROCESS GET LDA #PLOG+2 YES, LOAD TYPE OF LOGGING AND DEBUG DEBUG LOGGING? SZA,RSS JMP PRGET NO, GO PROCESS GET JSB #GETR YES, GET THE WHOLE HEADER DEF *+4 DEF #GRPM DEF RQBUF DEF MAXHE MAX HEADER LENGTH JSB ERR1 ERROR RETURN ADA C#LSZ ADD APPANDAGE LENGTH STA TEMP SO PLOG WILL GET IT xADA @RQBF OFFSET TO BUF AREA LDB STATS GET I/O STATS STB 0,I SAVE IT INA UP OFFSET LDB MSGCT GET MESSAGE COUNT STB 0,I SAVE IT INA UP OFFSET LDB =A<< GET DEBUG SYMBOL STB 0,I SAVE IT AT END OF BUF LDA TEMP ADD DEBUG LEN ADA K3 (STATUS, MSGCT, & SPECIAL SYMBOL) STA TEMP JSB EXEC MAILBOX WRITE/READ TO PLOG DEF *+8 DEF K20N DEF B10K SET Z BIT DEF K0 DEF K0 DEF RQBUF DEF TEMP DEF #PLOG NOP IGNORE ERROR RETURN * PRGET EQU * LDA LLU GET LAST LU WORD AND B400 CHECK NOT FROM DRIVER BIT SZA IS IT SET? JMP READC YES, MUST NOT BE FROM THE COMM. DRIVER LDA STATS GET I/O COMPLETION STATUS RAR,SLA ANY DRIVER ERRORS JMP ERCHK YES RAR SLA,RSS WAS THIS A WRITE COMPLETION? JMP READC .NO, GO TO READ COMPLETION * * SUCCESSFUL WRITE COMPLETION * CLA,INA SET WRITE COMPL FLAG FOR MA LDB LLU PASS LLU WORD TO MA JSB #MAPP CALL MESSAGE ACCOUNTING JMP GRGET MA RETURN * * RELEASE THE MESSAGE * RELSE LDA #PLOG PLOG CLASS NUMBER SZA LOGGING? JMP THRED YES, RETHREAD TO PLOG * JUST DEALLOCATE THIS CLASS BUFFER CLSAM LDA #GRPM ALR,RAR CLEAR "SAVE BUFFER" FLAG STA CLASS * JSB EXEC DO DUMMY GET TO CLEAR CLASS BUFFER DEF *+5 DEF K21 DEF CLASS DEF RQBUF DEF K0 * JMP GRGET BACK TO GET SKP * * SUCCESSFUL READ COMPLETION LOGIC FOLLOWS * READC EQU * LDA RQLEN SZA RQUEST LEN = 0? JMP CKST0 .NO, CHECK IF STREAM 0 LDA LLU .YES, UP INDICATION AND B377 PASS LU CLB JSB #UP CALL REROUTING% JMP RELSE NORMAL RETURN LDA #GRPM NO SAM RETURN JMP THRED SEND IT BACK FOR RETRY * * CHECK FOR STREAM ZERO MESSAGE * CKST0 EQU * LDA STREM GET STREAM WORD AND STRM0 MASK ALL EXCEPT STREAM # & LEVEL BIT CPA B10K STREAM ZERO? RSS JMP CKNOD .NO, CHECK NODE LDA RQBUF+#REQ .YES, CHECK MSG TYPE SZA,RSS RR MSG? JMP RRMSG .YES CPA K1 DSCHK MSG? RSS JMP CKNOD .NO LDA DALEN .YES, GET DATA LEN SZA ZERO? CPA RQBUF+#REQ+1 NO MORE ROOM? JMP NRETN .YES, SEND IT BACK LDA #NODE LDB #LEVL DST BSS2 JSB #PUTD SAVE NODE # AND LEVEL IN DATA AREA DEF *+4 DEF RQBUF+#REQ+1 OFFSET INTO DATA AREA DEF BSS2 NODE # AND LEVEL DEF K2 2 WORD SAVE JSB ERR1 ERROR RETURN ISZ RQBUF+#REQ+1 UP OFFSET ISZ RQBUF+#REQ+1 LDA STREM AND RPBIT SZA REPLY? JMP CKNOD .YES, GO TO CHECK NODE LDA DESTN .NO SSA,RSS ALWAYS LOCAL? CPA #NODE LOCAL? RSS .YES JMP CKNOD .NO NRETN LDA STREM TIME TO SEND IT BACK AND RTYCT CLEAR BUSY RETRY COUNT IOR RPBIT SET REPLY BIT IOR #BREJ INIT BUSY RETRY STA STREM LDA =B10100 STA CONWD+1 JMP RPLYR RRMSG EQU * LDA LLU AND B377 JSB #UPDA JMP RELSE NORMAL RETURN JMP GRGET MESSAGE HAS BEEN REQUEUED * * CHECK IF REQ/REP IS DESTINATED FOR THIS NODE * CKNOD EQU * LDA STREM AND LEMSK CLEAR COMM. LINE RETRY COUNT STA STREM LDA STREM LOAD STREAM WORD LDB SRC# LOAD SOURCE NODE # AND RPBIT CHECK STREAM WORD SZA,RSS REPLY? LDB DESTN NO, LOAD DESTN NODE # INSTEAD STB TEMP2 SAVE NODAL ADDRESS ݢ SSB,RSS SKIP IF ALWAYS LOCAL CPB #NODE IS IT US? JMP LOCAL YES SKP * * STORE & FORWARD TO ANOTHER NODE * LDA STREM GET STREAM WORD AND B10K SZA,RSS LEVEL ZERO? JMP NRVS .YES, LOOK UP LU ISZ RQBUF+#HCT .NO, UPDATE HOP COUNT RSS HOP COUNT O.K. JMP HOPER SEND HOP COUNT EXCEEDED MSG * * CONVERT NODE # TO LU * NRVS EQU * JSB #NRVS SEARCH NRV DEF *+2 DEF TEMP2 CPU NUMBER JMP ERETN ERR RETURN--CANNOT FIND NODE RETRY EQU * SZA,RSS LU = 0? JMP NPATH IF ZERO, NO PATH ERROR IOR =B100000 SET 2 WORD CONWD BIT STA CONWD LDA =B10100 SET Z & WRITE BIT STA CONWD+1 SAVE IT FOR REQU CALL * * RETHREAD MESSAGE FOR OUTPUT * SNDRP EQU * LDA MINHE GET MIN HEADER LEN LDB MINHE CMB,INB ADB RQLEN SSB RQLEN > MINHE? LDA RQLEN .NO, USE RQLEN STA OVLHE STORE IT AS OVERLAY LEN JSB #RQUE RETHREAD BUF FOR OUTPUT DEF *+9 DEF K20N DEF CONWD DEF K0 DEF K0 DEF RQBUF OVERLAY PORTION OF HEADER DEF OVLHE LEN OF OVERLAY DEF #GRPM DEF #GRPM JSB ERR1 ERROR RETURN JMP GRGET BACK TO GET SKP * * THIS REQ/REPLY IS DESTINED LOCALLY LOCAL EQU * LDA STREM GET STREAM WORD AND B10K LEVEL FIELD PRESENT? SZA LDA RQBUF+#LVL .YES, LOAD LEVEL FIELD AND B17 MASK OFF ALL BUT LEVEL # CPA #LEVL SAME LEVEL AS THIS NODE? JMP NOCON .YES, NO CONVERSION NECESSARY LDA #INCV .NO, RETHREAD TO #INCV SZA IS IT SCHEDULED? JMP THRED .YES JMP CONER .NO, ERROR * NOCON EQU * LDA STREM AND STRM0 CPA B10K STREAM ZERO? RSS .YES, MUST BE MA MESSAGE JMP NOTMA .NO CLA LDB LLU JSB #MAPP JMP GRGET NOTMA EQU * LDA RQBUF GET STREAM WORD AND RPBIT TEST REPLY FLAG SZA JMP REPLY IT'S A REPLY * * HERE WHEN LOCAL REQUEST IS RECEIVED * LDB #NULL SZB,RSS ANY TCBS AVAILABLE? JMP QRJCT NO, SEND IT BACK FOR AWHILE * LDA RQBUF AND B77 ISOLATE STREAM ADA #LDEF ADA K2 POINT TO LIST HEADER PNTR LDB 0,I POINT TO LIST HEADER INB STB TEMP SAVE ADDRESS OF CLASS # INB LDA 1,I GET 1ST WORD OF MONITOR NAME RAL,CLE,ERA CLEAR "NO ABORT" FLAG SZA,RSS IS THIS MONITOR ENABLED? JMP ILLRQ NO, RETURN A "DS06" STA NAME SAVE THE FIRST WORD INB DLD 1,I LOAD THE NEXT TWO WORD DST NAME+1 SAVE IT AS NAME JSB PGMAD DEF *+2 DEF NAME SZA,RSS WAS ID SEGMENT ADDR FOUND? JMP ILLRQ .NO, RETURN DS ERROR CPB K4 AVAILABLE MEMORY SUSPEND? JMP QRJCT YES, REJECT REQUEST * JSB RNRQ "LOOK" AT QUIESCENT LOCK DEF *+4 DEF LCNW LOCK,CLEAR,NO WAIT,NO ABORT DEF #QRN DEF TEMP2 NOP LDA TEMP2 GET LOCK STATUS CPA K1 QUIESCING? RSS NO JMP QRJCT YES, SEND IT BACK * * THIS REQUEST CAN NOW BE PASSED TO THE REQUIRED MONITOR * JSB #RSAX BUILD TCB FOR THIS STREAM DEF *+5 DEF K3 DEF RQBUF+1 PASS ORIGINATORS SEQ # DEF RQBUF & STREAM DEF RQBUF+2 & ORIGIN NODE NO. * SSB OK? JMP ILLRQ NO, GIVE DS06 ERROR * STA SEQ# STORE LOCAL SEQ # LDB #NULL NUMBER OF TCB'S LEFT SZB DID WE USE THE LAST ONE? JMP MONIT NO * JSB RNRQ YES! LOCK THE TABLE ACCESS RN DEF *+4 DEF LGNW U4GLOBAL LOCK, NO WAIT, NO ABORT DEF #TBRN DEF TEMP2 NOP MONIT EQU * CLA LDB LLU JSB #MAPP JMP GRGET LDA RQBUF+#SID LOAD SESSION WORD AND B377 GET DESTINAION SESSION ID SZA = ZERO? JMP *+3 .YES, JUST THREAD TO MONITOR LDA #RSM IF SESSION MONITOR NODE, SZA,RSS THREAD TO RSM * LDA TEMP,I GET MONITOR'S CLASS SPC 2 * * ENTER HERE TO RETHREAD THE CLASS BUFFER FROM #GRPM TO THE CLASS * NUMBER PASSED IN THE A REGISTER. * THRED EQU * STA CLASS * LDA MINHE GET MIN HEADER LEN LDB MINHE CMB,INB ADB RQLEN SSB RQLEN > MINHE? LDA RQLEN .NO, USE RQLEN STA OVLHE STORE IT AS OVERLAY LEN JSB #RQUE DEF *+9 DEF K20N DEF B10K REQUE WITH Z BIT SET DEF K0 DEF K0 DEF RQBUF OVERLAY PORTION OF HEADER DEF OVLHE LEN OF OVERLAY DEF CLASS DEF #GRPM RSS ERROR RETURN JMP GRGET BACK TO GET * CPA ASCDS LOOK FOR DS08 ERROR RSS JSB ERR1 CPB ASC08 JMP RQERR IF DS08, REQUEUE ERROR JSB ERR1 SKP * * HERE WHEN LOCAL REPLY RECEIVED * REPLY LDA RQBUF AND BZBIT IS THIS A QUIESCENT/BUSY REJECT? SZA,RSS JMP REPOK NO LDA RQBUF YES AND CLMSK CLEAR REPLY & BUSY FLAGS & LINE ERR CNTR STA RQBUF WORD GETS STORED IN SAM LATER LDB RQBUF+3 GET DESTINATION NODE CPB #NODE WAS THIS A LOCAL REQUEST? JMP BZYER YES! GIVE A DS08 NOW JMP RMBZY RETHREAD TO RTRY * REPOK EQU * CLA LDB LLU JSB #MAPP JMP GRGET JSB #RSAX SEARCH FOR MASTER TCB DEF *+3 DEF K4 DEF RQBUF+1 SSB,RSS FOUND? JMP THRED .YES, RETHREAD IT (A REG = MASTER CLASS #) C LDA K2 .NO, SEND ERROR STA ETYPE MESSAGE TO QCLM JMP ERR2 * QRJCT LDA RQBUF AND LEMSK CLEAR LINE ERROR COUNT IOR RPBZY SET "BUSY" & "REPLY" FLAGS STA STREM LDA =B10100 STA CONWD+1 JMP RPLYR SEND REPLY SKP * * ERROR OCCURRED * ERCHK LDA STATS GET DRIVER RETURNED STATUS RAR,RAR ROTATE TO GET READ/WRITE BIT (BIT 2) SLA,RSS IS THIS A WRITE ERROR? JMP EREAD NO, JUMP TO READ ERROR LDA STATS AND DVRXX CPA DVA66 NEW DVA66 DRIVER? JMP RR .YES, NO RETRY ABOVE DRIVER NECESSARY * * OLD DVA65 DRIVER, DO RETRY IF NECESSARY * LDA STATS AND B360 CPA B20 LINE ERROR? JMP LNERR CPA B40 LINE TIMEOUT? JMP LNERR CPA B60 LOCAL BUSY? JMP LCBZY CPA B120 REMOTE BUSY? JMP RMBZY JMP RR ALL OTHER ERRORS WILL TRY REROUTE * * LINE ERROR OR LINE TIMEOUT, CHECK RETRY COUNT * LNERR LDA STREM STREAM WORD AND B300 ISOLATE RETRY COUNT CPA B300 ALL RETRIES EXHAUSTED? JMP RR YES, TRY REROUTE * LDB LERR# LINE ERROR DELAY FACTOR STB TEMP2 SAVE IT FOR DELAY LDA B100 BUMP BITS 7-6 JMP RBUMP * * REMOTE BUSY REJECT * RMBZY LDA STREM STREAM WORD AND B7400 BITS 11-8 HAVE RETRY COUNT CPA B7400 ALL RETRIES EXHAUSTED? JMP BZYER YES, GIVE ERROR LDA B400 BUMP BITS 11-8 LDB RBZY# DELAY FOR REMOTE BUSY (1 SEC) STB TEMP2 SAVE OFFSET (10'S OF MSECS) * RBUMP ADA STREM BUMP RETRY COUNT STA STREM STORE NEW VALUE BACK JMP DELAY * * LOCAL BUSY REJECT * LCBZY LDB LBZY# STB TEMP2 * DELAY CLE DLD $TIME CURRENT SYSTEM TIME ADA TEMP2 ADD DELAY TIME SEZ,RSS CARRY? JMP *+3 NO INB,SZB,RSS WILL DAY ROLL OVER? ADA B25K YES, COMPENSATE FOR IT STA TEMP2 SAVE DELAY VALUE JSB #PUTR JUMP TO "STUFF" DELAY VALUE DEF *+3 IN MESSAGE DEF RQLEN OFFSET IN MESSAGE TO STORE DELAY VALUE DEF TEMP2 DELAY VALUE JSB ERR1 ERROR RETURN LDA #RTRY GET RETRY'S CLASS # SZA RTRY SCHEDULED? JMP THRED .YES, RETHRED TO IT LDA STREM .NO, RETRY IT IN GRPM INSTEAD LDB SRC# LOAD SOURCE NODE # AND RPBIT REPLY? LDB DESTN .NO, LOAD DESTN NODE # STB TEMP2 SAVE NODE ADDR SSB,RSS NEGATIVE LU? JMP NRVS .NO, SEARCH FOR LU CMB,INB .YES, MAKE IT POSITIVE LDA BREG PUT IT IN A REG. JMP RETRY SKP * * CHECK IF REROUTING IS NECESSARY * RR EQU * LDB RQBUF+#REQ LDA STREM AND STRM0 MASK ALL EXCEPT STREAM # & LEVEL BIT CPA B10K STREAM ZERO? SZB RR MSG? RSS JMP RELSE .YES, JUST RELEASE LDB SRC# PASS SOURCE NODE # LDA STREM AND RPBIT REPLY? SZA,RSS LDB DESTN .YES, PASS DEST. NODE # LDA LLU AND B377 PASS LU JSB #DOWN CALL REROUTING RSS NON RR LINK RETURN JMP CKNOD RR LINK RETURN * LDA STATS NO RR, RETURN ERROR TO USER AND B360 ISOLATE ERROR TYPE CPA B40 WAS IT DRIVER TIMEOUT? JMP TOERR .YES CPA B120 WAS IT REMOTE BUSY? JMP BZYER .YES * * LINE FAILURE ERROR--DS01 * LDB ASC01 O/W, RETURN LINE ERROR JMP ERETN * * DRIVER TIMEOUT ERROR--DS02 * TOERR EQU * LDB ASC02 JMP ERETN * * ALL ROUTES TO DESTINATION ARE DOWNED--DS04/1 * NPATH EQU * LDB ASC04 LDA STREM GET STREAM WORD AND B10K LEVEL ZERO? SZA,RSS JMP ERETN .YES, NO ERRORY QUALIFIER LDA ECQ1 .NO, GET ERROR QUALIFIER 1 IOR RQBUF+#ECQ STA RQBUF+#ECQ STORE IT JMP ERETN * * HOP COUNT EXCEEDED--DS04/2 * HOPER EQU * LDB ASC04 LDA ECQ2 IOR RQBUF+#ECQ STA RQBUF+#ECQ JMP ERETN * * NO MONITOR FOR REQUESTED STREAM IS PRESENT--DS06 * ILLRQ LDB ASC06 JMP ERETN * * NO MESSAGE CONVERTER--DS07/1 * CONER EQU * LDB ASC07 JMP NPATH+1 * * BUSY RETRY COUNT EXHAUSTED--DS08 * BZYER EQU * LDB RQBUF+#REQ LDA STREM AND STRM0 CPA B10K STREAM ZERO? SZB RR MSG? RSS JMP RELSE .YES, JUST RELEASE LDB ASC08 JMP ERETN * * REQUEUE ERROR--DS08/4 * RQERR EQU * LDA STREM AND B10K LEVEL ZERO? SZA,RSS JMP ERETN .YES, NO ERROR QUALIFIER LDA ECQ4 .NO, GET QUALIFIER 4 IOR RQBUF+#ECQ STA RQBUF+#ECQ * ERETN EQU * STB TEMP LDB RQBUF+#REQ LDA STREM AND STRM0 MASK ALL BUT STREAM # & LEVEL BIT CPA B10K STREAM ZERO? SZB RR MSG? RSS JMP RELSE .YES, RELEASE ERROR RR MSG LDA STREM AND B10K SZA,RSS LEVEL ONE OR ABOVE MSG? JMP CKRPE .NO, GO CHECK REPLY ERROR LDA RQBUF+#ECQ CHECK NO REPLY FLAG SSA IS IT SET? JMP CLSAM .YES, GO CLEAN SAM CCB ELSE SET ERROR FLAG FOR MA STB RQBUF+#MAR CKRPE EQU * LDA RQBUF GET STREAM WORD RAL CCE,SSA REPLY? JMP ERRFL YES, NO RECOVERY POSSIBLE * LDB TEMP STB EC2 STORE THE PASSED VALUE LDA #NODE GET LOCAL NODAL ADDRESS RAL,ERA INDICATE THERE'S AN ASCII ERROR STA ENO STORE IT IN ERROR LOCATION WORD LDA ASCDS GET "DS" STA EC1 STORE IT LDA STREM AND LEMSK CLEAR COMM. LINE RETRY COUNT AND RTYCT IOR RPBIT SET REPLY FLAG IOR #BREJ INITIALIZE BUSY RETRY COUNTERS STA STREM LDA =B12100 SET Z, NO DATA, & WRITE BIT STA CONWD+1 * RPLYR EQU * LDA SRC# LOAD ORIGINIAL NODE NO. SSA,RSS SKIP IF ALWAYS LOCAL CPA #NODE IS IT LOCAL? JMP LOCAL .YES, PASS ERROR TO UPPER S/W JSB #NRVS SEARCH FOR THE REPLY NODE DEF *+4 DEF SRC# USE ORIGINIAL NODE NUMBER DEF TEMP RETURN T/O VALUE DEF TEMP2 RETURN UPGRADE VALUE JMP ERETN ERROR RETURN SZA,RSS LU ZERO? JMP NPATH .YES, NO PATH ERROR IOR =B100000 STA CONWD * LDB #MHCT GET MAX HOP COUNT LDA STREM GET STREAM WORD AND B10K LEVEL FIELD PRESENT? SZA LDA RQBUF+#LVL .YES, LOAD LEVEL FIELD AND B17 MASK OFF ALL BUT LEVEL # SZA LEVEL ZERO? STB RQBUF+#HCT .NO, RESET HOP COUNT CPA TEMP2 SAME AS THE DESTINATION'S LEVEL? JMP SNDRP .YES, JUST SEND THE REPLY LDA #OTCV .NO, RETHREAD TO #OTCV SZA JMP THRED JMP CONER SKP * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON SOME MESSAGES, * *--------------------------------------* WORD 1 AND WORD 2 MAY * 2 * SEQUENCE NUMBER * HAVE DIFFERENT MEANINGS. * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* * 6 * A-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* * 7 * B-REGISTER WHE=N ERROR DETECTED * * *--------------------------------------* * 8 * TIME OF DAY WHEN ERROR DETECTED * * 9 * (2 WORDS) * * *--------------------------------------* * 10 * PROGRAM NAME WHERE * * 11 * ERROR IS DETECTED * * 12 * (3 WORDS) * * **************************************** * ERRFL EQU * CLA FIRST GIVE IT TO LDB LLU JSB #MAPP MA TO SEE IF IT WANTS JMP GRGET TO HOLD ON FOR RETRY LDA ASCDS LDB TEMP GET PASSED ERROR CODE DST AREG LDA K1 ERROR SENDING REPLY, ENCODE STA ETYPE SO QCLM PRINTS "REPLY FLUSHED..." JMP ERR2 * EREAD EQU * LDA STATS GET I/O COMPLETION STATUS AND B360 ISOLATE ERROR TYPE (BITS 4-7) CPA B120 REMOTE BUSY? JMP BZYER YES LDA STATS NO, MOVE I/O STATUS TO STA RQBUF+1 REQUEST BUFFER LDA LLU GET THE LAST LU WORD AND B377 MASK OFF ALL BITS EXCEPT LU STA RQBUF STORE IT IN THE FIRST WORD LDA K3 ENCODE SO 'QCLM' PRINTS STA ETYPE "COMMUNICATIONS READ ERROR" JMP ERR2 * * THIS REQUEST IS NON-RECOVERABLE, CLEAR, LOG, THEN IGNORE IT ERR1 NOP HERE TO REPORT IRRECOVERABLE ERROR DST AREG SAVE REGS FOR QCLM CLA STA ETYPE LDA @GRPM GET BASE ADDRESS CMA,INA MAKE IT NEGATIVE ADA ERR1 ADD POINT OF ERR TO GET RELATIVE ADDR ADA M1 STA PREG PASS ERROR ADDR TO QCLM LDA PNAME PASS PROGRAM NAME STA PGM DLD PNAME+1 DST PGM+1 * ERR2 EQU * DLD $TIME RECORD TIME OF ERROR DST TOD LDA #QCLM SZA,RSS QCLM AVAILABLE? JMP CLSAM .NO, FORGET MESSAGE JSB EXEC MAILBOX WRITE/READ TO QCLM DEF *+8 DEF K20N DEF K0 {9DEF RQBUF DEF K12 DEF ETYPE DEF K0 DEF #QCLM NOP * JMP CLSAM GO DEALLOCATE CLASS BUFFER SKP * * CONSTANTS AND STORAGE * RPBIT OCT 40000 BZBIT OCT 20000 RPBZY OCT 60000 TEMP NOP TEMP2 NOP BSS2 BSS 2 CONWD BSS 2 CLASS NOP ETYPE NOP LLU NOP LAST LU WORD STATS NOP I/O COMPLETATION STATUS DEBUG OCT 1000 DEBUG LOGGING MASK MSGCT NOP MESSAGE ENCOUNTED BY GRPM RQLEN NOP ACTUAL LENGTH OF HEADER DALEN NOP DATA LENGTH OVLHE NOP OVERLAY LEN NEEDED BY GRPM MINHE ABS #MHD+3 MIN HEADER LEN (+3 FOR STREAM 0 MSG) MAXHE ABS #MXR+#LSZ MAX HEADER LEN NEEDED BY GRPM RTYCT OCT 170077 STREAM WORD RETRY COUNT MASK LEMSK OCT 177477 MASK TO CLEAR LINE ERROR COUNT LGNW OCT 140002 LCNW OCT 140005 CLMSK OCT 117477 STRM0 OCT 010077 MASK FOR STREM & LEVEL BIT ECQ1 OCT 20 DS ERROR QUALIFIER ONE ECQ2 OCT 40 DS ERROR QUALIFIER TWO ECQ4 OCT 100 DS ERROR QUALIFIER FOUR DVRXX OCT 37400 MASK FOR DRIVER TYPE DVA66 OCT 33000 DRIVER 66 PNAME ASC 3,GRPM NAME ASC 3 @GRPM DEF GRPM * M1 DEC -1 K0 DEC 0 K1 DEC 1 K2 DEC 2 K3 DEC 3 K4 DEC 4 K12 DEC 12 K21 DEC 21 K20N OCT 100024 B17 OCT 17 B20 OCT 20 B40 OCT 40 B60 OCT 60 B77 OCT 77 B100 OCT 100 B120 OCT 120 B300 OCT 300 B360 OCT 360 B377 OCT 377 B400 OCT 400 B7400 OCT 007400 B10K OCT 010000 B25K OCT 025000 * * TIME DELAY CONSTANTS LBZY# DEC 50 LOCAL BUSY DELAY = .5 SECOND RBZY# DEC 100 REMOTE BUSY DELAY = 1 SECOND LERR# DEC 80 LINE ERROR RETRY DELAY = .8 SECOND * ASC01 ASC 1,01 ASC02 ASC 2,02 ASC04 ASC 1,04 ASC06 ASC 1,06 ASC07 ASC 1,07 ASC08 ASC 1,08 ASCDS ASC 1,DS * C#LSZ ABS #LSZ * RQBUF BSS #MXR+#LSZ+3 +3 FOR DEBUG LOGGING #GBUF EQU RQBUF * STREM EQU RQBUF SEQ# EQU RQBUF+1 SRC# EQU RQBUF+2 DESTN EQU RQBUF+3 PREG EQU RQBUF+4 AREG?H`^Z EQU RQBUF+5 BREG EQU RQBUF+6 TOD EQU RQBUF+7 PGM EQU RQBUF+9 * EC1 EQU RQBUF+4 EC2 EQU RQBUF+5 ENO EQU RQBUF+6 * SIZE BSS 0 * END GRPM ` ?T 91750-18125 2013 S C0122 &HELLO              H0101 yASMB,Q,C HED HELLO: LOGON/LOGOFF TO HP3000 * (C) HEWLETT-PACKARD CO. NAM HELLO,7 91750-1X125 REV.2013 800312 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT HELLO,BYE EXT D$RQB,#LU3K,.ENTR,#RSAX,#TBRN,#QXCL EXT D$INI,D$STW,D3KMS,D$3BF EXT D$SMP,D$LOG,D$INP,D$ECH,D$BRK,D$CTY EXT LUTRU,IFTTY,LOGLU,.MVW,EXEC,RNRQ SPC 3 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: HELLO *SOURCE: 91750-18125 * RELOC: 91750-1X125 * PGMR: DMT LST **************************** HELLO ***************************** * * * SOURCE: 91750-18125 * * * * BINARY: 91750-1X125 * * * * PROGRAMMER: JIM HARTSELL * * * * SEPTEMBER 29, 1975 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 14, 1978 * * FOR DS/1000 ENHANCEMENTS AND SESSION COMPATIBILITY * * * ****************************************************************** SPC 2 B EQU Rm1 SUP SKP * SUBROUTINE HELLO MUST BE CALLED BY A USER PROGRAM BEFORE * ANY MASTER COMMUNICATION FUNCTIONS WITH AN HP3000, SUCH AS * RFA AND PTOP. THIS SUBROUTINE ESTABLISHES COMMUNICATION * AND CREATES A REMOTE SESSION MAIN PROCESS ON THE HP3000 WHICH * ACTS AS A LOGICAL EXTENSION TO THE LOCAL PROCESS. * * SUBROUTINE BYE IS CALLED TO TERMINATE COMMUNICATION WITH * A REMOTE HP3000 AND TO RELEASE THE SESSION MAIN PROCESS NUMBER. * * CALLING SEQUENCES: * * JSB HELLO JSB BYE * DEF *+7 DEF *+5 * DEF ERRCD <<<<<<<<< ERROR CODE >>>>>>>>>> DEF ERRCD * DEF LDEV <<<<<<< LU OF AN HP3000 >>>>>>> DEF LDEV * DEF LSTDV <<<<<< LU OF LOG DEVICE >>>>>>> DEF LSTDV * DEF SMPNM <<< RETURNED PROCESS NUMBER >>> DEF SMPNM * DEF LOGB << ADDRESS OF LOGON MESSAGE . * DEF LOGBL < LENGTH OF LOGON MSG IN BYTES . * . . * . . * . . * LOGB ASC 8,HELLO USER.ACCT * * RETURNED ERRCD: 0 = NO ERROR. * 1 = HELLO FAILURE (SMPNM = 0) OR LINK DOWN. * 2 = RESERVED FOR EXCLUSIVE ACCESS. * 4 = INVALID LU. * 5 = TIMEOUT. * 6 = ILLEGAL (REJECTED) REQUEST. * 7 = "RES" TABLE ACCESS ERROR. * 8 = SYSTEM ERROR. * SKP * HELLO NOP ENTRY FOR "HELLO". LDA HELLO LDB B20 STREAM = 20 OCTAL. JMP PASAD * BYE NOP ENTRY FOR "BYE". LDA BYE LDB B21 STREAM = 21 OCTAL. * PASAD STA RETRN SET UP RETURN ADDRESS. STB STREM SAVE STREAM TYPE. CLA STA PRAMS CLEAR OLD PARAM ADDRESSES. STA PRAMS+1 STA PRAMS+2  STA PRAMS+3 STA PRAMS+4 STA PRAMS+5 JMP ENTER * PRAMS NOP ERROR CODE. NOP LOGICAL UNIT OF HP3000. NOP LU OF LOG DEVICE. NOP RETURNED PROCESS NUMBER. NOP ADDR OF LOGON MESSAGE. NOP LENGTH OF LOGON MESSAGE (BYTES). * RETRN NOP ENTER JSB .ENTR GET PARAM ADDRESSES. DPRAM DEF PRAMS * LDA DPRAM CHECK FOR MISSING PARAMETERS. STA TEMP LDA STREM LDB N6 6 PARAMS FOR HELLO, CPA B21 OR LDB N4 4 PARAMS FOR BYE. PLOOP LDA TEMP,I SZA,RSS JMP ILL ERROR - MISSING PARAM. ISZ TEMP INB,SZB JMP PLOOP * * VERIFY VALID HP3000 LOGICAL UNIT. * LDA D4 PRESET THE ERROR CODE. LDB #LU3K CPB PRAMS+1,I RSS JMP NGOOD INVALID LU. * * SET BREAK AND CONTROL-Y FLAGS AND TURN ECHO BIT ON * LDA B400 STA D$ECH SET ECHO BIT FOR D$INP. STA D$BRK ENABLE "BREAK" STA D$CTY AND "CONTROL-Y". * * CHECK IF USER FOLLOWED A "HELLO" WITH ANOTHER "HELLO", * AND IF SO, PERFORM "BYE" PROCESSING FOR PREVIOUS "HELLO". * LDA STREM IS THIS A "HELLO"? CPA B21 JMP GTLOG NO. * LDA D$SMP GET CURRENT PROCESS NUMBER. SZA,RSS HAS IT ALREADY BEEN ESTABLISHED? JMP GTLOG NO. * JSB #RSAX YES. DO "BYE" PROCESSING FOR DEF *+4 PREVIOUS "HELLO": DEF D10 REMOVE OLD ENTRY FROM THE PNL. DEF D$SMP PROCESS NUMBER. DEF N1 NODE NUMBER. * * SET INPUT AND OUTPUT LU NUMBERS. * GTLOG JSB LOGLU STORE DEF *+2 LOG LU DEF TEMP IN TEMP. STA TEMP CLA LDA PRAMS+2,I SET D$LOG TO 3RD AND B77 PRAMETER (MINUS SZA,RSS CONTROL BITS), LDA TEMP IF SUPPLIED, OR STA D$LOG LOG LU. m* JSB IFTTY DEF *+2 DEF D$LOG LDB D$LOG SET D$INP TO SZA,RSS D$LOG (IF LDB TEMP INTERACTIVE) STB D$INP OR LOG LU. * * BEGIN CONSTRUCTION OF REQUEST BUFFER WITH * THE 8-WORD FIXED FORMAT FOR REMOTE HELLO OR BYE. * LDA DPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * LDA D6 STORE MESSAGE CLASS = 6. STA D$3BF LDA STREM STORE STREAM TYPE. STA D$3BF+2 CPA B20 HELLO? JMP MVMSG YES. GO MOVE. * LDA "BY" BYE. MOVE JSB D$STW ASCII "BYE" LDA "E" INTO APPENDAGE. JSB D$STW JMP SEND * NOLEN CLA,INA JMP NGOOD ILL LDA D6 JMP NGOOD TBLER LDA D7 JMP NGOOD * * MOVE ASCII MESSAGE TO REQUEST BUFFER. * * MVMSG LDB PRAMS+5,I NUMBER OF BYTES. STB D$3BF+7 SAVE IN HEADER. SZB,RSS CHECK FOR ZERO. JMP NOLEN ILLEGAL! INB ROUND UP. CLE,ERB MAKE WORDS. STB TEMP LDA PRAMS+4 SOURCE ADDRESS. LDB D$RQB ADB D8 DESTINATION ADDRESS. JSB .MVW MOVE THE MESSAGE. DEF TEMP NOP * * SEND REQUEST TO THE 3000 BY WRITING TO QUEX'S CLASS. * SEND JSB D3KMS SHIP THE REQUEST BUFFER TO QUEX. DEF *+2 DEF BIT15 NO-ABORT BIT SET IN CONWD. JMP ERRTN ERROR RETURN. * CLA CLEAR ERROR CODE. STA PRAMS,I LDA STREM HELLO OR BYE? CPA B21 JMP BYEX BYE: CLEAN UP. * LDB D$RQB HELLO: GET PROCESS NUMBER ADB D4 FROM REPLY BUFFER. LDA B,I ALF,ALF AND B377 STA D$SMP STORE FOR MASTER REQUESTS. STA PRAMS+3,I PASS BACK TO CALLER. STA B CLA,INA SZB,RSS JMP NGOOD HELLO FAILURE. * * BUILD PROCESS NUMBER LIST ENTRY IN "RES". * JSB LUTRU GET "REAL" LOG LU. DEF *+3 DEF D$LOG DEF REALU * JSB RNRQ WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE. DEF *+4 DEF LGW LOCK GLOBAL RN/WAIT/NO ABORT. DEF #TBRN TABLE-ACCESS RN. DEF TEMP DUMMY. JMP TBLER ** RTE ERROR. * JSB #RSAX ADD PROCESS # LIST ENTRY. DEF *+6 DEF D8 DEF REALU LOGGING LU. DEF D$SMP PROCESS NUMBER. DEF N1 NODE NUMBER. DEF BIT3K MPE FLAG. * SSB ANY ERRORS? JMP TBLER YES. * * SEND "DSLINE" COMMAND TO HP3000 AFTER "HELLO". * LDA DSLBF MOVE REQUEST TO D3KMS BUFFER. LDB D$RQB JSB .MVW DEF D12 NOP * JSB D3KMS SEND "DSLINE" TO HP3000, DEF *+2 AND WAIT FOR REPLY. DEF BIT15 NO ABORT. JMP ERRTN ERROR RETURN. * JMP RETRN,I RETURN TO USER. * * CHECK BYE. "FROM" PROCESS NUMBER IS ZERO FOR CLEAN BYE. OTHERWISE, * USER MAY HAVE REPLIED "NO" TO AN "ABORT?" PROMPT. * BYEX LDB D$RQB GET "FROM" ADB D4 PROCESS # LDA B,I IN REPLY. ALF,ALF AND B377 SZA IF NON-ZERO, JMP GET8 SOMETHING IS WRONG. * * BYE WAS GOOD: REMOVE ENTRY FROM THE PROCESS # LIST. * JSB #RSAX DEF *+4 DEF D10 REMOVE AN ENTRY. DEF D$SMP PROCESS NUMBER. DEF N1 NODE NUMBER. * CLA CLEAR STA D$SMP PROCESS NUMBER. JMP RETRN,I RETURN TO USER. * ERRTN CPA "DS" RSS JMP SYSER SYSTEM ERROR. * LDA B GET NUMERIC PORTION OF "DSXX". CPA "00" JMP SYSER SYSTEM ERR IF ZERO. AND D7 ISOLATE LAST DIGIT. * NGOOD LDB PRAMS MAKE SURE ERROR PARAM SZB WAS SPECIFIED. STA PRAMS,I RETURN ERROR CODE. JMP RETRN,I RETURN TO CALLER. * * RTE SYSTEM EU$"RROR (PROBABLY BAD LU). SEND KILL TO TERMINATE SESSION. SYSER LDB D$RQB GET MPE ADB D4 SESSION LDA B,I NUMBER. ALF,ALF AND B377 SZA,RSS JMP GET8 STA SMP# STORE IN "KILL" MESSAGE. JSB EXEC SEND KILL TO DEF *+8 3000 VIA CLASS DEF SD20 I/O TO QUEX. DEF D0 DEF KLBUF DEF D8 DEF D8 DEF D0 DEF #QXCL NOP GET8 LDA D8 RETURN ERROR CODE JMP NGOOD 8 TO CALLER. * KLBUF BYT 10,6 LENGTH, CLASS FOR KILL D0 OCT 0 OCT 27 STREAM OCT 0 SMP# NOP SMP NUMBER OCT 0,0,0 SKP * * CONSTANTS AND WORKING STORAGE. * D4 DEC 4 D6 DEC 6 D7 DEC 7 D8 DEC 8 D10 DEC 10 D12 DEC 12 SD20 DEF 20,I B20 OCT 20 B21 OCT 21 B77 OCT 77 BIT15 OCT 100000 BIT3K OCT 40000 B377 OCT 377 B400 OCT 400 N1 DEC -1 N4 DEC -4 N6 DEC -6 LGW OCT 40002 STREM NOP "BY" ASC 1,BY "E" ASC 1,E "DS" ASC 1,DS "00" ASC 1,00 TEMP NOP REALU NOP * DSLBF DEF *+1 OCT 006003 "DSLINE" REQUEST BUFFER. OCT 0 OCT 22 OCT 0,0,0,0 OCT 10 ASC 2,RFA OCT 27 OCT 0 * END c$ @ K 91750-18126 2013 S C0122 &ID.66              H0101 cOASMB,R,L,C HED * ID.66 91750-18126 REV.2013 NAM ID.66 91750-16126 REV.2013 800724 (L) EXT $IF2,$IF5,$IF7,$IFTX,$DV1,$DV4,$DV6,$DV13 EXT $DV15,$DV16,$DV17,$DV18,$DV19,$DV20 EXT $DIOC,$XQSB,$DMPR ENT ID.66 SPC 2 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: ID.66 * SOURCE: 91750-18126 * RELOC: 91750-16126 * PGMR: JOHN LAMPING * * WRITTEN BY JOHN LAMPING [APRIL 1979] * * L-SERIES PSI DS/1000 DRIVER * * NOTE: WHENEVER KNOWLEDGE OF THE BIT POSITION OF A FLAG IS USED * BUT NO REFERENCE TO THE FLAG WOULD OTHERWISE BE GENERATED, * THE LABEL OF THE FLAG IS DOUBLE REFERENCED. ( +FL-FL ) SPC 2 ************************************************** * * * TEMPORARIES AND CONSTANTS * * * ************************************************** SPC 2 * * IFT EXTENSION POINTERS * XTBEG EQU * RPTRY DEF *-XTBEG RETRY COUNTER / => NEXT WORD TO READ RLEN1 DEF *-XTBEG BUFFER LENGTH / - WORDS TO SKIP RLEN2 DEF *-XTBEG BUFFER LENGTH / WORDS TO READ RDSIZ DEF *-XTBEG LENGTH OF FRAME READY ON CARD WPTR DEF *-XTBEG => NEXT WORD TO WRITE WLEN DEF *-XTBEG LENGTH OF WRITE BUFFERS WFSIZ DEF *-XTBEG MAXIMUM PSI FRAME SIZE WBUFS DEF *-XTBEG NUMBER OF ALLOCATED OUTPUT BUFFERS * - NUMBER OF TIMEOUTS LEFT IF CARD * HAS BEEN ASKED TO ALLOCATE BUFFERS RCONT DEF *-XTBEG READ` PROCESS CONTINUATION ADDRESS WCONT DEF *-XTBEG WRITE PROCESS CONTINUATION ADDRESS * THE ABOVE TWO WORDS MUST BE IN ORDER FBITS DEF *-XTBEG FLAG BITS FMISC DEF *-XTBEG MISCELLANEOUS INFORMATION TRIPL DEF *-XTBEG DMA TRIPLE AREA (SIX WORDS) MXTPL ABS XTBEG-* MXTLN ABS XTBEG-TRIPL-6 XTPTR DEF XTBEG SPC 1 * * TEMPORARY VARIABLES * SSERV BSS 1 SYSTEM SERVICE REQUEST * -3 = COMPLETE WRITE PROCESS REQUEST * -2 = COMPLETE READ PROCESS REQUEST * -1 = COMPLETE CURRENT REQUEST * 0 = NO SYSTEM SERVICE * 1 = REQUEST DCPC FOR READ PROCESS * 2 = REQUEST DCPC FOR WRITE PROCESS * 8 = RELEASE DCPC SRVOK BSS 1 PROCESS ALLOWED TO DO COMPLETION RETURN * 0 IF ANY SYSTEM SERVICE OK ACTIV BSS 1 WHICH PROCESS IS ACTIVE * 1=READ, 2=WRITE ADV BSS 1 -1 SAYS ACTIVATE OTHER PROCESS ENTRY BSS 1 DRIVER ENTERED AT CA66 IF -1, IA66 IF 0 TGONE BSS 1 ONE IFF MEDIUM TIMEOUT EXPIRED RENTR BSS 1 NON-ZERO SAYS DRIVER REENTRY REQUESTED FNMBR DEC 29150 SECURITY CODE (TEMP1 MUST BE NEXT) TEMP1 BSS 1 SIX WORD TEMPORARY AREA FOR ACTIVE TEMP2 BSS 1 PROCESS, USED FOR SCHEDULING QUEUE TEMP3 BSS 1 AMONG OTHER THINGS TEMP4 BSS 1 TEMP5 BSS 1 TEMP6 BSS 1 SPC 1 * * FBITS BIT EQUIVALENCES * FW EQU 000000B WAIT FOR READ FOR FRONT PANEL MESSAGES * SHOULD BE 10000B RC EQU 40000B RECONNECTION AFTER POWER-FAIL WANTED SE EQU 20000B SEVERE ERROR OCCURRED ON CARD AC EQU 10000B CARD HAS BEEN ASKED TO CONNECT ND EQU 4000B LINK IS IN NON-DS MODE SM EQU 2000B  START OF DS 1 MESSAGE LC EQU 1000B LINE IS LOGICALLY CONNECTED LT EQU 400B LONG TIMEOUT RUNNING MT EQU 200B MEDIUM TIMEOUT RUNNING ST EQU 100B SHORT TIMEOUT RUNNING WL EQU 40B BACKPLANE LOCKED TO WRITE PROCESS RL EQU 20B BACKPLANE LOCKED TO READ PROCESS * BOTH SET SAY BACKPLANE BUSY WP EQU 10B WRITE REQUEST PENDING RP EQU 4B READ REQUEST PENDING WA EQU 2B REQUEST ON WRITE PROCESS ABORTED RA EQU 1B REQUEST ON READ PROCESS ABORTED SPC 1 * * FMISC BIT EQUIVALENCES * TW EQU 60000B CARD OUTPUT MESSAGE TYPE * SHOULD BE 160000B TR EQU 16000B CARD INPUT MESSAGE TYPE FM EQU 1000B FRONT PANEL MESSAGE SEEN CI EQU 400B MUST SEND CONNECT INDICATION LU EQU 377B LOGICAL UNIT NUMBER OF CARD SPC 1 * * OTHER EQUIVALENCES * A EQU 0 B EQU 1 CDATA EQU 30B CDMA0 EQU 20B CDMA1 EQU CDMA0+1 CDMA2 EQU CDMA0+2 CDMA3 EQU CDMA0+3 CFPFG EQU 24B SET TO -1 IF CARD USED BY FRONT PANEL SPC 1 * * DECIMAL AND OCTAL CONSTANTS * .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 B10 EQU .8 .9 DEC 9 B11 EQU .9 .10 DEC 10 B12 EQU .10 B13 OCT 13 .15 DEC 15 B17 EQU .15 .50 DEC 50 B77 OCT 77 B100 OCT 100 B200 OCT 200 B377 OCT 377 B400 OCT 400 B600 OCT 600 B777 OCT 777 B1000 OCT 1000 B2000 OCT 2000 B7703 OCT 7703 B7777 OCT 7777 B10K OCT 10000 B40K OCT 40000 BIT15 OCT 100000 MB1K1 ABS -1000B-1 MB400 OCT -400 M60 DEC -60 MB36 OCT -36 M20 DEC -20 M10 DEC -10 M5 DEC -5 M3 DEC -3 M2 DEC -2 M1 DEC -1 SPC 1 * * ERROR CODES * #LFAL EQU .1 #TMOT EQU .2 #LBUS EQU .3 #MEAB EQU .4 #NOIN EQU B10 #WRMD EQU B11 #ILRQ EQU B12 #RBUS EQU .5 #SERR EQU B13 SPC 1 ~;* * CARD COMMANDS * !NOOP EQU B40K NO OPERATION (CANCELS UNSOLICITED INPUT) !UNST OCT 50000 ENABLE UNSOLICITED STATUS INPUT !UNDS OCT 45401 ABORT UNCOLICITED STATUS INPUT !ABDM OCT 45402 ABORT DMA TRANSFER !OTBF OCT 43000 ALLOCATE OUTPUT BUFFERS !NMT OCT 40400 NEW MESSAGE TYPE !OTTR EQU BIT15 OUTPUT DATA TRANSFER !SMB EQU B10K START OF MESSAGE BIT FOR !OTTR !INTR EQU .0 INPUT DATA TRANSFER !RSET OCT 57400 RESET !MIFL OCT 42400 WHAT IS MAXIMUM I FIELD? !R2WD OCT 45002 READ 2 WORDS FROM BUFFER !TIME OCT 140401 SET CARD TIMEOUT !CNCT OCT 41400 CONNECT !DSCN OCT 41000 DISCONNECT !DCRD OCT 46000 DISCARD INPUT FRAME !ADBP OCT 52400 ADVANCE BUFFER POINTER !PWUP OCT 77400 POWER UP ACKNOWLEDGE !BRK OCT 50400 SEND BREAK FRAME !SIDT OCT 44000 SET INTERNAL DATA TYPE !STGD OCT 135336 GOOD POWER UP STATUS !STG2 OCT 177164 OTHER GOOD POWER UP STATUS SPC 1 * * PARAMATERS AND POINTERS * SHORT EQU .10 COUNTER FOR SHORT TIME MDIUM EQU .50 MEDIUM TIMEOUT LONG DEC 1500 15 SECOND TIMEOUT RRLIM DEC -20 READ RETRY LIMIT RINIA DEF RINI WINIA DEF WINI RSERA DEF RSER WSERA DEF WSER SEVERE ERROR RECOVERY ADDRESS WPFLA DEF WPFL POWER FAIL RECOVERY ADDRESS WFPRA DEF WFPR FRONT PANEL RECOVERY ADDRESS RCNTA DEF RCONT-1,I QUEUE ASC 3,QUEUE PROGRAM THAT MAKES READ REQUESTS SPC 1 * * BIT MASKS * TRB ABS TR FMB EQU B1000+FM-FM CIB EQU B400+CI-CI LUB EQU B377+LU-LU FWB EQU BIT15+FW-FW RCB ABS RC SEB ABS SE ACB ABS AC NDB ABS ND SMB ABS SM LCB EQU B1000+LC-LC LTB ABS LT MTB ABS MT STB EQU B100+ST-ST WPB EQU .8+WP-WP RPB EQU .4+RP-RP WALCB ABS WA+LC LCRCB ABS LC+RC M4B ABS LC+RC+ND+100000B+FW-FW BUSYB ABS AC+WP+RP+WL+RL TWB ABS 160000B+TW-TW FMNB EQU MB1K1+FM-FM CINB ABS -CI-1 PWUPB ABS SE+RC+WP+RP WLRLB ABS WL+RL SERCN ABS -SE-RC-1 XTNB ABS -ST-MT-LT-x1 XCNB ABS -AC-RC-LC-1 LCNB EQU MB1K1+LC-LC RPNB EQU M5+RP-RP M3NB ABS -RC-ND-10000B+FW-FW-1 WANB EQU M3+WA-WA SKP ************************************************** * * * SYSTEM SECTION * * * ************************************************** SPC 2 **** **** * *** ENTRY PART: HANDLE DRIVER ENTRY *** * **** **** SPC 1 * * DO CONFIGURATION OF DRIVER * ID.66 NOP AND .7 GET JUST GOOD STUFF STA ENTRY REMEMBER WHY WE ARE HERE LDA $IFTX GET IFT EXTENSION ADDRESS CPA XTBEG ALREADY POINTING THERE? JMP S1A2 YES, BE LAZY LDB MXTPL NO, GET NUMBER OF WORDS STB TEMP1 WE MUST SET LDB XTPTR GET POINTER TO FIRST S1A1 STA B,I CONFIGURE WORD INA ADVANCE INB POINTERS ISZ TEMP1 DONE? JMP S1A1 NO, WORK SOME MORE S1A2 CLA CLEAR STA SSERV DRIVER STA ACTIV STATUS STA TGONE TEMPORARY STA RENTR VARIABLES STA SRVOK * * HANDLE FIRST DRIVER ENTRY * LDA $IF7,I HAVE WE BEEN ON THIS ALF,RAL IFT BEFORE SSA,RSS (FIRST ENTRY FLAG CLEAR)? JMP S1C YES LDA $IF7,I AND B377 IS IFT EXTENSION ADA MXTLN OF THE CCE,SZA,RSS RIGHT SIZE? JMP S1B YES, PROCEED LDA .50 NO, SAY ERROR SO SOMEBODY STA $DV16,I WILL GET THE IDEA CLA DO COMPLETION JMP ID.66,I RETURN S1B STA RDSIZ,I CLEAR CRITICAL STA WBUFS,I IFT EXTENSION WORDS STA FBITS,I CLEAR ALL FLAGS LDA $IF7,I CLEAR XOR B2000 FIRST ENTRY STA $IF7,I FLAG LDA RINIA SET STA RCONT,I PROCESS LDA WINIA RESTART STA WCONT,I ADDRESSES * * DETERMINE TYPE OF ENTRY, HANDLE IT * S1C LDA ENTRY INITIATE SLA,RAR OR TIMEOUT ENTRY? JMP S1C0 YES SLA,RAR NO, CONTINUE? JMP S1C1 YES SLA NO, POWER FAIL JMP PFAIL YES, HANDLE THAT * * HANDLE ABORT REQUESTS * LDA $DV20,I FIND WHICH ALF,ALF PROCESS WAS AND .3 SERVING THIS LDB A DVT LDA FBITS,I SET HIS IOR B+WA-WA ABORT BIT CMB REQUEST STB SSERV COMPLETION RBL,RBL CLEAR PROPER AND B+WP-WP PENDING BIT STA FBITS,I SAVE NEW FLAGS JMP INIT ENTER MAIN CODE * * HANDLE TIMEOUT * S1C0 SLA,RSS TIMEOUT? JMP S1C2 NO, INITIATE ENTRY LDA FBITS,I MEDIUM ALF,ALF LENGTH RAL,SLA TIMEOUT? ISZ TGONE+MT-MT YES, FLAG IT CMA,SSA,SLA MEDIUM OR SHORT TIMEOUT? JMP SICK+ST-ST NO, BAD TROUBLES JMP INIT YES, HANDLE NORMALLY * * HANDLE CONTINUE ENTRY * S1C1 SFC CDMA2 DMA PARITY ERROR? JMP $DMPR YES, REPORT LDA FBITS,I HAS THE LINE BEEN AND BUSYB INITIALIZED SZA OR ARE WE TRYING? JMP CONTN YES, PROCESS THIS INTERRUPT CLF CDATA NO, TURN OFF FLAG JMP EXIT IGNORE INTERRUPT SPC 1 **** **** * *** COMMAND PART: IDENTIFY AND VERIFY COMMAND *** * **** **** S1C2 LDA $DV15,I GET REQUEST AND B7703 ISOLATE FUNCTION/SUBFUNCTION CLB RRR 6 ISOLATE FUNCTION CODE BLF,RBL IS REQUEST TYPE SSB,SLB,RSS CONTROL REQUEST? JMP S2A1 NO, READ OR WRITE ADA {MB36 YES, IS FUNCTION CODE SSA,RSS UNDER 36B? JMP S2A9 NO, INDICATE IF LINK IS UP ADA .6 YES, IS IT SSA UNDER 30B? JMP S2A6 YES, ILLEGAL LDB $DV16,I GET OPTIONAL PARAMETER ARS IS REQUEST SET DS/NON-DS MODE? SZA OR SET/CLEAR FRONT PANEL WAIT CPB FNMBR YES, IS SECURITY CODE WRONG? CCB,RSS NO, ALL IS COOL, GET PHONY MESSAGE TYPE JMP S2A6 YES, DUMP THIS DUDE S2A13 LDA .2 JMP S2A4 SET WRITE FLAG S2A1 AND B77 GET MESSAGE TYPE AND DIRECTION LDB A SAVE IT ARS GET JUST TYPE CPA B17 READ/WRITE SPECIAL DATA? JMP S2A13 YES CPA .3 BREAK FRAME SLB,RSS DATA TYPE WRITE? JMP S2A11 NO LDA FNMBR YES, CHECK FIRST CPA $DV18,I PARAMETER FOR SECURITY CODE CCE,RSS RIGHT JMP S2A6 WRONG! LDA FMISC,I GET OUT AND LUB LU TIMES 32 ALF,ELA PLUS 1 CPA $DV19,I EQUAL TO SECOND PARAMETER? JMP S2A12 YES, PROCEED JMP S2A6 NO, NO FOOLING US S2A11 SZA DS 1 CPA B10 MESSAGE RSS TYPE? JMP S2A10 NO LDA $DV15,I YES, ELA,ALF CLASS I/O ERA AND DOUBLE SSA,SLA,RSS BUFFERED? JMP S2A6 NO, ERROR LDA $DV19,I YES, SECOND BUFFER ADA M2 AT LEAST SSA TWO WORDS? JMP S2A6 NO, ERROR CCA YES, ADA $DV19,I POINT TO ADA $DV18,I LAST WORD STA TEMP1 SAVE POINTER LDA FMISC,I GET AND LUB LU XOR TEMP1,I GET REST OF SLB LAST WORD AND B777 UNLESS IT IS A READ XOR TEMP1,I IN WHICH CASE JUST STORE STA TEMP1,I STUFF IT CLA RE~STORE TYPE S2A10 ADA M5 IS TYPE SSA,RSS TOO BIG? JMP S2A6 YES, ERROR S2A12 CLA,INA SLB,RSS IS REQUEST A READ? JMP S2A4 YES LDA FBITS+ND-ND,I NO, WRITE, ALF GET NON DS ALLOWED IOR FBITS+FW-FW,I IN SIGN BIT RBR,RBR DS 1 OR DS 2 CMB,SSB,SLB MESSAGE TYPE? CMA YES SSA,RSS MODES MATCH? JMP S2A5 NO, ERROR LDA .2 GET WRITE FLAG LDB FBITS+AC-AC,I ARE WE BLF,SLB INITIALIZED? JMP S2A4 YES LDA #NOIN NO, STOP THIS JMP S2A7 IMPOSTOR S2A4 STA SRVOK INDICATE COMPLETION LIMITATION ALF,ALF INDICATE IOR $DV20,I WHO WILL DO STA $DV20,I THIS COMMAND LDA SRVOK SET COMMAND RAL,RAL PENDING IOR FBITS+WP-WP,I FLAG CPA FBITS,I REQUEST ALREADY PENDING? JMP S2A8 YES, REJECT THIS ONE STA FBITS,I SET PENDING FLAG JMP INIT ENTER MAIN CODE S2A8 LDA #LBUS LOCAL BUSY ERROR SAYS JMP S2A7 TOO MUCH TO HANDLE S2A9 LDA FBITS,I DETERMINE WHTEHER WE AND M4B ARE READY FOR A DS 1 MESSAGE LDB WBUFS,I HAVE WE GIVEN UP CPB M1 ON GETTING A BUFFER? CLA YES, NOT READY CPA LCRCB OTHERWISE READY? CLA,RSS YES, GOOD STATUS S2A5 LDA #WRMD WRONG MODE ERROR RSS S2A6 LDA #ILRQ GET ILLEGAL REQUEST STATUS S2A7 CLB SAY CURRENT STB ACTIV DVT JSB STAT SET STATUS CCA SET COMPLETION STA SSERV FLAG JMP EXIT GO RESTORE TIMEOUTS * * PUT INFORMATION ON COMMAND FOR ACTIVE PROCESS IN TEMP1 : TEMP4 * NO SKIP RETURN IF REQUEST HAS BEEN ABORTED * SKIP RETURN WITH TEMPS VALID IF REQUEST STILL PENDING * CMDAT NOP LDA ACTIV HAS AND FBITS+WA-WA,I REQUEST BEEN SZA ABORTED? JMP CMDAT,I YES, NO SKIP RETURN ISZ CMDAT NO, PREPARE SKIP RETURN LDA ACTIV MAKE SURE WE HAVE JSB DVTST THE CORRECT COMMAND LDA $DV15,I GET REQUEST LDB $DV17,I GET LENGTH STB TEMP3 OF FIRST BUFFER LDB $DV16,I GET POINTER STB TEMP2 TO BUFFER ALF,ALF ARE BITS RAR,RAR NINE AND TEN SSA,SLA,RSS SET? JMP CMDA1 NO, MUST BE READ OR WRITE ALF ISOLATE OPTION PART AND .7 OF FUNCTION CODE CMA MAKE NEGATIVE FOR COMMAND TYPE LDB $DV18,I GET OPTIONAL PARAMTER JMP CMDA2 CMDA1 SLA,RSS ARE WE TO IGNORE FIRST BUFFER? JMP CMDA3 NO CLB YES, SET LENGTH STB TEMP3 TO ZERO LDB $DV18,I SET POINTER STB TEMP2 TO SECOND BUFFER CMDA3 ALF,RAR GET BITS 9, 8, AND 7 OF FUNCTION CODE AND .7 WHICH ARE MESSAGE TYPE LDB $DV19,I GET LENGTH OF SECOND BUFFER ADB M2 WITHOUT LU WORD SZA DS 1 MESSAGE TYPE? CLB NO, IGNORE SECOND BUFFER CMDA2 STB TEMP4 STORE SECOND LENGTH / OPTIONAL PARAMETER STA TEMP1 STORE MESSAGE TYPE / COMMAND JMP CMDAT,I THAT'S ALL FOLKS SPC 1 **** **** * *** EXIT PART: LEAVE DRIVER, REQUEST / RELEASE RESOURCES *** * **** **** EXIT LDA FBITS,I GET TIMEOUT FLAGS CLB ALF,ALF LONG SLA TIMEOUT? LDB LONG+LT-LT YES RAL,SLA MEDIUM TIMEOUT? LDB MDIUM+MT-MT YES RAL,SLA SHORT TIMEOUT? LDB SHORT+ST-ST YES CMB,INB MAKE TIMEOUT NEGATIVE STB TEMP1 SAVE TIMEOUT VALUE LDA SSERV DO WE NEED TO ASK FOR SZA,RSS A COMPLETION RETURN? JMP EXIT4 NO G.CMA YES, SET UP JSB DVTST RIGHT DVT LDB $DV6,I GET STATUS LDA $DV15,I IS REQUEST IOR B100 A WRITE CPA $DV15,I REQUEST? ADB .4 YES, SET NOT READ BIT AND B600 IS REQUEST SZA NON-DS? ADB .8 YES, SET NON-DS BIT STB $DV6,I SET STATUS LDA $DV20,I CLEAR PROCESS AND B377 SERVER STA $DV20,I FLAG CLA SAY NO STA $DV16,I ERROR JMP EXIT5 EXIT4 LDA ENTRY WERE WE ENTERED CLE,ERA ON ABORT SZA,RSS OR INITIATE? JMP EXIT7 YES ISZ ID.66 NO, DO PHYSICAL WAIT EXIT5 CLA,RSS EXIT7 LDA .8 GET PHONY DONE REQUEST LDB TEMP1 SET STB $IF2,I TIMEOUT SZB ACTIVATE IT INA IF ANY JMP ID.66,I RETURN FROM WHENCE WE CAME SPC 1 * * SET UP DVT SERVED BY PROCESS INDICATED BY A * DVTST NOP SZA,RSS DO WE WANT THE CURRENT DVT? JMP DVTST,I YES LDB $IF5,I MAKE CPB $DV1 SURE JMP DVTS1 WE HAVE STA DVTMP ONE OF CLA,INA OUR OWN JSB $DIOC DVT'S LDA DVTMP DVTS1 ALF,ALF IS THIS DVT AND $DV20,I BEING SERVED BY SZA THE PROPER PROCESS? JMP DVTST,I YES LDB $IF5,I NO, GO TO LDA .5 THE OTHER JSB $DIOC DVT JMP DVTST,I DVTMP BSS 1 * * SET STATUS OF REQUEST ON ACTIVE PROCESS * STAT NOP ALF SET STATUS IN SZA PROPER ADA .2 FORM STA CMDAT SAVE IT LDA ACTIV HAS REQUEST AND FBITS+WA-WA,I BEEN SZA ABORTED? JMP STAT,I YES, DO NOTHING LDA ACTIV GET RIGHT JSB DVTST DVT LDA $DV6,I UPDATE AND MB400 : STATUS IOR CMDAT STA $DV6,I JMP STAT,I ALL DONE SKP ************************************************** * * * READ SECTION * * * ************************************************** SPC 2 **** **** * *** PART -1: SEVERE ERROR RECOVERY *** * **** **** RSER EQU * LDA FBITS,I IS A AND RPB READ REQUEST SZA,RSS PENDING? JMP RINI NO JSB COMPL YES, COMPLETE IT LDA #SERR DECLARE A SEVERE JSB STAT ERROR SPC 1 **** **** * *** PART 0: INITIALIZE FOR READING *** * **** **** RINI CLA SAY NO FRAME STA RDSIZ,I PENDING SPC 1 **** **** * *** PART 1: WAIT FOR FRAME *** * **** **** R1 LDA M10 SET TIMEOUT STA RPTRY,I COUNTER R1A LDA FMISC,I NEED TO TELL AND CIB HIGHER LEVELS ABOUT SZA CONNECT? JMP R2D YES LDA RDSIZ,I FRAME SZA READY? JMP R2 YES LDA FBITS,I NO, CLEAR ERA,CLE,ELA READ ABORTED BIT STA FBITS+RA-RA,I JUST IN CASE AND RPNB READ CPA FBITS,I PENDING? JMP R1D NO AND ACB YES, ARE WE AUTHORIZED SZA,RSS TO CONNECT? JMP R1B NO, ERROR JSB CMDAT GET READ'S NOP LDA TEMP1 MESSAGE TYPE CPA .4 DS 2 TYPE? JMP R1D YES, DON'T TIME HIM LDA TGONE DID A SZA TIMEOUT OCCUR? ISZ RPTRY,I YES, TOO MANY? JMP R1C NO LDA #TMOT YES, BOUNCE THIS RSS REQUEST WITH TIMEOUT R1B LDA #NOIN NOT INITIALIZED JSB STAT INDICATE ERROR JSB COMPL DUMP REQUEST JMP R1 TRY AGAIN R1C LDA FBITS,I REQUEST IOR MTB TIMEOUT STA FBITS,I R1D JSB SUSP WAIT JMP R1A SEE WHAT HAPPENED SPC 1 **** **** * *** PART 2: DETERMINE MESSAGE PARAMETERS *** * **** **** R2 LDA FMISC,I IS MESSAGE AND TRB TYPE SZA,RSS DS 1? JMP R2A YES LDA RDSIZ,I NO, FIRST BUFFER STA RLEN1,I LENGTH IS FRAME SIZE CLA SECOND BUFFER LENGTH IS ZERO JMP R2E * * DS MESSAGE, GET TOTAL LENGTHS FROM FIRST TWO WORDS * R2A JSB LOCK GRAB BACKPLANE LDB RDSIZ,I IS FRAME ADB M3 AT LEAST LDA FBITS,I THREE WORDS LONG AND SMB AND IS START SSB,INB,RSS OF MESSAGE SZA,RSS BIT SET? JMP R2B NO, THROW THE BUM OUT STB RDSIZ,I SAY BUFFER TWO WORDS SHORTER LDA !R2WD TELL CARD THAT WE WANT JSB OTCM$ TO READ IN TWO WORDS JSB WFLG$ LIA CDATA,C FIRST WORD IS LENGTH STA RLEN1,I OF FIRST BUFFER JSB WFLG$ SECOND WORD LIA CDATA,C IS LENGTH STA RLEN2,I OF SECOND BUFFER ARS IS SECOND BUFFER SZA SHORTER THAN 2 WORDS? JMP R2C NO, GOOD * * ILLEGAL FRAME, THROW IT AWAY * R2B LDA !DCRD TELL CARD JSB OTCM$ TO THROW JSB WCOM$ OUT FRAME JSB UNLK$ CLA NO MORE STA RDSIZ,I FRAME PENDING JMP R1 TRY AGAIN * R2C JSB UNLK$ GIVE BACK BACKPLANE JMP R3 * * SEND CONNECT INDICATION REQUEST TO HIGHER UPS * R2D CLA REQUEST STA RLEN1,I CONNECT R2E STA RLEN2,I INDICATION SPC 1 **** **** * *** PART 3: GET A READ REQUEST *** * **** **** R3 CLA CLEAR OUT STA RPTRY,I RETRY COUNTER * * WAIT FOR A READ REQUEST, MAKE ONE IF NEEDED * R3A LDA FBITS+RA-RA,I CLEAR READ ABORTED BIT ERA,CLE,ELA IN CASE IT WAS SET STA FBITS,I FROM BEFORE AND RPB IS A READ REQUEST SZA PENDING? JMP R3B YES, DO OUR STUFF LDB RLEN1,I IS THIS A ADB RLEN2,I CONNECT SZB,RSS INDICATION? JMP R3A2 YES, DS 1 MESSAGE TYPE LDA FBITS,I AND RCB IS THIS A SZA,RSS 3000 CALL? JMP R3B2 YES, WAIT FOR QUEZ LDB FMISC,I GET AND RRL 6+TR-TR SAVE AND .7 MESSAGE R3A2 STA TEMP4 TYPE CPA .2 FRONT PANEL RSS MESSAGE TYPE? JMP R3A1 NO LDA FBITS+FW-FW,I YES, IN FRONT PANEL SSA WAIT MODE? JMP R3B2 YES, WAIT LDA FMISC,I NO, IS THIS THE AND FMB FIRST FRONT PANEL SZA MESSAGE SEEN? JMP R3B4 NO, DISCARD IT R3A1 LDB RLEN1,I GET LENGTHS LDA RLEN2,I OF BUFFERS STA TEMP3 SAVE SECOND LENGTH SZA IS SECOND LENGTH LDA RPTRY,I NON-ZERO AND IS ADA RRLIM RETRY COUNTER SSA,RSS BIG? CLB YES, DUMP FIRST BUFFER STB TEMP2 SAVE FIRST LENGTH LDA FMISC,I SAVE AND LUB LU IOR BIT15 INDICATING SECOND EQT STA TEMP1 JSB $XQSB SCHEDULE DEF QUEUE PROGRAM DEF FNMBR WITH PARAMETERS DEC 0 LDA FBITS,I ASK FOR IOR STB QUICK STA FBITS,I TIMEOUT JSB SUSP WAIT JMP R3A SEE IF A GOOD THING HAPPENEDK * * HANDLE NO SAM REQUESTS * R3B CLA SET JSB STAT GOOD STATUS JSB CMDAT FIND OUT ABOUT REQUEST JMP R1 REQUEST ABORTED LDA TEMP3 IS IT A IOR TEMP4 NO SAM SZA REQUEST? JMP R3C NO JSB COMPL MAYBE, DO A COMPLETION JSB CMDAT IS THIS JMP R1 REQUEST ABORTED LDA TEMP1 A CONNECT SZA,RSS INDICATION? JMP R3B3 YES LDA $DV18,I NO, DOES THIS SAY CPA .1 BAD LENGTHS? JMP R3B4 YES, TOSS OUT FRAME CLB CLEAR RETRY COUNTER CPA .2 IF DS/1000 STB RPTRY,I IS ILL JSB LOCK WAIT FOR BACKPLANE JSB UNLK$ TO QUIET DOWN LDA FBITS,I ASK FOR IOR MTB MEDIUM STA FBITS,I TIMEOUT R3B2 JSB SUSP WAIT FOR SOMETHING LDA TGONE INCREMENT ADA RPTRY,I RETRY COUNTER STA RPTRY,I IF TIMEOUT OCCURRED JMP R3A TRY AGAIN R3B3 LDA FMISC,I CLEAR "MUST AND CINB TELL ABOUT STA FMISC,I CONNECT" BIT LDA RLEN1,I WERE WE IOR RLEN2,I LOOKING FOR A SZA CONNECT INDICATION? JMP R3A NO, WAIT FOR READ JMP R1 DONE R3B4 JSB LOCK GRAB BACKPLANE JMP R2B GO TOSS FRAME * * MAKE SURE COMMAND IS LEGAL * R3C LDA FMISC,I DO READ RRR 10+TR-TR MESSAGE TYPE XOR TEMP1 AND FRAME AND .7 TYPE SZA AGREE? JMP R3C1 NO, ERROR LDB TEMP1 DS 1 SZB MESSAGE TYPE? JMP R3C3 NO, TAKE ANYTHING LDA TEMP4 SECOND CPA RLEN2,I LENGTHS RSS EQUAL? JMP R3C1 NO, COMPLAIN LDA TEMP3 FIRST LENGTHS CPA RLEN1,I EQUAL? JMP R4 YES, GOOD SZA,RSS c NO, IS REQUEST FOR ZERO WORDS? JMP R3C2 YES, SORT OF GOOD R3C1 JSB COMPL CLAIM LDA #WRMD ILLEGAL JSB STAT REQUEST JMP R3A TRY AGAIN R3C2 LDA #RBUS SET STATUS TO JSB STAT LOCAL BUSY JMP R4 R3C3 LDA FMISC,I INDICATE IOR FMB FRONT PANEL MESSAGE CPB .2 IF THAT IS STA FMISC,I WHAT WE HAVE SPC 1 **** **** * *** PART 4: READ DATA *** * **** **** * * SET UP RLEN1, RLEN2, RPTRY * R4 LDA TEMP2 SET BUFFER POINTER IOR BIT15 WITH DMA INPUT STA RPTRY,I DIRECTION BIT LDA TEMP3 SET COMBINED ADA TEMP4 LENGTHS TO READ ADA BIT15 AND START OF MESSAGE BIT STA RLEN2,I ALLOWED FLAG LDB TEMP1 GET MESSAGE TYPE LDA RLEN1,I GET THE NUMBER OF WORDS IN FIRST BUFFER SZB SET TRANSMISSION LOG STA $DV17,I TO REAL LENGTH FOR NOT DS 1 CMA,INA GET NUMBER OF WORDS TO SKIP ADA TEMP3 FOR A DS 1 TYPE MESSAGE SZB,RSS DS 1 MESSAGE? STA RLEN1,I YES, RECORD SKIP COUNT * * WAIT FOR A FRAME TO ARRIVE, HANDLE EXCEPTIONS * R4B LDA RLEN2,I DO WE NEED SZA,RSS TO READ MORE WORDS? JMP R4F NO, WE ARE DONE R4B1 JSB CMDAT REQUEST STILL PENDING? JMP R1 NO, ABORTED LDB RDSIZ,I IS A SZB FRAME READY? JMP R4C YES LDA FBITS,I AND LCB IS THE LINK SZA,RSS LOGICALLY CONNECTED? JMP R4B2 NO, GO STOP THE READ JSB SUSP WAIT FOR SOME SIGNIFICANT EVENT JMP R4B1 TRY AGAIN R4B2 JSB COMPL REQUEST COMPLETION LDA #LFAL LINE FAILURE JSB STAT IS THE STATUS JMP R1 TRY AGAIN * * MAKE SURE WE HAVE A GOOD LOOKING FRAME * R4C LDA FMISC,I 9DO INPUT RRR 10+TR-TR MESSAGE TYPE XOR TEMP1 AND COMMAND AND .7 TYPE SZA AGREE? JMP R4C1 NO, ERROR LDA RLEN2,I GET START OF MESSAGE RAL,CLE,ERA ALLOWED INDICATOR STA RLEN2,I CLEAR IT LDA FBITS,I IS START AND SMB OF MESSAGE CME BIT SET AND SEZ,SZA NOT ALLOWED? JMP R4C1 YES, THAT'S BAD LDB RLEN1,I SSB,RSS CLB IS THE ADB RDSIZ,I FRAME SIZE CMB,INB BIGGER THAN ADB RLEN2,I THE NUMBER OF SSB,RSS WORDS WE WANT? JMP R4C2 NO, GOOD R4C1 JSB COMPL YES, COMPLETE THIS REQUEST LDA #MEAB BLAME THINGS ON JSB STAT THE OTHER SIDE JMP R1 GO GET BACK IN SYNC R4C2 JSB LOCK WE WILL NEED THE BACKPLANE * * DO SOMETHING WITH THIS FRAME * R4D LDA RLEN1,I DO WE SSA,RSS NEED CLA TO ADA RDSIZ,I SKIP THE LDB A ENTIRE CMA,SSA,INA,SZA FRAME? JMP R4D1 NO STB RLEN1,I UPDATE COUNT CLA NO FRAME STA RDSIZ,I READY NOW LDA !DCRD TELL CARD JSB OTCM$ TO DUMP JSB WCOM$ FRAME JMP R4E1 R4D1 STB RDSIZ,I UPDATE FRAME SIZE R4D2 LDA RLEN1,I DO WE NEED CMA,SSA,INA TO SKIP SOME WORDS? JMP R4D3 NO ADA MB400 YES, SKIP SSA,RSS AT MOST CCA 255 ADA B400 WORDS LDB A UPDATE ADB RLEN1,I SKIP STB RLEN1,I COUNT IOR !ADBP TELL JSB OTCM$ CARD JSB WCOM$ WAIT FOR CARD TO FINISH JMP R4D2 SEE IF WE MUST SKIP MORE R4D3 LDA !INTR COMPUTE ADA RDSIZ,I COMMAND TO STA TEMP6 READ IN THE FRAME LDA TRIPL SET POINTER STA TEMP5 TO TRIPLE AREA LDA RPTRY,I SET DMA STARTING ADDRESS STA TEMP1 WITH INPUT BIT SET ADA RDSIZ,I UPDATE STA RPTRY,I BUFFER POINTER LDA RDSIZ,I SET DMA CMA,INA TRANSFER STA TEMP2 LENGTH ADA RLEN2,I SAY HOW MANY WORDS STA RLEN2,I MUST STILL BE READ CLA SAY NO STA RDSIZ,I FRAME READY JSB DMA$ SET UP TRIPLE, START UP DMA * * WAIT FOR TRANSFER TO FINISH, HANDLE EXCEPTIONS * R4E JSB WTRN$ WAIT FOR TRANSFER TO FINISH R4E1 JSB UNLK$ UNLOCK BACKPLANE LDA FMISC,I IS AND TRB MESSAGE TYPE SZA,RSS DS 1? JMP R4B YES, GET NEXT FRAME * * ENTIRE MESSAGE HAS BEEN READ, COMPLETE * R4F JSB COMPL DONE AT LAST JMP R1 BACK FOR MORE WORK SKP ************************************************** * * * WRITE SECTION * * * ************************************************** SPC 2 **** **** * *** PART -1: HANDLE POWER-FAIL AND SEVERE ERROR *** * **** **** WSER EQU * SEVERE ERROR RECOVERY LDA FBITS,I REQUEST ON AND WPB WRITE SZA,RSS PROCESS? JMP W1C NO JSB COMPL YES, DUMP IT LDA #SERR WITH NASTY JSB STAT ERROR W1C JSB SUSP WAIT FOR A NEW COMMAND LDA FBITS,I DID A CONFIGURATION AND WPB COMMAND SZA,RSS ARRIVE? JMP W1C NO, WAIT SOME MORE LDA FBITS,I CLEAR SICK CARD AND SERCN AND AUTOMATIC RECONNECT STA FBITS,I FLAGS WFPR EQU * FRONT PANEL RECOVERY JSB LOCK RESERVE BACKPLANE  LDA !RSET RESET JSB OTCM$ CARD JSB WFLG$ WAIT FOR HIM TO RECOVER RSS WPFL EQU * POWER FAIL RECOVERY JSB LOCK KEEP THINGS FOR OURSELVES LDA !PWUP TELL CARD THAT JSB OTCM$ WE UNDERSTAND JSB WCOM$ HIS TROUBLES RSS SPC 1 **** **** * *** PART 0: HANDLE STARTUP OF CARD *** * **** **** WINI JSB LOCK LOCK THINGS UP CLA SAY NO BUFFERS STA WBUFS,I READY LDA FMISC,I SET WRITE TYPE IOR TWB UNDEFINED AND CINB AND NO CONNECT STA FMISC,I INDICATION NEEDED LDA FBITS,I AUTOMATIC AND RCB RECONNECTION? SZA,RSS JMP W1D NO, DON'T BOTHER LDA !CNCT TELL CARD JSB OTCM$ TO CONNECT JSB WCOM$ ONCE MORE LDA FBITS,I SET IOR ACB ASKED TO CONNECT STA FBITS,I FLAG W1D LDA !TIME TELL JSB OTCM$ CARD JSB WFLG$ THAT TIMEOUT IS COMING JSB DVTST GET OUR LDA $DV13,I TIMEOUT VALUE CMA,INA AS A POSITIVE QUANTITY OTA CDATA,C TELL CARD JSB WCOM$ ABOUT IT JSB UNLK$ GIVE BACK BACKPLANE **** **** * *** PART 1: WAIT FOR SOMETHING TO DO *** * **** **** W1 LDA FBITS,I IS A REQUEST PENDING AND WPB FOR THE WRITE PROCESS SZA TO EXECUTE? JMP W1A YES, GO DO OUR THING JSB SUSP NO, WAIT FOR SOMETHING TO HAPPEN JMP W1 W1A CLA SET GOOD JSB STAT STATUS LDA FBITS,I CLEAR WRITE ABORT BIT AND WANB IN CASE IT WAS STA FBITS,I SET FROM BEFORE JSB LOCK WE ARE GOING TO NEED THE BACKPLANE JSB CMDAT GET COCMMAND JMP W3D ABORTED LDB TEMP1 TYPE CCE,SSB SPECIAL COMMAND? JMP W3 YES, GO TO PART 3 CPB .3 SEND BREAK MESSAGE? JMP W3C YES, DO THAT SPC 1 **** **** * *** PART 2: SEND WRITE DATA *** * **** **** * * SET MESSAGE TYPE * W2 LDA FMISC,I GET CARD'S ALF,RAR CURRENT AND .7+TW-TW OUTPUT TYPE CPA TEMP1 MATCH? JMP W2A YES, WE CAN SAVE SOME WORK LDA FMISC,I NO, SET TW ALF,RAR TO NEW RRR 3+TW-TW MESSAGE TYPE STA FMISC,I LDA TEMP1 GET BACK MESSAGE TYPE ADA !NMT MAKE COMMAND TO TELL CARD JSB OTCM$ TELL IT JSB WCOM$ WAIT FOR IT TO FINISH JSB CMDAT RESTORE COMMAND INFORMATION JMP W3D COMMAND ABORTED * * GET MESSAGE PARAMETERS * W2A LDA TEMP2 GET POINTER TO START OF BUFFERS LDB TEMP1 SET SIGN BIT CCE,SZB,RSS IF MESSAGE TYPE RAL,ERA IS DS STA WPTR,I SAVE POINTER LDA TEMP3 GET LENGTH OF FIRST BUFFER ADA TEMP4 ADD LENGTH OF SECOND BUFFER STA WLEN,I SAVE NUMBER OF WORDS TO WRITE * * TRANSFER EACH FRAME * W2B LDA WLEN,I MORE DATA TO CCE,SZA,RSS WRITE OUT? JMP W3D NO, ALL DONE * * WAIT FOR BUFFER TO BE READY OR ERROR CONDITION * THE BACKPLANE IS LOCKED IFF E IS SET * W2C LDA FBITS,I WRITE REQUEST ABORTED AND WALCB OR LINE LOGICALLY CPA LCB DISCONNECTED? JMP W2C0 NO, SO FAR SO GOOD SEZ GIVE BACK BACKPLANE JSB UNLK$ IF WE HAVE IT LDA #LFAL LINE FAILURE STATUS JMP W2C5 REPORT W2C0 LDA WBUFS,I HAVE WE ASKED SSA FOR A OUTPUT BUFFER? JMP W2C2 YES, WAIT SOME MORE SEZ,RSS NO, GRAB BACKPLANE JSB LOCK IF WE DON'T HAVE IT LDA WBUFS,I SEE HOW MANY BUFFERS WE HAVE SZA ARE THERE ANY? JMP W2C1 YES, FILL ONE UP CLB NO, COMPUTE LDA WLEN,I HOW MANY BUFFERS DIV WFSIZ,I WE WILL NEED AND B77 ADA !OTBF ASK JSB OTCM$ FOR JSB WCOM$ BUFFERS W2C1 ADA M1 GET HOW MANY STA WBUFS,I MINUS ONE CCE,SSA,RSS DID WE GET ANY? JMP W2D YES, FILL ONE UP LDA M60 SET TIMEOUT STA WBUFS,I LIMIT W2C2 SEZ GIVE BACK BACKPLANE JSB UNLK$ IF WE HAVE IT LDA WBUFS,I IS TIME INA,SZA,RSS UP? JMP W2C3 YES, ERROR LDB TGONE NO, DID TIMEOUT SZB OCCUR? STA WBUFS,I YES, COUNT IT LDA FBITS,I ASK FOR IOR MTB MEDIUM STA FBITS,I TIMEOUT JSB SUSP WAIT FOR SOMETHING CLE SAY WE DON'T OWN THE BACKPLANE JMP W2C SEE WHAT WE GOT W2C3 LDA #RBUS REMOTE BUSY W2C5 JSB STAT STATUS JSB COMPL JMP W1 WAIT FOR A NEW REQUEST * * SEND OUTPUT TRANSFER COMMAND * W2D LDA WLEN,I GET LENGTH CPA WFSIZ,I LAST FRAME CANNOT BE FULL SIZE ADA M1 SO WE CAN DETECT DUPLICATE FRAMES LDB WPTR,I ADD TWO WORDS TO LENGTH SSB IF LENGTH WORDS MUST BE ADA .2 WRITTEN OUT LDB WFSIZ,I IS LENGTH CMB GREATER THAN ADB A MAXIMUM FRAME SSB,RSS SIZE? LDA WFSIZ,I YES, USE MAX FRAME SIZE ADA !OTTR MAKE OUTPUT TRANSFER COMMAND LDB WPTR,I IS THIS FRAME SSB START OF DS 1 MESSAGE? ADA !SMB YES, SET START OF MESSAGE BIT STA TEMP6 SAVE COMMAND * * START UP DMA * W2E LDA TRIPL SET POINTER STA TEMP5 TO TRIPLE AREA LDA WPTR,I DO WE HAVE TO SEND SSA,RSS LENGTH WORDS? JMP W2E1 NO ELA,CLE,ERA YES, BUT WE WON'T STA WPTR,I ANY MORE JSB CMDAT GET OUR DVT SET UP JMP W3D NOT THERE ANY MORE LDA TEMP4 PUT LENGTHS IN DVT STA $DV18,I WHERE THEY WILL BE SAFE LDA TEMP3 WHILE DMA IS STA $DV17,I RUNNING LDA $DV17 SET ADDRESS STA TEMP1 OF LENGTH WORDS LDA M2 MUST WRITE STA TEMP2 TWO LENGTH WORDS LDA BIT15 SET UP JSB TRPL$ TRIPLE LDA WFSIZ,I MAX DMA TRANSFER NOW ADA M2 IS TWO LESS THAN JMP W2E2 MAX FRAME SIZE W2E1 LDA WFSIZ,I GET MAX DMA TRANSFER CPA WLEN,I LAST FRAME CANNOT BE FULL SIZE ADA M1 SO WE CAN DETECT DUPLICATE FRAMES W2E2 LDB WLEN,I BIGGER CMB THAN ADB A WORDS TO SSB,RSS WRITE? LDA WLEN,I YES, USE WORDS TO WRITE LDB WPTR,I SET DMA STB TEMP1 STARTING ADDRESS ADB A ADJUST BUFFER STB WPTR,I POINTER CMA,INA SET DMA STA TEMP2 WORD COUNT ADA WLEN,I UPDATE NUMBER OF WORDS STA WLEN,I THAT MUST BE TRANSFERRED LDA B400 USE AUTO LDB TRIPL MODE IF CPB TEMP5 SECOND CLA TRIPLE JSB DMA$ SET UP TRIPLE AND START DMA * * WAIT FOR DMA TO FINISH OR ABORT, HANDLE IT * W2F JSB WTRN$ WAIT FOR DONE JMP W2B SEE IF THERE IS MORE TO SEND SPC 1 **** **** * *** PART 3: PROCESS CONTROL COMMANDS *** * **** **** W3 ERB,RBR GET LAST THREE BITS OF FUNCTION CODE CMB,CME,SZB WAS COMMAND 30 OR 31? JMP W3B NO * * PROCESS INITIALIZE LINK * SEZ REALLYy INITIALIZE LINK? JMP W3A NO, MUST BE CLEAR LINK LDA #ILRQ GET POSSIBLE ERROR LDB $DV4,I GET POINTER ELB,CLE,ERB TO OTHER DVT CMB,INB IS THIS ADB $DV1 THE FIRST SSB,RSS DVT? JMP W3F NO, REJECT LDA TEMP2 GET AND LUB THE LU LDB ACB RECONNECT ALLOWED CPA TEMP2 ONLY FOR TYPE 0 ADB RCB CONNECT XOR FMISC,I PUT LU AND LUB WHERE WE XOR FMISC,I CAN GET IT STA FMISC,I LATER LDA FBITS,I CLEAR FUNNY FLAGS AND M3NB ADD ASKED TO CONNECT, IOR B AND RECONNECT IF NECESSARY STA FBITS,I SAVE FLAGS LDA TEMP2 GET ALF,ALF CONNECT AND B377 TYPE IOR !CNCT TELL JSB OTCM$ CARD JSB WCOM$ TO CONNECT LDB A SAVE RESPONSE LDA #NOIN GET POSSIBLE ERROR SZB CONNECT OK? JMP W3F NO, COMPLAIN LDA !MIFL ASK CARD JSB OTCM$ WHAT THE LARGEST JSB WCOM$ BUFFER SIZE IS STA WFSIZ,I SAVE ANSWER JSB UNLK$ RELEASE BACKPLANE JSB COMPL COMPLETE JSB LOCK GET BACK BACKPLANE JMP W1D UPDATE CARD'S TIMEOUT * * PROCESS CLEAR LINK * W3A LDA FBITS,I SAY AND XCNB NOT ASKED TO CONNECT STA FBITS,I NOT CONNECTED, AND NO RECONNECT LDA !DSCN TELL CARD JSB OTCM$ TO HANG UP JSB WCOM$ HEAR ME, OH CARD JMP W3D COMPLETE * * PROCESS SET/CLEAR MODE COMMANDS * W3B SSB,SLB REALLY SET/CLEAR MODE COMMAND? JMP W3E NO, MUST BE READ/WRITE FUNNY STUFF LDA NDB GET APPROPRIATE BIT SLB FOR THIS LDA FWB COMMAND XOR FBITS,I GET THE REST OF THE BITS SEZ,RSS CLEAR BIT? AND FBITS,I YES SEZ SET BIT? IOR FBITS,I YES STA FBITS,I SAVE NEW BITS JSB CIBCK SEE IF WE MUST ANNOUNCE NEW STATE JMP W3D * * PROCESS SEND BREAK * W3C LDA !BRK GET STOMP ON NEIGHBOR COMMAND JSB OTCM$ TELL CARD JSB WCOM$ TO SEND BREAK SZA,RSS DID THINGS GO WELL? JMP W3D YES LDA #LFAL NO, TELL W3F JSB STAT PROBLEMS W3D JSB UNLK$ JSB COMPL REQUEST COMPLETION JMP W1 BACK TO MAIN LOOP * * READ OR WRITE CONFIGURATION DATA * W3E LDA TEMP4 GET AND B377 DATA TYPE SZA,RSS DEFAULT TYPE INA IS ONE IOR !SIDT TELL CARD JSB OTCM$ ABOUT TYPE JSB WFLG$ OF DATA JSB CMDAT GET BACK INFO JMP W3G REQUEST ABORTED, BACK OFF LDA TRIPL SET POINTER STA TEMP5 TO TRIPLE AREA LDA TEMP3 GET BUFFER LENGTH LDB TEMP1 INPUT CMB,CCE,SLB OR OUTPUT RAL,ERA TRANSFER STA TEMP6 PUT IT WHERE DMA$ LOOKS LDA TEMP2 SET ADDRESS CCE,SLB,RSS WITH RAL,ERA DIRECTION STA TEMP1 BIT LDA TEMP3 SET LENGTH CMA,INA NEGATIVE STA TEMP2 FOR DMA CLA STANDARD CONTROL WORD JSB DMA$ START DMA JSB WTRN$ WAIT FOR COMPLETION JMP W3D COMPLETE W3G LDA !SIDT SET CARD BACK JSB OTCM$ TO ORDINARY JSB WCOM$ DATA TRANSFER JMP W3D SKP ************************************************** * * * BACKPLANE SECTION * * * ************************************************** SPC 2 * * REQUEST COMPLETION RETURN * COMPL NOP LDA ACTIV+WA-WA  AND FBITS,I IS THE ABORT BIT OF THE SZA,RSS ACTIVE PROCESS SET? JMP COMP1 NO XOR FBITS,I YES, CLEAR IT AND RETURN, STA FBITS,I A COMPLETION RETURN HAS ALREADY JMP COMPL,I BEEN REQUESTED COMP1 LDA SRVOK DO WE WANT WHAT CPA ACTIV WE CAN'T HAVE CLA OR HAS A IOR SSERV SYSTEM SERVICE SZA,RSS ALREADY BEEN REQUESTED? JMP COMP2 NO ISZ RENTR YES, REQUEST DRIVER REENTRY LDB COMPL SUSPEND THIS JMP SUSPB PROCESS COMP2 LDA ACTIV SET UP THE CMA SERVICE STA SSERV WORD RAL,RAL CLEAR THE PROPER AND FBITS+WP-WP,I REQUEST PENDING STA FBITS,I BIT JMP COMPL,I SPC 1 * * LOCK THE BACKPLANE * LOCK NOP LDB LOCK GET RETURN ADDRESS JSB BSYCK CAN WE HAVE THE BACKPLANE? JMP SUSPB NO, GO WAIT FOR IT LDA ACTIV+WL-WL ALF SET THE BACKPLANE IOR FBITS,I LOCKED TO OUR STA FBITS,I PROCESS JMP LOCK,I TELL OUR GOOD NEWS SPC 1 * * UNLOCK THE BACKPLANE * UNLK$ NOP LDA ACTIV+WL-WL CLEAR THE ALF CORRECT XOR FBITS,I BACKPLANE LOCK STA FBITS,I FLAG CCA MAKE SURE THE NEXT PROCESS STA ADV IS ACTIVATED WHEN WE SUSPEND JMP UNLK$,I SPC 1 * * WAIT FOR DMA TRANSFER TO FINISH OR BE ABORTED * IF ABORTED, STOP DMA, TELL CARD, AND RETURN TO R1 OR W1 * WTRN$ NOP LDA FBITS+WA-WA,I AND ACTIV HAS THIS TRANSFER SZA BEEN ABORTED? JMP WTRN1 YES, TUBE IT LDB WTRN$ NO, GET SUSPEND ADDRESS SFS CDMA0 DMA FINISH? JMP SUSPB NO, WAIT CLF CDMA0 YES, STOP FURTHER INTERRUPTS JMP WTRN$,I RETURN WTRN1 CLC CDMA1 STOP DMA LDA !ABDM GET XABORT DMA COMMAND OTA CDATA,C SEND IT WTRN2 LDA MTB ASK FOR IOR FBITS,I HALF SECOND STA FBITS,I TIMEOUT JSB WAIT HAS THE CARD SET THE FLAG? RSS NO JMP WTRN3 YES JSB SUSP WAIT FOR CARD'S DMA TO DO SOMETHING LDA TGONE TIMEOUT? SZA,RSS IF YES, THEN DMA MUST HAVE FINISHED JMP WTRN2 NO, KEEP WAITING WTRN3 STC CDATA,C INDICATE COMMAND TO CARD JSB WFLG$ WAIT FOR HIM TO FINISH JSB UNLK$ RELEASE BACKPLANE LDA ACTIV RETURN TO CPA .2 THE CORRECT JMP W1 PROCESS CLB FIXING RDSIZ STB RDSIZ,I IF FROM JMP R1 READ PROCESS SPC 1 * * OUTPUT A COMMAND TO THE CARD * OTCM$ NOP OTA CDATA SEND THE COMMAND STC CDATA,C TELL THE CARD IT IS A COMMAND JMP OTCM$,I SPC 1 * * SET UP A DMA TRIPLE * TEMP5 => LOCATION TO STORE TRIPLE * TEMP1 = DATA ADDRESS WITH SIGN SET FOR READ * TEMP2 = NEGATIVE TRANSFER LENGTH * A = CONTROL WORD 1 WITHOUT IN BIT * TRPL$ NOP LDB TEMP1 GET DATA ADDRESS RBL,CLE,SLB,ERB CLEAR ADDRESS SIGN ADA B200 SET 'IN' IF READ DESIRED STA TEMP5,I SET CONT 1 ISZ TEMP5 SET STB TEMP5,I CONT 2 ISZ TEMP5 LDA TEMP2 SET STA TEMP5,I CONT 3 ISZ TEMP5 ADVANCE POINTER FOR NEXT TRIPLE JMP TRPL$,I SPC 1 * * SET UP TRIPLE, START DMA, DO COMMAND IN TEMP6 * DMA$ NOP JSB TRPL$ SET UP A TRIPLE LDA ACTIV REQUEST ON AND FBITS+WA-WA,I CURRENT PROCESS SZA ABORTED? JMP DMA1 YES, JUST DO COMMAND LDA TRIPL SET SELF CONFIGURATION OTA CDMA0 ADDRESS STC CDMA0,C START SELF CONFIGURATION DMA1 LDA TEMP6 TELL CARD JSB OTCM$ TO DO COMMAND J JMP DMA$,I SPC 1 * * WAIT FOR FLAG FROM CARD * WFLG$ NOP LDB WFLG$ GET RETURN ADDRESS JSB WAIT FLAG SET? JMP SUSPB NO, SUSPEND JMP WFLG$,I YES, RETURN SPC 1 * * WAIT FOR RESPONSE TO COMMAND, MAKE SURE RESPONSE * IS GOOD, RETURN RESPONSE IN A * WCOM$ NOP LDB WCOM$ GET RETURN ADDRESS JSB WAIT FLAG SET? JMP SUSPB NO, SUSPEND LIA CDATA YES, GET ANSWER SSA FAILURE BIT SET? JMP SICK YES, MUST BE POWERFAIL OR WORSE JMP WCOM$,I NO, MUST BE OK SPC 1 * * WAIT A SHORT TIME FOR FLAG * SKIP RETURN IF FLAG IS SET, B IS UNCHANGED * WAIT NOP LDA M20 GET SHORT TIME COUNTER WAIT1 INA,SZA,RSS TIME UP? JMP WAIT,I YES, THAT'S ALL SFS CDATA NO, FLAG SET? JMP WAIT1 NO, WAIT SOME MORE ISZ WAIT YES, SAY FLAG SET JMP WAIT,I RETURN SPC 1 * * CHECK FOR BACKPLANE NO LONGER BUSY * SKIP RETURN IF SO, B IS UNCHANGED * BSYCK NOP LDA FBITS,I GET LOCK AND WLRLB FLAGS SZA,RSS ANY LOCK? JMP BSYC2 NO, SAY SO CPA WLRLB YES, LOCKED TO BACKPLANE? BSYC1 JSB WAIT YES, HAS CARD RESPONDED? JMP BSYCK,I NO, STILL LOCKED UP CLF CDATA ALLOW ANOTHER INTERRUPT LIA CDATA GET CARD'S RESPONSE SSA POWER FAIL? JMP SICK YES, GET HIM BACK ON HIS FEET SZA AN ACKNOWLEDGMENT? JMP BSYC1 NO, GIVE HIM ANOTHER CHANCE LDA FBITS,I YES, CLEAR XOR WLRLB LOCK STA FBITS,I FLAGS BSYC2 ISZ BSYCK SAY NOT BUSY JMP BSYCK,I RETURN TO POINT OF ORIGIN SPC 1 * * SUSPEND ACTIVE PROCESS, ACTIVATE OTHER ONE OR SET UP * BACKPLANE FOR DRIVER EXIT AND EXIT * SUSP NOP LDB SUSP RETURN ADDRESS IS RSS PROCESS CONTINUATION ADDRESS SUSP B ADB M1 ALTERNATE ENTRY, B IS ADDRESS + 1 LDA ACTIV SAVE CPA .1 RESTART STB RCONT,I ADDRESS CPA .2 IN CORRECT STB WCONT,I WORD ISZ ADV SHOULD WE ACTIVATE OTHER PROCESS? JMP SUSP1 NO, PREPARE BACKPLANE TO EXIT XOR .3 YES, ADJUST SUSP3 STA ACTIV ACTIVE PROCESS INDICATOR ADA RCNTA JUMP TO LDB A,I NEW JMP B,I PROCESS SUSP1 LDA FBITS,I IS AND WLRLB BACKPLANE SZA LOCKED? JMP SUSP4 YES, KEEP OUR HANDS OFF LDA !UNST GET UNSOLICITED STATUS INPUT COMMAND LDB RENTR DRIVER REENTRY SZB,RSS REQUESTED? JMP SUSP2 NO LDA FBITS,I YES, SET BACKPLANE IOR WLRLB BUSY FLAGS IOR LTB AND REQUEST STA FBITS,I TIMEOUT LDA !NOOP GET NO-OP COMMAND SUSP2 JSB OTCM$ SEND OUR PARTING COMMAND JMP EXIT RETURN TO THE SYSTEM SUSP4 LDA FBITS,I BACKPLANE LOCKED, IOR LTB REQUEST STA FBITS,I LONG TIMEOUT JMP EXIT SPC 1 * * PROCESS DRIVER ENTRY FROM CARD INTERRUPT * CONTN LIA CFPFG HAS THE FRONT PANEL SZA USED OUR CARD? JMP RSTRT YES, RESET JSB BSYCK BACKPLANE LOCKED? JMP GO YES, NONE OF OUR BUSINESS LIA CDATA GET CARD'S RESPONSE SSA FAILURE? JMP SICK YES, MUST BE POWERFAIL OR WORSE LDB A SAVE INPUT RBL,RBL SCRAMBLE SOME BITS SLB,RSS UNSOLICITED INPUT? JMP GO NO, MUST HAVE BEEN A NO-OP RBL,SLB,RBL YES, INCOMMING FRAGMENT? JMP CONT1 YES RBL,SLB NO, NEW MESSAGE TYPE? JMP CONT2 YES RBL,SLB,BLF NO, OUTPUT BUFFER READY? JMP CONT3 YES LDA FBITS,I NO, STATUS CHANGE, GET FLAGS RBL,RBL RBL,SLB 42 DISCONNECT, TRYING TO RECONNECT? AND LCNB YES, RECORD IT RBL,SLB COMPLETE DISCONNECT? AND XCNB YES, RECORD IT RBL,SLB CONNECT? IOR LCB YES, RECORD CONNECT STA FBITS,I SAVE NEW STATUS JSB CIBCK TELL HIGHER UPS IF NECESSARY JMP CONT4 CONT1 AND B7777 SET STA RDSIZ,I FRAGMENT SIZE LDA FBITS,I RECORD IOR SMB START OF SLB,RSS MESSAGE XOR SMB BIT STA FBITS,I VALUE JMP CONT4 CONT2 RRL 10+TR-TR MOVE TYPE TO PROPER FIELD XOR FMISC,I PUT IT IN AND TRB THE REST OF XOR FMISC,I THE WORD STA FMISC,I SAVE NEW TYPE JMP CONT4 CONT3 AND B77 GET NUMBER OF BUFFERS LDB WBUFS,I GET OLD NUMBER OF BUFFERS STA WBUFS,I SAVE NEW NUMBER OF BUFFERS LDA FBITS,I GET FLAGS IN CASE CPB M1 HAD WE GIVEN UP ON GETTING A BUFFER? JSB CIBCK YES, TELL RE-ROUTING THE GOOD NEWS CONT4 JMP GO START THINGS UP SPC 1 * * SET FLAG TO SEND INDICATION OF LINE UP TO HIGHER UPS * IF THE LINE IS NOW READY FOR DS/1000 TRAFFIC * ON ENTRY A MUST EQUAL FBITS,I * CIBCK NOP AND M4B ISOLATE RC, LC, FW, ND LDB A SAVE THEM LDA WBUFS,I HAVE WE GIVEN UP CPA M1 ON GETTING A BUFFER? CLB YES, THEN WE ARE NOT READY LDA FMISC,I GET THE INFO AND FMNB SAY NO FRONT PANEL MESSAGE CPB LCRCB READY FOR DS/1000 TRAFFIC? IOR CIB YES, SET FLAG STA FMISC,I PUT IT ALL BACK JMP CIBCK,I FIN SPC 1 * * PROCESS DRIVER ENTRY NOT FROM CARD INTERRUPT * PFAIL LDA .3 SAY NO SYSTEM SERVICE STA SRVOK AVAILABLE INIT LDA FBITS,I AND WLRLB BACKPLANE SZA LOCKED? JMP GO YES, NONE OF OUR BUSINESS LDA !UNDS NO, GET \DISABLE UNSOLICITED INPUT JSB OTCM$ SEND CANCEL COMMAND LDA FBITS,I INDICATE IOR WLRLB BACKPLANE STA FBITS,I BUSY SPC 1 * * START UP WRITE PROCESS * GO LDA FBITS,I CLEAR AND XTNB TIMEOUT STA FBITS,I REQUEST BITS CCA TELL SUSP TO ACTIVATE READ PROCESS STA ADV WHEN WRITE PROCESS SUSPENDS LDA .2 START UP WITH JMP SUSP3 WRITE (RIGHT) PROCESS SPC 1 * * HANDLE UNEXPECTED TIMEOUT * SICK EQU * LIA CDATA GET WHAT THE CARD HAS TO SAY LDB WPFLA GET POWERFAIL RECOVERY ADDRESS CPA !STGD RECOVERY FROM POWER-FAIL? CLA,RSS YES CPA !STG2 OTHER GOOD STATUS? RSTR1 CLA,RSS YES LDA SEB NO, THE CARD IS SICK SZA IF SICK, MUST USE LDB WSERA SEVERE ERROR RECOVERY ADDRESS IOR FBITS,I BESTOW THE BUSTED BOARD BIT IF SICK AND PWUPB AND SAVE SE, WP, RP, AND RC STA FBITS,I SAVE NEW BITS STB WCONT,I SET WRITE RECOVERY ADDRESS LDA RSERA SET READ STA RCONT,I RECOVERY ADDRESS CLC CDMA1 SUSPEND DMA CLC CDMA3 STOP DMA COLD JMP GO SPC 1 * * RESET CARD AFTER FRONT PANEL HAS USED IT * RSTRT CLA CLEAR 'BEEN IN OTA CFPFG FRONT PANEL' FLAG LDB WFPRA GET FRONT PANEL RECOVERY ADDRESS JMP RSTR1 ENTER RECOVERY CODE SPC 3 BSS 0 FIND HOW MUCH SPACE WE TAKE END ^* A!c 91750-18127 2013 S C0122 &IDADL              H0101 rxASMB,Q,C HED IDADL: 91750-1X127 REV 2013 (C) HEWLETT-PACKARD CO. 1980 NAM IDADL,8 91750-1X127 REV 2013 791119 L * SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: IDADL * SOURCE: 91750-18127 * RELOC: 91750-1X127 * PGMR: DAN GIBBONS * *************************************************************** SPC 2 ENT #IDAD EXT $IDSZ,$IDA * * THIS SUBROUTINE ACCEPTS AN RTE-L FILE DIRECTORY OPEN- * FLAG (CONTAINING EXCLUSIVE OPEN FLAG IN BIT 15 AND IDSEG * # IN RIGHT BYTE) IN THE A-REG, AND CONVERTS IT TO THE * FORMAT USED BY M & PRE-RTE4B SYSTEMS (BIT 15 UNCHANGED, * BITS 0-14 = IDSEG ADDRESS). * * * CALLING SEQUENCE: * * = L-TYPE OPEN FLAG * JSB #IDAD * RETURN--=M/RTE4B-TYPE OPEN FLAG, DESTROYED * SKP #IDAD NOP =L-TYPE OPEN FLAG STA TEMP SAVE IT AND RTBYT ISOLATE IDSEG # SZA,RSS ANY IDSEG #? JMP #IDAD,I NO, RETURN WITH =0 ADA M1 MPY $IDSZ =(IDSEG#-1)(IDSEG SIZE) ADA $IDA ADD STARTING ADR OF IDSEGS LDB TEMP RETRIEVE ORIGINAL OPEN FLAG ELB =EXCLUSIVE OPEN BIT RAL,ERA SET IT INTO BIT 15 JMP #IDAD,I RETURN. =ALTERNATE TYPE OPEN FLAG SPC 3 TEMP NOP RTBYT OCT 377 M1 DEC -1 END 3   BI 91750-18128 2013 S C0122 &IDADM              H0101 syASMB,C,Q HED IDADM: 91750-1X128 REV 2013 (C) HEWLETT-PACKARD CO. 1980 NAM IDADM,8 91750-1X128 REV 2013 791119 M * SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: IDADM * SOURCE: 91750-18128 * RELOC: 91750-1X128 * PGMR: DAN GIBBONS * *************************************************************** SPC 2 ENT #IDAD * * THIS IS A DUMMY SUBROUTINE TO BE ATTACHED TO DLIST IN * AN M ENVIRONMENT. * * #IDAD RPL 0 REPLACE "JSB #IDAD" WITH "NOP" END &T CI 91750-18129 2013 S C0122 &INCNV              H0101 ASMB,R,Q,C HED INCNV 91750-16129 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM INCNV,19,20 91750-16129 REV.2013 791219 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT INCNV * EXT EXEC,DTACH,#GETR,#GRPM,#CVBF,#INCV,.MVW EXT $CVT1,CNUMD,REIO,#NODE,#OTCV,#ICV0,#LEVL EXT $TIME,#QCLM,#NRVS * SUP * ************************ * NAME: INCNV * * * SOURCE: 91750-18129 * THIS VERSION RUNS IN * * RELOC: 91750-16129 * MESSAGE FORMAT * * PGMR: JIM HARTSELL * LEVEL 1 NODES * * * * * ************************ * * * INCNV IS AN INCOMING-MESSAGE CONVERTER THAT CONVERTS MESSAGES FROM * A LOWER UPGRADE LEVEL "UP" TO THE LEVEL AT WHICH THE LOCAL NODE * OPERATES. THE LOCAL UPGRADE LEVEL IS INDICATED BY #LEVL (IN RES). * THE INCOMING FORMAT LEVEL, IF BIT 12 IN THE STREAM WORD IS SET, IS * IN THE HEADER AT OFFSET +4 (OTHERWISE ZERO). A GIVEN VERSION OF * INCNV CAN ONLY CONVERT UP TO THE "LEVEL" OF THE NODE IN WHICH IT RUNS. * ALL VERSIONS OF INCNV CAN CONVERT UP FROM LEVEL 0. * * FOR EXAMPLE: A NODE WHICH OPERATES AT UPGRADE LEVEL 0 ONLY KNOWS * HOW TO BUILD MESSAGES FOR LEVEL 0 FORMAT. IT DOESN'T KNOW ANYTHING * ABOUT HIGHER LEVEL FORMATS. WHEN THE MESSAGE IS RECEIVED BY A HIGHER * LEVEL NODE, THE INCNV MODULE AT THAT NODE WILL CONVERT UP TO THE * HIGHER LEVEL. * * TO EXTEND INCNV FOR THE NEXTƨ UPGRADE LEVEL, * * 1. SET MAX, ADD, HDR EQUATES FOR NEW LEVEL. * 2. REPLACE GLOBAL EQUATE BLOCK WITH NEW FORMAT DEFINITIONS. * 3. ADD ENTRY TO FMTBL & TOTBL. * 4. ADD FROMX AND TOX TABLE. * 5. ADD ENTRY TO SPECL (ADD "EXT" IF ROUTINE REQUIRED). * * MAX EQU 31 MAX REQ SIZE FOR ALL OLDER LEVELS. ADD EQU 7 ADDITIONAL SIZE FOR NEWEST LEVEL. HDR EQU 7 MAX HEADER SIZE, ALL OLDER LEVELS. SKP * * THE FOLLOWING GLOBAL EQUATE BLOCK MUST DEFINE MESSAGE HEADER FORMAT * FOR LEVEL OF NODE IN WHICH THIS VERSION OF INCNV IS RUNNING. * * * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEןM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * ******************************************* * * * * * C O N V E R S I O N T A B L E S * * * * * ******************************************* SPC 2 * * WHEN CONVERTING FROM AN OLDER FORMAT TO THE NEXT UPPER LEVEL, THE * FORMAT LEVEL NUMBER OF THE OLDER FORMAT IS USED AS THE OFFSET INTO * BOTH THE "FROM TABLE" (FMTBL) AND THE "TO TABLE" (TOTBL). IN OTHER * WORDS, WHEN THE OLDER FORMAT IS LEVEL 0, THEN OFFSET 0 IN BOTH TABLES * SPECIFIES CONVERSION FROM FORMAT LEVEL 0 (FROM0) TO FORMAT LEVEL 1 (TO1). * SPC 3 FMTBL DEF *+1 DEF FROM0 FROM LEVEL 0. DEF FROM1 FROM LEVEL 1. * . * . * . SPC 5 TOTBL DEF *+1 DEF TO1 TO LEVEL 1. DEF TO2 TO LEVEL 2. * . * . * . SPC 3 * * TABLE OF ENTRY POINTS FOR OPTIONAL EXTERNAL REQUEST-SPECIFIC * CONVERSION ROUTINES. USE SUBROUTINE NAMES OF THE FORM #ICV0, #ICV1,... * IF APPLICABLE FOR THAT LEVEL. IF NO REQUEST-SPECIFIC CONVERSION * IS NEEDED, JUST USE THE DUMMY "NULL". * SPECL DEF *+1 DEF #ICV0 LEVEL 0 TO LEVEL 1 SPECIFICS (EXT). * . * . * . SPC 3 * TABLES CONTINUED NEXT PAGE.... SKP * * THE FOLLOWING TABLES WORK IN PAIRS TO SPECIFY MAPPING FROM ONE FORMAT * LEVEL TO ANOTHER, I.E., FROM0-TO1, FROM1-TO2{, ETC. THE SAME OFFSET IS * USED INTO BOTH TABLES FOR EACH WORD THAT IS TRANSFERRED. * * THE "FROM" HALF SPECIFIES AN OFFSET FOR EVERY WORD TO BE TRANSFERRED TO * THE NEXT LEVEL. THE FIRST AND SECOND WORDS SPECIFY THE SIZE OF THE * HEADER FOR THE REQUEST AND REPLY, RESPECTIVELY. THE THIRD WORD INDICATES * THE # OF *REQUEST* WORDS TO BE MOVED (NEG) TO THE NEXT UPPER FORMAT LEVEL. * * WARNING: THE SIZE OF THE FORMAT LEVEL 0 REQUEST HEADER AT "FROM0" IS * TEMPORARILY MODIFIED BY INCNV FOR PTOP AND DLIST (7 WORD HEADER) * REQUESTS. * * THE "TO" HALF SPECIFIES THE TARGET OFFSET INTO THE NEWER FORMAT WHERE * THE CORRESPONDING WORD FROM THE OLDER FORMAT IS TO BE STORED. THE FIRST * AND SECOND WORDS SPECIFY THE SIZE OF THE HEADER FOR THE REQUEST AND * REPLY, RESPECTIVELY. THE THIRD WORD INDICATES THE # OF *REPLY* WORDS * TO BE MOVED (NEG) TO THE NEXT UPPER FORMAT LEVEL. * SPC 3 FROM0 DEC 4 SIZE OF FORMAT 0 REQUEST HEADER. DEC 7 SIZE OF FORMAT 0 REPLY HEADER. DEC -4 NEG. # WORDS TRANSFERRED IF *REQUEST*. B1 DEC 1 WORD 1 = STREAM WORD. DEC 2 WORD 2 = SEQUENCE #. DEC 3 WORD 3 = SOURCE NODE #. B4 DEC 4 WORD 4 = DEST. NODE #. DEC 5 WORD 5 = EC1. DEC 6 WORD 6 = EC2. B7 DEC 7 WORD 7 = ERROR NODE NUMBER. * FROM1 DEC 0 RESERVED FOR LEVEL 2 CONVERTER. * . * . * . SPC 2 TO1 DEC 13 SIZE OF FORMAT 1 REQUEST HEADER. DEC 13 SIZE OF FORMAT 1 REPLY HEADER. DEC -7 NEG. # WORDS TRANSFERRED IF *REPLY*. DEC 1 WORD 1 = STREAM WORD. DEC 2 WORD 2 = SEQUENCE #. DEC 3 WORD 3 = SOURCE NODE #. DEC 4 WORD 4 = DEST. NODE #. DEC 5 WORD 5 = EC1. DEC 6 WORD 6 = EC2. DEC 7 WORD 7 = ERROR NODE NUMBER. * TO2 DEC 0 RESERVED FOR LYpEVEL 2 CONVERTER. * . * . * . SKP A EQU 0 B EQU 1 * INCNV JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * LDA FROM0 SAVE SIZE OF FORMAT LEVEL 0 STA SAVEF REQUEST HEADER. * * GET A REQUEST TO BE CONVERTED (SHOULD BE ANY FORMAT LEVEL BELOW * THAT OF NODE IN WHICH INCNV IS RUNNING). * INGET LDA RQBA RESET ADDR OF OUTPUT BUFFER. STA RQADR LDA SAVEF RESTORE SIZE OF FORMAT LEVEL 0 STA FROM0 REQUEST HEADER. * CLA CLEAR ERROR FLAGS. STA TEMP STA EFLAG * JSB #GETR GET A REQUEST (AND DATA). DEF *+6 DEF #INCV CLASS # FOR INCNV. RQBA DEF RQB INTERNAL REQUEST BUFFER. DEF C#MAX MAXIMUM REQUEST LENGTH. DEF #CVBF+1 EXTERNAL DATA BUFFER. DEF #CVBF MAXIMUM DATA LENGTH. ISZ TEMP ERROR RETURN. SET FLAG. * STA RQLEN SAVE ACTUAL REQUEST LENGTH. STB DAINL SAVE ACTUAL DATA LENGTH. * JSB EXEC CLEAR BUFFER IN S.A.M. DEF *+5 DEF CLS21 DEF #INCV DEF #CVBF+1 DEF B0 NOP IGNORE ERROR RETURN. * LDA TEMP ERROR ON ORIGINAL "GET"? SZA JMP INGET YES. * LDA #GRPM INITIALIZE TO SEND TO GRPM. STA CLASS * * GET FORMAT LEVEL # OF RECEIVED REQUEST. * GTFMT LDB RQB+#STR FIRST CHECK BIT 12 OF STREAM WORD. STB STMWD SAVE STREAM WORD. BLF CLA SLB,RSS JMP SAVLV BIT 12 NOT SET = LEVEL 0. LDA RQB+#LVL GET "FORMAT LEVEL" WORD. AND B17 ISOLATE BITS 0-3. SAVLV STA CURLV SAVE AS "CURRENT LEVEL". * CMA IF INCOMING LEVEL ADA #LEVL IS EQUAL TO OR GREATER SSA THAN #LEVL, JMP SFAIL THEN SYSTEM FAILURE (GRPM). * LDA STMWD DETERMINE WHETHER REQUEST OR REPLY. - RAL,RAL ISOLATE BIT 14 OF STREAM WORD. AND B1 STA ADJMT 0 = REQUEST, 1 = REPLY. * * CROSS-CHECK LOCAL NRV AGAINST REMOTE NRV: COMPARE LEVEL OF INCOMING * REQUEST/REPLY AGAINST THE LEVEL SPECIFIED IN THE LOCAL NRV FOR THE * SENDING NODE. THEY SHOULD BE THE SAME. IF NOT: FOR REQUEST, SEND * "DS07" REPLY BACK TO GRPM --- FOR REPLY, SEND "DS07" TO QCLM, FLUSH * THE REPLY, AND LET MASTER CALLER TIME OUT ("DS05"). * LDB ADJMT LDA RQB+#SRC IF REQUEST, GET SOURCE NODE. SZB LDA RQB+#DST IF REPLY, GET DESTINATION NODE. STA TARGT * JSB #NRVS GET LEVEL # OF SENDING NODE. DEF *+4 DEF TARGT DEF TEMP DEF LEVEL RETURNED LEVEL NUMBER. JMP NRVER ERROR RETURN. * LDA LEVEL CROSS-CHECK LEVEL NUMBERS. CPA CURLV JMP MHEAD MATCH. OK. * NRVER DLD "DS07 NRV ERROR! STORE "DS07". DST RQB+#EC1 LDA RQB+#ECQ SET QUALIFIER = 2. IOR B40 STA RQB+#ECQ LDA #NODE INDICATE ASCII ERROR CODE. IOR BIT15 STA RQB+#ENO * LDA ADJMT CHECK WHETHER REQ OR REPLY. SZA JMP SQCLM REPLY. "DS07" TO QCLM, "DS05" TO USER. LDA RQB+#STR REQUEST. SET REPLY BIT AND IOR BIT14 SEND TO GRPM. STA RQB+#STR JMP APEND * * IF CONVERTING PTOP OR DLIST REQUEST FROM FORMAT LEVEL 0, MODIFY * THE HEADER SIZE SPECIFICATION AT "FROM0". * MHEAD ADA CURLV COMBINE ADJMT AND CURLV. SZA IF BOTH ARE ZERO, JMP NXLEV LDA STMWD CHECK STREAM WORD OF REQUEST. AND B77 ISOLATE STREAM. CLB SET DEFAULT MOD = NONE. CPA B1 IF DLIST, RSS CPA B4 OR PTOP, LDB B7 SET MOD = 7 WORD HEADER. SZB STB FROM0 STORE NEW SIZE IF REQUIRED. * * BEGIN CONVERSION TO NEXT UPWARD LEVEL. PERFORM REQUEST-SPECIFIC * CONVERSIONS, IF ANY. * NXLEV LDB CU,RLV GET CURRENT LEVEL NUMBER. ADB SPECL ADD TO TABLE OF REQUEST- LDB B,I SPECIFIC ROUTINE STB TEMP LDA RQADR AND GO DO IT. LDB RQLEN JSB TEMP,I JSB ERROR ERROR RETURN. STB RQLEN SAVE POSSIBLY MODIFIED LENGTH. * LDB CURLV FIND "FROM" INDEX TABLE. ADB FMTBL LDB B,I GET POINTER TO REQ HEADER SIZE. STB FPTR ADB ADJMT IF REPLY, BUMP POINTER. STB FSZPT POINTER TO "FROM" HEADER SIZE. LDA B,I GET SIZE OF THE HEADER (POS.). ADA RQADR ADD TO START OF HEADER. STA BODAD ADDRESS OF BODY OF REQUEST. ISZ FPTR ISZ FPTR POINT TO # WORDS TO MOVE (IF REQUEST). * * CLEAR THE TEMPORARY BUFFER. * LDA TMPBF STA TPTR LDB N#HDR CLA CLRTM STA TPTR,I ISZ TPTR INB,SZB JMP CLRTM * * MOVE CURRENT HEADER TO TEMPORARY BUFFER (OLDER FORMAT). * LDA RQADR LDB TMPBF JSB .MVW DEF FSZPT,I NOP * * SET UP POINTERS AND COUNTERS FOR NEWER FORMAT. * LDB CURLV FIND "TO" INDEX TABLE. ADB TOTBL LDB B,I GET POINTER TO REQ HEADER SIZE. STB TPTR ADB ADJMT IF REPLY, BUMP POINTER. STB TSZPT POINTER TO "TO" HEADER SIZE. LDA B,I GET THE SIZE OF THE HEADER. CMA,INA STA TEMP SAVE FOR CLEARING BUFFER. ADA BODAD STA RQADR ADDR OF NEWER HEADER. * LDA FSZPT,I COMPUTE DIFFERENCE IN SIZE CMA,INA FROM OLDER TO NEWER FORMAT. ADA TSZPT,I ADA RQLEN ADD TO CURRENT SIZE. STA RQLEN ISZ TPTR ISZ TPTR POINT TO # WORDS TO MOVE (IF REPLY). * * CLEAR TARGET AREA FOR NEWER FORMAT OF REQUEST. * LDB RQADR CLA CLEAR STA B,I INB ISZ TEMP JMP CLEAR * * CONVERT FROM OLDER FORMAT TO NEXT UPPER LEVEL. * LDA FPTR,I GET # WORDDS TO MOVE FOR REQUEST. LDB ADJMT SZB IF REPLY, LDA TPTR,I GET # WORDS TO MOVE FOR REPLY. STA TEMP ISZ FPTR ISZ TPTR * CONV LDA FPTR,I GET A WORD-INDEX INTO OLDER FORMAT. ADA N1 ADJUST TO ZERO. ADA TMPBF ADDR OF WORD IN OLDER FORMAT REQUEST. LDA A,I CONTENTS OF WORD. LDB TPTR,I GET A WORD-INDEX INTO NEWER FORMAT. ADB N1 ADJUST TO ZERO. ADB RQADR ADDR OF WORD IN NEWER FORMAT REQUEST. STA B,I STORE FROM OLD TO NEW LOCATION. * ISZ FPTR BUMP POINTERS. ISZ TPTR ISZ TEMP INCR. # WORDS TO MOVE. JMP CONV LOOP TILL DONE. * ISZ CURLV BUMP TO NEXT LEVEL UP. * * CHECK IF ANOTHER LEVEL. * LDA CURLV CPA #LEVL REACHED LEVEL # OF THIS NODE? RSS JMP NXLEV NO. KEEP ON CONVERTING. * * CONVERSION FINISHED --- * STORE FORMAT LEVEL NUMBER IN THE MESSAGE (LEVEL IS NOW THE SAME * AS THAT OF NODE IN WHICH INCNV IN RUNNING, THUS INCNV CAN NOW USE * ITS GLOBAL EQUATES TO STORE DIRECTLY INTO THE MESSAGE HEADER). * LDA RQADR,I SET BIT 12 (LEVEL 1 & ABOVE). IOR BIT12 STA RQADR,I * LDB RQADR STORE LEVEL NUMBER. ADB C#LVL LDA B,I AND B7760 IOR CURLV STA B,I * LDA EFLAG IF REQUEST-SPECIFIC ERROR OCCURRED SZA ON THE WAY OF BEING CONVERTED UP, JMP REJCT SEND IT BACK DOWN VIA OTCNV. * LDA DAINL WAS DATA LENGTH TOO LARGE? (NOT CMA,INA CHECKED WHEN RECEIVED BECAUSE GRPM ADA #CVBF WOULD THROW REJECTED LOWER LEVEL SSA,RSS REPLY RIGHT BACK TO INCNV.) JMP APEND NO. * CLA YES. SET ERROR = "DS03". STA DAINL DLD "DS03 DST RQB+#EC1 LDA RQB+#ECQ (QUALIFIER = 1) IOR B20 STA RQB+#ECQ LDA #NODE IOR BIT15 STA RQB+#ENO LDA RQB+#STR CHECK WHETHER REQUEST OR REPLY. RAL SSA JMP APEND REPLY. * RAR IOR BIT14 REQUEST: SET REPLY BIT. STA RQB+#STR * REJCT LDA #OTCV SEND REPLY TO OTCNV TO CONVERT STA CLASS BACK DOWN TO LEVEL OF SOURCE NODE. * * PROCESS THE LOCAL APPENDAGE AREA. * APEND LDA RQLEN CLEAR THE LOCAL APPENDAGE AREA. ADA RQADR STA BODAD LDB C#LSZ CMB,INB CLA CLAP STA BODAD,I ISZ BODAD INB,SZB JMP CLAP * LDB RQLEN ADD NUMBER OF WORDS ADB C#LSZ IN LOCAL APPENDAGE AREA. STB RQLEN * ADB RQADR SET BIT 8 OF LAST WORD ADB N1 OF REQUEST ("LAST LU"). LDA B,I IOR BIT8 STA B,I * * SEND CONVERTED REQUEST BACK TO GRPM OR OTCNV. * JSB EXEC SEND REQUEST BACK TO GRPM. DEF *+8 DEF CLS20 DEF CONWX "Z" BIT & "WRITE" INDICATOR SET. DEF #CVBF+1 ADDRESS OF DATA BUFFER. DEF DAINL DATA LENGTH. RQADR NOP ADDRESS OF NEW REQUEST. DEF RQLEN LENGTH OF NEW REQUEST. DEF CLASS CLASS # OF GRPM OR OTCNV. NOP IGNORE ERROR RETURN. * JMP INGET GO GET NEXT MESSAGE BUFFER. * * ERROR IN REQUEST-SPECIFIC CONVERSION. FORMAT MAY STILL BE AS RECEIVED * FROM GRPM. ERROR REPLY CAN BE ANY LEVEL BELOW THAT OF NODE IN WHICH * INCNV IS RUNNING. SEND TO OTCNV TO CONVERT BACK DOWN. * ERROR NOP CLA,INA FLAG ERROR SO REJECT CAN BE STA EFLAG HANDLED AFTER CONVERSION COMPLETE. JMP ERROR,I * * REPORT ERROR IN NODAL ROUTING VECTOR (NRV). * SFAIL LDA CURLV FORMAT LEVEL # RECEIVED. CCE JSB $CVT1 STA EMSG+7 * LDB RQADR SOURCE NODE NUMBER. ADB C#SRC (RELATIVE POSITION FROM LEVEL TO LDA B,I LEVEL IS NOT SUPPOSED TO CHANGE!) STA TEMP * JSB CNUMD DEF *+3  DEF TEMP DEF EMSG+15 * JSB REIO DISPLAY ON SYS CONSOLE. DEF *+5 DEF ICOD2 DEF B1 DEF EMSG DEF ELEN NOP IGNORE ERROR RETURN. * JMP INGET GO BACK TO GET NEXT REQUEST. * EMSG ASC 18, RECV'D LEVEL XX MSG FROM NODE XXXXX ELEN DEC 18 SKP * * SEND ERROR TO QCLM AND FLUSH THE MESSAGE. * SQCLM LDB RQADR ADB B4 STB TEMP POINT TO WORD 5 OF "QCLM BUFFER". DLD TEMP,I MOVE #EC1 & #EC1 TO "A & B REGISTERS". ISZ TEMP DST TEMP,I ISZ TEMP ISZ TEMP DLD $TIME RECORD TIME OF ERROR. DST TEMP,I * LDA #QCLM GET CLASS NUMBER FOR QCLM. SZA,RSS JMP INGET IF NO QCLM, FORGET MESSAGE. * JSB EXEC MAILBOX WRITE/READ TO QCLM. DEF *+8 DEF CLS20 DEF B0 DEF RQADR,I DEF D12 DEF B1 TYPE 1. DEF B0 DEF #QCLM NOP IGNORE ERROR RETURN. * JMP INGET GO BACK TO GET NEXT MESSAGE. SPC 5 * * DUMMY REQUEST-SPECIFIC CONVERSION SUBROUTINE. * NULL NOP JMP NULL,I SKP * * CONSTANTS AND STORAGE. * B0 OCT 0 B17 OCT 17 B20 OCT 20 B40 OCT 40 B77 OCT 77 D12 DEC 12 N1 DEC -1 ICOD2 OCT 100002 CLS20 OCT 100024 CLS21 OCT 100025 CONWX OCT 10100 BIT8 OCT 400 BIT12 OCT 10000 BIT14 OCT 40000 BIT15 OCT 100000 B7760 OCT 177760 "DS03 ASC 1,DS03 "DS07 ASC 1,DS07 * CLASS NOP CURLV NOP TARGT NOP LEVEL NOP FPTR NOP TPTR NOP BODAD NOP DAINL NOP RQLEN NOP FSZPT NOP TSZPT NOP ADJMT NOP TEMP NOP SAVEF NOP STMWD NOP EFLAG NOP * N#HDR ABS -HDR C#MAX ABS MAX C#LVL ABS #LVL C#SRC ABS #SRC C#LSZ ABS #LSZ * * TEMPORARY BUFFER TO HOLD OLDER FORMAT OF REQUEST. * TMPBF DEF *+1 BSS HDR * * BUFFER FOR CURRENT REQUEST AND HEADER EXPANSION. * BSS ADD ADDITIONAL ROOM FOR REQ EXPANSION. RQB BSS MAX+#LSZ BUFFtB@= S1 * = -32768 TO REQUEST SYSTEM ATTENTION ON LU S1 * * S3 = NODE NUMBER AT WHICH ,LU IN S2 EXISTS. * = 25834 SECURITY CODE IF SYSTEM ATTENTION IS REQUESTED IN P2 * * S4 = IOMAP NODE'S NETWORK SECURITY CODE IF MAP SETUP REQUESTED * THE CODE IN P4 MUST MATCH THAT CODE OR THE MAP SET-UP IS DENIED. SPC 3 * RETURN PARAMETERS FOR THE ABOVE FUNCTIONS: * * R1 = LU FOR WHICH MAP WAS SET UP OR #LMPE IF S1 = -2 * = -1 IF SECURITY CODE IS ILLEGAL * = -2 IF LU IN S1 IS ILLEGAL * = -3 IF NO MAP HAS YET BEEN SET UP OR LU MAPPING IS BOTCHED * P2 = DESTINATION LU TO WHICH MAP IS SENT OR #LMPE+1 IF S1 = -2 * P3 = DESTINATION NODE TO WHICH MAP IS SENT OR #LMPE+2 IF S1 =-2 * * * * EXT RMPAR,EXEC,PRTN,#NODE,XLUEX EXT #SPLU,#LMPE,#NMSC SPC 2 IOMAP EQU * JSB RMPAR FETCH SCHEDULE PARAMETERS DEF *+2 DEF IPRAM * * FIND "RESERVED LU" FOR THIS NODE * IF NONE SET UP YET, SET IT UP NOW. LDA #SPLU IS THERE A "SPECIAL" LU ALREADY SAVED IN SSGA? SZA JMP IO1 YES. LDA MAPLU NO, WERE WE GIVEN SZA A POTENTIALLY SSA MAPPABLE LU? JMP RTER3 NO, CAN'T DO SETUP, TOO BAD IOR BIT15 MAKE DYNAMIC STATUS CALL STA SPCL1 SO THAT DRIVER JSB XLUEX WILL BE ENTERED DEF *+3 AND SET UP DEF D3 "SPECIAL" LU DEF SPCL1 LDA #SPLU WAS "SPECIAL" LU SZA,RSS SET UP? JMP RTER3 NO, BAD TROUBLES IO1 EQU * IOR BIT15 SET "TRUE LU" BIT STA SPCL1 SAVE LU IN DOUBLE WORD STA SPCL2 XLUEX CONWD TEMPLATES LDA MAPLU REQUEST TO SIMPLY RETURN PRESENT CPA M2 CONTENTS OF #LMPE? JMP ERTRN YES. LDA RLU GET REMOTE LU CPA M1 REQUEST TO RETURN I/O MAP INFORMATION? JMP RTMAP YES CPA BIT15 REQUEST SYSTEM ATTENTION? JMP SYSAT YES * SET UP I/Ot MAP LDA SECOD GET SECURITY CODE UNL ALF,ALF CMA LST CPA #NMSC IS IT CORRECT? JMP IO2 YES RTER1 CCB NO, SET ERROR INDICATION JMP RETRN IO2 LDB FNMBR GET SECURITY CODE FOR DRIVER STB BUFFR LDA MAPLU STA BUFFR+1 LDA RLU STA BUFFR+2 LDA NODE STA BUFFR+3 JSB XLUEX ESTABLISH I/O MAP DEF *+5 DEF D2 DEF SPCL1 DEF BUFFR DEF D4 SZB,RSS WAS MAP SET UP? RTER2 LDB M2 NO, ILLEGAL LU * RETRN EQU * STB IPRAM SET RETURN CODE * * PASS RESULTS BACK TO CALLER PRT EQU * JSB PRTN DEF *+2 DEF IPRAM JSB EXEC TERMINATE DEF *+2 DEF D6 * * RETURN LU MAPPING ERROR CODES * ERTRN DLD #LMPE+1 SET SECOND TWO DST IPRAM+1 ERROR WORDS LDB #LMPE GET FIRST ERROR WORD JMP RETRN RETURN IT SPC 10 * * HERE TO REQUEST SYSTEM ATTENTION * SYSAT LDA IPRAM+2 IS THE SYSAT SECURITY CODE CPA FNMBR PRESENT? RSS YES, GO AHEAD JMP RTER1 NO, REJECT THIS JSB XLUEX DEF *+4 DEF D3 DEF SPCL2 DEF MAPLU SYSTEM ATTENTION LU FOR RTE-L JMP PRT RETURN SKP * HERE TO RETURN I/O MAP INFORMATION TO "FATHER" * RTMAP EQU * * RTP1 JSB XLUEX DEF *+6 DEF D1 DEF SPCL1 "RESERVED LU" + 3600B DEF IPRAM+1 RETURN INFORMATION HERE DEF D2 DEF IPRAM LU TO CHECK * LDA IPRAM+1 IS THIS A "MAPPABLE" LU? SSA,RSS JMP RTP2 YES--RETURN MAP INFORMATION ISZ IPRAM NO, TRY NEXT LU LDA IPRAM --BE SURE AND B377 THAT WE DON'T CPA IPRAM GO TOO FAR.... JMP RTP1 .. LU < 256, GO SEE IF IT'S A VALID ONE JMP RTER2 ERROR: ALL LUS HAVE BEEN CHECKED * RTP2 DLD IPRAM+1 PUT THE SWP LU FIELD DST IPRAM+1 FIRST JMP PRT RETURN RESULTS * RTER3 EQU * HERE WHEN LU MAPPING HAS NOT BEEN SET UP YET. LDB M3 RETURN -3 JMP RETRN SPC 2 IPRAM BSS 5 'RMPAR' PARAMETER AREA MAPLU EQU IPRAM "MAPPED" LU RLU EQU IPRAM+1 REMOTE LU NODE EQU IPRAM+2 REMOTE NODE NUMBER SECOD EQU IPRAM+3 SECURITY CODE BUFFR BSS 4 I/O MAPSET-UP BUFFER AREA SPCL1 NOP "SPECIAL LU" + A SUBFUNCTION OCT 3600 MAP SETUP/READ FUNCTION SPCL2 NOP OCT 3500 SYSTEM ATTENTION CONTROL FUNCTION M1 DEC -1 M2 DEC -2 M3 DEC -3 M4 DEC -4 D1 DEC 1 D2 DEC 2 D3 DEC 3 D3N DEF 3,I D13N DEF 13,I I/O STATUS, NO ABORT D4 DEC 4 D6 DEC 6 B377 OCT 377 BIT15 OCT 100000 FNMBR DEC 25834 END IOMAP ! EN 91750-18131 2013 S C0122 &LO..              H0101 a=ASMB,R,L,C HED LO.. SUBROUTINE TO LOAD PROGRAMS FROM A REMOTE NODE * NAME: LO.. * SOURCE: 91750-18131 * RELOC: 91750-1X131 * PGMR: GERRY BELDEN * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 LO..,7 91750-1X131 REV.2013 800316 L * SKP * ENT LO.. * EXT $LIBR,$LIBX,IDSGA,NAM..,$.LOA,.ENTR EXT O.BUF,WRITF,CNUMD EXT $ID#,$IDA EXT $CKSM,IDMEM,.MVW EXT $FWBG,$BGBP,D$OVR EXT #NCNT,SECUR,FINFO EXT DOPEN,DREAD,DCLOS SUP * * * PURPOSE: * TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" REMOTELY IN A * SUBROUTINE. CALL IS STANDARD "L-ACTION ROUTINE" FORMAT. * THE PROGRAM IS LOADED INTO MEMORY AFTER THE ID SEGMENT * IS LOADED. LO.. WILL HANDLE R.T. PROGRAMS OR B.G. BUT * B.G. IS ONLY ALLOWED IF "LOAD/SWAP" IS NOT IN THE SYSTEM. * * WORDS SET BY LO..: * * LONG ID SEGMENT * 7 PRIORITY CHANGED IF 0 TO 99 * 13-15 PROGRAM NAME FROM LOAD FILE NAME * 16 ID BIT ALWAYS LEFT RESET, MR BIT SET * 28 DISC LU LEFT 0 * * * SHORT ID SEGMENT * 7 SEGMENT MAIN'S LOAD FILE BLOCK # FOR SEGLD * 8 SHORT ID SEGMENT'S CHECKSUM (ONE'S COMPLEMENTED) * FOR SEGLD. * SKP DUMMY NOP NAME NOP ER NOP LO.. NOP ENTRY POINT JSB .ENTR DEF DUMMY GET PARAMETERS LDA NAME ADVANCE TO INA THE NAME STA ANAME MOVE THE NAME LDB ER TO THE 2ND INB THROUGH 4TH JSB .MVW RETURN PARAMETERS DEF D3c NOP * LDA ANAME,I AND B77 TEST FOR LU CPA ANAME,I JMP ERR00 ANY LU IS ILLEGAL ! LDA #NCNT IS THIS NODE INITIALIZED ? SZA,RSS YES -- GO OPEN FILE JMP ERR01 NO -- DSPLY MSG & ABORT * CLA,INA TURN ON REMOTE SESSION STA D$OVR OVERIDE FOR FILE ACCESS JSB DOPEN OPEN THE ABS INPUT FILE DEF *+7 DEF DCB DEF IERR ANAME NOP A(FILE NAME) DEF D4 FORCE FILE TO TYPE 1 DEF SECUR SECURITY CODE DEF FINFO CRN & FILE NODE (2 WORDS) LDA IERR ANY ERROR ? SSA JMP ERR50 RFA ERROR SKP * * WORK ON LONG ID * JSB DREAD READ IN SKELETON ID DEF *+6 DEF DCB DEF IERR DEFID DEF IDBUF DEF D34 LENGTH OF ID + 4 EXTRA WORDS DEF LEN * LDA IERR ANY ERROR ? SSA JMP ERR50 RFA ERROR * CLA,CCE CLEAR SUM TOTAL JSB SUM CALCULATE CHECKSUM DEF IDBUF DEC -31 CPA ID+32 EQUAL TO WORD 32 ? CLA,RSS YES JMP ERR12 NO LDA $CKSM GET SYSTEM CHECKWORD CPA ID+31 COMPARE ? RSS JMP ERR12 * * TEST FOR BACKGROUND PROGRAM - IF SO, ONLY LEGAL * TO LOAD IF 'LOAD' & 'SWAP' MODULES NOT IN SYSTEM * AND NO OTHER BG PROGRAM IS LOADED * LDA $FWBG START OF BACKGROUND CMA,INA COMPARE WITH LOW MAIN ADA ID+21 SSA JMP LO..1 REAL TIME SO OK LDA $ID# GET NEGATIVE NUMBER CMA,INA OF ID SEGMENTS STA LPCNT FOR COUNTER LDB $IDA POINT TO LO MAIN ADDRESS ADB D20 OF FIRST ID SEGMENT LO..5 LDA B,I IS THIS CPA $FWBG A BACKGROUND PROGRAM? RSS YES JMP LO..6 NO, NO PROBLEM ADB M8 YES, GET FIRST WORD LDA B,I OF NAM$E SZA NON-ZERO? JMP ERR40 YES, PROGRAM CONFLICT ADB D8 NO, GO BACK TO LOW MAIN ADDRESS LO..6 ADB D30 ADVANCE TO NEXT ID SEGMENT ISZ LPCNT MORE TO DO? JMP LO..5 YES LDA $.LOA 'LOAD MODULE IN SYSTEM' FLAG SZA 0 IS YES JMP LO..2 BACKGROUND OK ! JMP ERR13 ILLEGAL BG LOAD ATTEMPT * * TEST FOR SEGMENTED PROGRAM AND IF SO RAISE HIGH * MAIN TO LIMIT OF REAL-TIME AREA FOR PROGRAM * CONFLICT CHECKS LATER. * LO..1 LDA ID+24 FIND # OF SEGMENTS AND B176K SZA,RSS JMP LO..2 NONE LDA $FWBG YES, CHANGE UPPER LIMIT STA ID+33 LDA $BGBP ALSO OF BASE PAGE STA ID+34 SKP * * SET UP PROGRAM NAME * LO..2 JSB NAM.. CHECK FOR LEGAL NAME DEF *+2 DEF ANAME,I PROGRAM NAME IS FILE NAME SZA NAME OK ? JMP ERR00 NO LDB ANAME GET 1ST 2 CHARS OF NAME LDA B,I STA ID+13 SAVE THEM INB DLD B,I NOW GET THE REST STA ID+14 LDA B LAST CHAR. AND UBYTE CLEAR LOWER BYTE STA ID+15 * * CHECK PRIORITY, SET TO 99 IF 0 * LDA ID+7 GET PRIORITY SZA,RSS TEST FOR ZERO LDA D99 IF SO SET IT TO 99 STA ID+7 * * GO PRIVILEGED TO WRITE THE ID SEGMENT * JSB $LIBR NOP * JSB IDSGA SEARCH FOR DUPLICATE PROGRAM NAMES DEF *+2 DEF ANAME,I SEZ,CME IF NOT FOUND, CLEAR E-REG JMP RTPRG AND CHECK MEMORY BOUNDS LDA M61 SET ERROR STA ER,I CODE DLD DUP IF FOUND, RETURN DUPLICATE ERROR JMP PEXIT WITH E-REG = 1 * * TEST FOR REAL-TIME PROGRAM MEMORY CONFLICT * RTPRG JSB IDMEM TEST FOR REAL-TIME MEMORY BOUNDS DEF *+2 CONFLICTS DEF IDBUF PASS IT THE BUILT UP ID SEGMENT CCE,SZA,RSS IF NO CONFLICT FOUND (OR NOT R.T.) JMP SERCH THEN SEARCH FOR FREE ID SEG. LDB A PUT NAME ADDRESS IN B CLA & FLAG SPECIAL 'REMOVE' MESSAGE JMP PEXIT WITH E-REG = 1 SKP * * SEARCH FOR FREE ID SEGMENT * SERCH JSB IDSGA CALL FOR MATCH OF BLANK NAME DEF *+2 DEF ZERO ARRAY OF THREE ZEROS SEZ,RSS IF FOUND, GO MOVE ID DOWN JMP MOVE LDA M64 SET ERROR STA ER,I CODE DLD NOID OTHERWISE 'NO ID' MESSAGE & EXIT JMP PEXIT E-REG = 1 * * MOVE ID SEGMENT INTO SYSTEM * MOVE STA B SAVE COPY OF ID ADDRESS STB IDSEG SAVE FOR COMPLETION LDA DEFID SET A TO SOURCE (B TO DEST.) JSB .MVW MOVE THE ID SEGMENT DEF D30 NOP CLA,CLE SET UP FOR GOOD RETURN PEXIT JSB $LIBX DONE! DEF *+1 DEF LO..3 * LO..3 SEZ,RSS CHECK FOR AN ERROR JMP LO..4 NONE SZA 'REM' ERROR ? JMP ERR30 ID SEG ERROR JMP ERR40 MEMORY CONFLICT ('REM') SKP * * LOAD BASE PAGE * FIND BLOCK # OF BP, POSITION FILE PTR, LOAD IT * LO..4 LDA D2 SET SECTOR POINTER STA SECTR TO START OF MAIN LDA ID+22 HIGH MAIN STA HMAIN LDB ID+21 LOW MAIN STB LMAIN JSB BUMP GET NEXT BLOCK # LDA SECTR SET UP FILE POSITIONING STA IREC LDA ID+24 LOW BASE PAGE STA LBSPG AND BPMSK (B1777) LDB A LDA ID+25 HIGH BASE PAGE STA HBSPG JSB LODIT LOAD IT ! * * LOAD THE MAIN * LDA D2 BLOCK # OF MAIN STA IREC SET UP FILE POSITIONING LDA HMAIN HIGH MAIN LDB LMAIN LOW MAIN JSB LODIT LOAD IT ! SKP * * SET UP BLOCK NUMBERS OF SEGMENT MAINS & PLACE IN * SHORT IDS * " LDA LBSPG FIND # OF SEGMENTS ALF,ALF RAR,RAR AND B77 SZA,RSS ARE THERE ANY ? JMP DONE SET MR BIT & EXIT CMA,INA NEGATE & SAVE AS LOOP COUNT STA LPCNT LDA LMAIN LOW MAIN ADDRESS (1ST SHORT ID) STA SEGAD SAVE FOR CHECKSUM * * FIND BLOCK # OF 1ST SEGMENT MAIN * LDA LBSPG LOW BP ADDRESS AND BPMSK LDB A LDA HBSPG HIGH BP JSB BUMP SECTR NOW IS BLOCK # OF 1ST * SEGMENT MAIN * * FIX UP SHORT IDS * LOOP LDB SEGAD CURRENT SHORT ID STB SIDAD SAVE FOR CHECKSUM CALL ADB D4 STB TEMP SAVE A(SEG HIGH MAIN) ADB D2 STA B,I SAVE SEG MAIN BLK# (FROM BUMP CALL) INB POINT TO CHECKSUM WORD STB SEGAD CLA JSB SUM DO CHECKSUM SIDAD NOP DEC -7 CMA DS REQUIRES ONE'S COMPLEMENT STA SEGAD,I ISZ SEGAD NEXT SHORT ID LDA TEMP,I SEGMENT HIGH MAIN+1 LDB HMAIN SEGMENT START ADDRESS JSB BUMP ADVANCE FILE BLOCK # ISZ TEMP A(HIGH BASE PAGE+1) LDA TEMP,I LDB HBSPG SEG. B.P. START JSB BUMP ADVANCE FILE BLOCK # * (BLOCK # FOR NEXT SEG IN A) ISZ LPCNT DONE ? JMP LOOP SKP * * SET UP DS RESERVED AREA FOLLOWING SHORT IDS * LDA ANAME PICK UP 6TH CHAR OF FILE NAME ADA D2 LDA A,I AND B377 STA SEGAD,I PLACE IN 1ST WORD OF BLOCK LDB SEGAD BLOCK ADDRESS STB TEMP SAVE FOR CHECKSUM ISZ SEGAD POINT TO 2ND WORD LDA SECUR SAVE FILE SECURITY CODE STA SEGAD,I ISZ SEGAD 3RD WORD DLD FINFO SAVE FILE CRN & NODE # DST SEGAD,I CLA CLEAR CHECKSUM JSB SUM TEMP NOP START ADDR OF RESERVED BLOCK DEC -7 CMA ONE'S COMPLEMENT FOR DS SEGLD LDB SEGAD ADB D5 POINT TO CHECKSUM WORD STA B,I SAVE IT SKP * * DONE LOADING & FIXING UP SEGMENTS AS WAS REQUIRED * - NOW DO CLEANUP & EXIT * DONE DLD DNMSG MESSAGE ADDRESS DST MESS1 LDA AD5 A(LENGTH) STA LENGT A(MESSAGE LENGTH) JSB MSOUT DISPLAY THE MESSAGE LDB IDSEG FIND ADDRESS OF ID SEG STATUS WRD ADB D15 JSB $LIBR GO PRIVELEGED NOP LDA B,I IOR SBIT SET MR BIT (#15) STA B,I JSB $LIBX DEF *+1 DEF EXIT * * EXIT * EXIT JSB DCLOS CLOSE INPUT FILE IF ANY DEF *+3 DEF DCB DEF IERR * CLA TURN OFF SESSION OVERIDE STA D$OVR JMP LO..,I SKP * * ERROR PROCESSING * ERR00 LDA M65 SET ERROR STA ER,I CODE DLD BDNM ILLEGAL FILE NAME JMP ERR30 ERR01 DLD NODE NODE NOT INITIALIZED JMP ERR30 ERR12 LDA M66 SET ERROR STA ER,I CODE DLD CKSM ID CHECKSUM OR SYSTEM JMP ERR30 CHECKWORD MISMATCH ERR13 LDA M62 SET ERROR STA ER,I CODE DLD NOBG ILLEGAL ATTEMPT TO LOAD BG * ERR30 DST MESS1 SAVE IN MESSAGE BUFFER LDA AD5 STANDARD LENGTH ECONT STA LENGT SAVE LENGTH DEF JSB MSOUT DLD ABORT LOAD ABORT MESSAGE DST MESS1 SAVE IT LDA AD5 STA LENGT LENGTH OF MESSAGE JSB MSOUT JMP EXIT ALL DONE * * * REMOVE CONFLICTING PROGRAM * * ENTERED WITH B POINTING TO NAME OF PROGRAM * TO BE REMOVED * ERR40 LDA B REMOVE PROGRAM: MEMORY BOUNDS LDB AMES2 CONFLICT JSB .MVW MOVE THE NAME TO MSG BUFFER DEF D3 NOP LDA AMES2 ALSO MOVE TO LDB ER RETURN PARAMETERS INB t|2 THROUGH 4 JSB .MVW DEF D3 NOP LDA M60 SET ERROR STA ER,I CODE DLD REM 'REMOVE' MESSAGE DST MESS1 LDA AD8 MESSAGE LENGTH JMP ECONT OUTPUT IT * * RFA / DS ERROR EXIT * ERR50 LDA IERR GET RFA ERROR STA ER,I SET IT FOR APLDR CMA,INA & MAKE IT POSITIVE STA IERR JSB CNUMD CONVERT TO ASCII DEF *+3 DEF IERR DEF MESS1 MESSAGE BUFFER DLD ERMSG OVERLAY MSG ONTO 1ST DST MESS1 TWO WORDS OF BUFFER LDA AD6 JMP ECONT SKP * * ERROR MESSAGES * BDNM ASC 2,BDNM NODE ASC 2,NODE ERMSG ASC 2,ERR- CKSM ASC 2,CKSM DNMSG ASC 2,DONE ABORT ASC 2,ABRT REM ASC 2,REM DUP ASC 2,DUP NOID ASC 2,NOID NOBG ASC 2,NOBG SKP * * BUMP - BUMP BLOCK NUMBERS TO POINT AT THE VARIOUS MAINS, BASE * PAGES, AND SEGMENTS CONTAINED WITHIN A TYPE 6 FILE. * * * CALLING SEQUENCE: * A = HIGH ADDRESS + 1 * B = LOW ADDRESS * JSB BUMP * * ON RETURN: A = BLOCK # AND SECTR = BLOCK # * B IS DESTROYED * * BUMP NOP CMB,INB SET THE LOW ADDRESS NEGATIVE ADA B AND ADD TO HIGH ADDRES. CLB CLEAR FOR DIVIDE DIV D128 FIND # OF BLOCKS SZB IF REMAINDER IS ZERO OK INA OTHERWISE, ADD 1 MORE BLOCK ADA SECTR CURRENT + OLD STA SECTR JMP BUMP,I RETURN SKP * * MESSAGE OUTPUTTER * MSOUT NOP CLA TURN OFF OVERIDE TEMPORARILY STA D$OVR JSB WRITF OUTPUT THE MESSAGE DEF *+5 DEF O.BUF DEF IERR DEF MESSG LENGT NOP CLA,INA TURN SESSION OVERIDE BACK ON STA D$OVR JMP MSOUT,I * * MESSG ASC 3, LOAD MESS1 BSS 2 MESS2 BSS 3 AMES2 DEF MESS2  SKP * * LODIT - LOAD MEMORY FROM A REMOTE FILE * * LODIT LOADS PROGRAM OR BASE PAGE FROM A REMOTE FILE AS * FOLLOWS: IT TAKES THE HIGH & LOW LOAD ADDRESSES FROM * THE A & B REGISTERS, THE STARTING LOAD FILE RECORD # * FROM IREC AND TRANSFERS THE DATA BLOCK BY BLOCK UNTIL * COMPLETE. THE FILE MUST BE AN ALREADY OPENED TYPE 6 * FILE (FORCED TO TYPE 1) AND NO CHECKING IS DONE AS TO * WHETHER THE HIGH & LOW LOAD ADDRESSES ARE CORRECT. * * CALLING SEQUENCE: * A = HIGH ADDRESS + 1 * B = LOW ADDRESS * IREC = LOAD FILE RECORD # * * JSB LODIT * ON RETURN: * CONTENTS OF BOTH REGS. DESTROYED * LODIT NOP STA HIHAD SAVE HIGH ADDRESS LDA D128 INITIALIZE TRANSFER SIZE STA SVAMT * * READ / LOAD LOOP * LODLP STB LOWAD SAVE LOW ADDRESS CMB,INB ADB HIHAD HIGH - LOW SZB,RSS ANYTHING LEFT ? JMP LODIT,I NOPE, DONE ! SSB JMP LODIT,I DONE ! LDA D128 LESS THAN 128 WORDS LEFT ? CMA,INA ADA B SSA STB SVAMT YES, ONLY TRANSFER REMAINDER * JSB DREAD READ IN A BLOCK DEF *+7 (OR PARTIAL BLOCK) DEF DCB DEF IERR DEF IDBUF INPUT BUFFER DEF SVAMT # WORDS ( ACCESS TO 3000 LOGGING * (C) HEWLETT-PACKARD CO. NAM LOG3K,19,80 91750-16132 REV.2013 790508 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: LOG3K *SOURCE: 91750-18132 * RELOC: 91750-16132 * PGMR: DMT LST ************************** LOG3K ************************* * * * SOURCE: 91750-18132 * * * * BINARY: 91750-16132 * * * * PROGRAMMER: DAVE TRIBBY * * * * OCTOBER 13, 1978 * * * ************************************************************** SPC 1 * * DS/1000 PROGRAM TO PROVIDE OPERATOR ACCESS TO 3000 LOGGING. * EXT $OPSY,IFTTY,SPOPN,#CL3K,#LU3K,#FWAM,PGMAD EXT EXEC,CNUMD,REIO,LOGLU,NAMR,.DFER,LUTRU * A EQU 0 A-REGISTER B EQU 1 B-REGISTER SUP SKP LOG3K LDA $OPSY CHECK FOR OPERATING RAR,SLA SYSTEM TYPE. JMP XLABI LDA B,I NON-DMS LOAD. JMP CHKPR XLABI XLA B,I DMS LOAD. SPC 1 * * WHAT IS THE CONSOLE LU? * CHKPR SZA,RSS IF FIRST PARAM IS 0, JMP SETLU SET TO LOGLU. K IOR B600 SET ECHO AND COL 1 BITS. STA CONSL STORE CONSOLE LU. JMP PRHED * SETLU JSB LOGLU GET CONSOLE LU DEF *+2 OF SCHEDULER. DEF TEMP IOR B600 SET ECHO AND COL 1 BITS. STA CONSL STORE AS CONSOLE LU. SPC 1 * PRINT CURRENT STATUS INFORMATION. PRHED JSB PRINT PRINT DEF HEAD1 FIRST DEC 14 HEADING. * LDA #FWAM IF NO SAM SZA,RSS ALLOCATED, JMP NOTEN NOT ENABLED! * LDA #LU3K IF NO SZA,RSS 3000 LU, JMP NOTEN NOT ENABLED! * DLD ".LU" MOVE " LU " TO DST LUINF+2 LU INFORMATION. LDA D4 LENGTH IS 4. STA LULEN * LDA #CL3K IF NO SZA LOGGING LU, JMP CHKCL JSB .DFER MOVE "" DEF LUINF+4 DEF NONE * JSB PRINT PRINT IT. DEF LUINF DEC 7 JMP CHKIN GO CHECK FOR INPUT. * CHKCL AND BIT13 IF I/O CLASS BIT SZA,RSS IS SET, JMP GETLU * JSB .DFER (BIT IS SET...) DEF LUINF+2 MOVE "CLASS" DEF CLASS LDA BLNKS STA LUINF+5 LDA D6 STA LULEN * GETLU LDA LULEN ADA @LUIN ADD STARTING ADDR STA ADDR TO LENGTH. LDA #CL3K AND B377 ISOLATE LU OR CLASS. STA TEMP JSB CNUMD CONVERT DEF *+3 TO DEF TEMP ASCII DEF ASCII (DECIMAL). * DLD ASCII+1 PICK UP RESULT. RRL 8 ROTATE LEFT 1 BYTE. DST ADDR,I STORE. * LDA LULEN ADD 2 TO LENGTH. ADA D2 STA LULEN * LDA #CL3K+2 IF FILE NAME SZA,RSS IS IN RES, JMP DOWN? JSB .DFER MOVE IT DEF LUINF+6 INTO DEF PFILE BUFFER. JSB .DFER DEF LUINF+9 DEF #CL3K+2 LDA PARN SThA LUINF+12 LDA D13 LENGTH IS STA LULEN NOW 13. SPC 1 DOWN? LDA #CL3K IF SIGN BIT SSA,RSS IS SET, JMP PRLU LDA @LUIN POINT TO ADA LULEN NEXT BUFFER STA TEMP WORD. DLD DOWN MOVE "DOWN" DST TEMP,I TO BUFFER. LDA LULEN ADD 2 ADA D2 TO LENGTH. STA LULEN SPC 1 PRLU JSB PRINT PRINT DEF LUINF LU LULEN NOP INFORMATION. SPC 1 CLA SET LOGGING LENGTH STA LGLEN TO ZERO. LDB @LGIN SET DEST. ADDR. IN CASE OF NO BUF. LDA #CL3K+1 BUFFERS BEING TRACED? SSA,RSS JMP DRVR? NO. CHECK FOR DRIVER. * LDB @HEDR SET UP MOVE STB MPNTR POINTER. LDB D4 SET LENGTH STB LGLEN TO 4. * RAL POSITION BIT 14. SSA,RSS APPENDAGE BIT SET? JMP MOVLG NO. GO MOVE MESSAGE. LDB @APND SET UP MOVE STB MPNTR POINTER. ISZ LGLEN SET LENGTH TO 5. * LDA #CL3K+1 GET MAX DATA LENGTH AND LENBT FROM BITS 0-12. SZA,RSS IF ZERO, JMP MOVLG GO MOVE MESSAGE. STA TEMP SAVE LENGTH. JSB CNUMD CONVERT DEF *+3 TO DEF TEMP ASCII DEF ASCII (DECIMAL). DLD ASCII+1 DST WRDDT LDA D8 SET MOVE STA LGLEN LEN TO 8. LDA @WRDT SOURCE ADDRESS. RSS READY TO MOVE. * MOVLG LDA MPNTR SOURCE ADDRESS. LDB @LGIN DESTINATION. MVW LGLEN MOVE LOGGING MESSAGE. * LDA #CL3K+1 CHECK DRIVER AND BIT13 BIT. SZA,RSS JMP PRLOG NOT SET. GO PRINT. LDA @&DVR SET. MOVE " AND MVW D6 DRIVER". LDA LGLEN INCREMENT ADA D6 LENGTH BY STA LGLEN SIX. * PRLOG LDA LGLEN CALCc9ULATE TOTAL ADA D4 MESSAGE LENGTH. STA LGLEN JSB PRINT PRINT DEF LGINF LOGGING LGLEN NOP INFORMATION. * JMP CHKIN GO CHECK FOR INPUT. SPC 3 * CHECK TO SEE IF DRIVER IS BEING LOGGED. DRVR? LDA #CL3K+1 DRIVER BIT SET? AND BIT13 SZA JMP DRVR! YES. GO MOVE "DRIVER". * LDA @NOTH MOVE "NOTHING". RSS * DRVR! LDA @DRVR MOVE "DRIVER" LDB @LGIN DESTINATION ADDRESS. MVW D4 MOVE MESSAGE. LDA D4 LENGTH STA LGLEN IS 4. JMP PRLOG GO PRINT. SPC 5 ** ENTER HERE WHEN NODE IS NOT ENABLED FOR 3000 COMMUNICATIONS ** * NOTEN JSB PRINT PRINT DEF NTENL MESSAGE. DEC 10 JMP DONE TERMINATE. * NTENL ASC 10, HP 3000 NOT ENABLED SKP CHKIN JSB IFTTY CHECK CONSOLE DEF *+2 TO SEE IF IT'S DEF CONSL INTERACTIVE. SSA,RSS IF NOT, JMP DONE ALL DONE. SPC 2 JSB PRINT ASK: DEF CHNG? "CHANGES?". D6 DEC 6 * JSB READ READ REPLY. SPC 1 LDA NAME GET COMMAND. CPA "LU" LU? JMP GTLU YES. CPA "FI" FI? JMP GETFI YES. CPA "TY" TY? JMP GETTY YES. CPA "UP" UP? JMP UP YES. CPA "/E" /E? JMP DONE YES. CPA "EX" EX? JMP DONE YES. CPA "NO" NO? JMP DONE YES. CPA "EN" EN? JMP DONE YES. CPA "??" ??? JMP XPLAN YES. * * COMMAND NOT RECOGNIZED. PRINT ERROR MESSAGE. * PRERR JSB PRINT DEF ERMSG DEC 19 JMP CHKIN TRY AGAIN. * ERMSG ASC 19, UNRECOGNIZED. TYPE "??" FOR COMMANDS. SPC 1 * PRINT FINAL MESSAGE AND TERMINATE DONE JSB PRINT PRINT DEF ENMSG ENDING DEC 5  MESSAGE. JSB EXEC ALL DONE--TERMINATE. DEF *+2 DEF D6 SKP * GET NEW LOGGING LU. * GTLU JSB PNAMR PARSE AHEAD. LDA STATS IF NUMERIC PARAM PROVIDED, AND D3 CPA D1 DON'T NEED TO PROMPT. JMP GTLU1 * JSB PRINT PROMPT FOR NEW LU. DEF NEWLU DEC 6 JSB READ READ. GTLU1 LDA NAME GET RESPONSE. CPA "/E" IF "/E" JMP CHKIN PROMPT AGAIN. AND HB377 IF > 255, SZA JMP INVAL INVALID. * JSB CLOLD CLEAR OLD ENTRY. JSB LUTRU GET "REAL" LU NUMBER DEF *+2 SINCE QUEX RUNS DEF NAME OUTSIDE OF SESSION. SSA IF ERROR, JMP INVAL IT'S INVALID. STA #CL3K SET NEW LU. JMP PRHED PRINT NEW STATUS. SPC 3 INVAL JSB PRINT PRINT DEF INVMS INVALID DEC 7 MESSAGE. JMP CHKIN GET NEW COMMAND. * INVMS ASC 7, INVALID VALUE SKP * GET NEW FILE NAME--ONLY FOR SPOOLED SYSTEMS. GETFI JSB PGMAD IS SMP DEF *+2 IN SYSTEM? DEF "SMP" SZA,RSS JMP NOSMP NO. TELL USER. JSB PNAMR PARSE AHEAD. LDA NAME IF INFO GIVEN, SZA DON'T NEED TO PROMPT. JMP GTFI1 JSB PRINT PROMPT FOR DEF NEWFI FILE NAME. DEC 7 JSB READ READ. LDA NAME GET RESPONSE. CPA "/E" IF "/E", JMP CHKIN PROMPT AGAIN. * GTFI1 JSB CLOLD CLEAR OLD ENTRY. * JSB .DFER MOVE DEF SPNAM SPOOL DEF NAME FILE NAME. DLD SECU SET SECURITY AND DST SPSEC CARTRIDGE NUMBER. JSB SPOPN OPEN THE SPOOL LU. DEF *+3 DEF SPBUF DEF SPLU * LDA SPLU GET LU #. SSA NEGATIVE? JMP RPTER REPORT SPOOL ERROR. * JSB LUTRU GET "REAcL" LU NUMBER DEF *+2 SINCE QUEX RUNS DEF SPLU OUTSIDE OF SESSION. * STA #CL3K SET LU # IN SSGA. JSB .DFER MOVE FILE DEF #CL3K+2 NAME TOO. DEF NAME LDA NAME+2 STA #CL3K+4 JMP PRHED PRINT NEW STATUS. SPC 1 * REPORT SPOPN ERROR RPTER CMA,INA MAKE POSITIVE. STA TEMP SAVE ERROR. JSB CNUMD CONVERT DEF *+3 TO DEF TEMP ASCII DEF ASCII (DECIMAL). DLD ASCII+1 MOVE TO DST SMPER+7 MESSAGE. JSB PRINT PRINT DEF SMPER MESSAGE. DEC 9 JMP CHKIN READ AGAIN. * SMPER ASC 9,***SMP ERROR -XXXX SPC 1 * SMP NOT PRESENT. NOSMP JSB PRINT PRINT DEF ERRSP MESSAGE. D8 DEC 8 JMP CHKIN READ AGAIN. * ERRSP ASC 8,SORRY, NO SPOOL SPC 2 * SPOOL SET-UP BUFFER SPBUF DEC 0 NO BATCH INPUT CHECKING NOP SPNAM ASC 3, SPOOL FILE NAME SPSEC BSS 2 SECURITY, CARTRIDGE OCT 23 DEVICE TYPE=MAG TAPE OCT 23 DISPOSITION DEC 0,0,0,0,0,0,0 * SPLU NOP SPOOL LU (RETURNED BY SPOPN) SKP * GET NEW TRACE TYPE GETTY JSB PNAMR PARSE AHEAD. LDB NAME IF INFO GIVEN, SZB NO NEED TO PROMPT. JMP GTTY1 * JSB PRINT PROMPT FOR NEW TYPE. DEF NEWTY DEC 9 JSB READ READ. LDB NAME GET RESPONSE. CPB "/E" IF "/E", JMP CHKIN PROMPT AGAIN. * GTTY1 CLA CLEAR OPTIONS. CPB "DA" DATA? JMP SDATA YES. CPB "AP" APPENDAGE? JMP SAPND YES. CPB "HE" HEADER? JMP SHEAD YES. CPB "DR" DRIVER? JMP SETDR YES. CPB "NO" NONE? JMP STOPT YES. JMP PRERR UNRECOGNIZED. PROMPT AGAIN. * * SET VARIOUS OPTIONS. SDATA LDA SECUư GET NAMR PARAMETER. AND LENBT MAKE SURE IT FITS IN BITS 0-12. * SAPND IOR BIT14 SET APPENDAGE BIT. * SHEAD IOR BIT15 SET HEADER BIT. * STA TEMP HOLD OPTIONS. JSB PNAMR PARSE AHEAD. LDA TEMP RESTORE OPTIONS. * LDB NAME GET SECOND OPTION. CPB "DR" DRIVER? SETDR IOR BIT13 YES. SET BIT 13. * STOPT STA #CL3K+1 STORE NEW OPTIONS. JMP PRHED PRINT NEW STATUS. SKP * REMOVE "DOWN" BIT FROM LU. UP LDA #CL3K PICK UP LU. AND NOT15 REMOVE SIGN. STA #CL3K STORE. JMP PRHED PRINT NEW STATUS. SPC 3 * EXPLAIN LOG3K FUNCTIONS XPLAN JSB PRINT DEF EXPLN ABS ENDXP-EXPLN JMP CHKIN PROMPT AGAIN. * EXPLN ASC 27,LOG3K SETS UP FIVE WORDS IN SUBSYSTEM GLOBAL WHICH ARE ASC 10, USED BY THE HP3000 BYT 15,12 ASC 27,COMMUNICATIONS MODULE QUEX. THESE WORDS INDICATE WHAT ASC 07,TRACING SHOULD BYT 15,12 ASC 28,TAKE PLACE FOR COMMUNICATIONS BUFFERS AND WHETHER DRIVER ASC 09, FUNCTIONS SHOULD BYT 15,12 ASC 27,BE RECORDED. LOG3K REPORTS CURRENT OPTIONS AND ALLOWS ASC 10,YOU TO CHANGE THEM. BYT 15,12 BYT 15,12 ASC 09,POSSIBLE CHANGES: BYT 15,12 ASC 15, LU NEW LOG LOGICAL UNIT BYT 15,12 ASC 21, FI NEW LOG FILE (SPOOL SYSTEM ONLY) BYT 15,12 ASC 17, UP RESET LOG LU TO BE "UP" BYT 15,12 ASC 13, TY NEW LOGGING TYPE BYT 15,12 BYT 15,12 ASC 12,POSSIBLE LOGGING TYPES: BYT 15,12 ASC 09, NO NOTHING BYT 15,12 ASC 17, HE COMM. BUFFER HEADER ONLY BYT 15,12 ASC 15, AP HEADER AND APPENDAGE BYT 15,12 ASC 23, DA:n HEADER, APPENDAGE, AND n WORDS DATA BYT 15,12 ASC 28, DR DRIVER EVENTS AND STATES (MAY BE SECOND OPTN) BYT 15,12 ASC 26,EXAMPLE-- DA:50,DR TRACES 50 WORDS DATA AND DRIVER. BYT 15,12 ENDXP EQU * SKP * * SUBROUTINE TO PRINT A RECORD ON CONSOLE. * CALLING SEQUENCE: JSB PRINT * DEF * DEC * PRINT NOP ENTRY POINT LDA PRINT,I PICK STA MSG UP ISZ PRINT PARAMETERS. LDA PRINT STA MSLEN ISZ PRINT SET RETURN ADDR. JSB REIO CALL REIO FOR WRITE. DEF *+5 DEF SD2 DEF CONSL MSG NOP MSLEN NOP NOP IGNORE ERRORS. JMP PRINT,I RETURN. SPC 3 * * SUBROUTINE TO READ FROM CONSOLE AND PARSE INPUT. * CALLING SEQUENCE: JSB READ * READ NOP ENTRY. JSB REIO DO READ. DEF *+5 DEF SD1 DEF CONSL DEF INBUF DEF N80 JMP DONE TERMINATE UPON ERROR. STB RDLEN SAVE # OF CHARACTERS. CLA,INA SET POINTER TO STA PNTR FIRST CHARACTER. JSB PNAMR PARSE. JMP READ,I RETURN. SKP * SUBROUTINE TO CALL NAMR PARSE ROUTINE * CALLING SEQUENCE: * JSB PNAMR * PNAMR NOP ENTRY POINT JSB NAMR CALL DEF *+5 NAMR DEF NAME ROUTINE. DEF INBUF DEF RDLEN DEF PNTR JMP PNAMR,I RETURN. SPC 2 * RTE FILE NAMR PARAMETERS NAME BSS 3 STATS BSS 1 SECU BSS 1 CRN BSS 5 SPC 1 INBUF BSS 40 RDLEN NOP SPC 1 PNTR NOP COLUMN POINTER SKP * SUBROUTINE TO CLEAR OLD ENTRY IN SSGA. * CALLING SEQUENCE: JSB CLOLD * CLOLD NOP ENTRY POINT. LDA #CL3K+3 SPOOLED LU? SZA,RSS JMP CLCLS LDA #CL3K YES. AND NOT15 SAVE LU NUMBER. STA TEMP * * IF RUNNING UNDER SESSION, FIND THE SESSION LU WHICH MATCHES THE * "TRUE" LU THAT WAS RECORDED IN #CL3K. * h LDA D63 START AT 63. STSLU STA TESTL SET THE TEST LU. SZA,RSS IF DOWN TO 0, JMP NTFND NOT FOUND! JSB LUTRU COMPARE TEST LU'S DEF *+2 "TRUE" LU TO DEF TESTL THE SPOOL LU. CPA TEMP IS THIS IT? JMP FOUND YES! CCA NO DECREMENT ADA TESTL AND TRY AGAIN. JMP STSLU * FOUND JSB EXEC TELL SMP DEF *+5 TO RELEASE. DEF SD23 DEF "SMP" DEF D4 DEF TESTL NOP (ERROR RETURN.) * CLFIL CLA CLEAR STA #CL3K+2 FILENAME STA #CL3K+3 IN SSGA. STA #CL3K+4 JMP CLOLD,I RETURN. * * * THE SPOOL LU WAS NOT FOUND IN THE SESSION SWITCH TABLE. WARN USER, * BUT GO AHEAD AND CLEAR SSGA WORDS. USER SHOULD RUN GASP AND RELEASE * THE SPOOL FILE. * NTFND JSB PRINT PRINT DEF SPWRN WARNING. DEC 15 JMP CLFIL GO CLEAR FILE NAME. SPWRN ASC 15,SPOOL NOT SET BY THIS SESSION * * CLCLS LDA #CL3K IF LOGGING IS NOT AND BIT13 TO AN I/O CLASS, SZA,RSS JMP CLOLD,I RETURN. * LDA #CL3K SET NO-WAIT IOR BIT15 BIT IN CLASS #. STA CLASN * DEFLU CCA STA TEMP SET RELEASE RETRY SWITCH TO -1. CLRTN JSB EXEC RELEASE CLASS NUMBER. DEF *+5 DEF SD21 SPECIFY CLASS GET - NO ABORT. DEF CLASN CLASS/RELEASE/NO WAIT. DEF D0 DEF D0 RSS ERROR RETURN. ISZ TEMP RELEASE PROCESSING COMPLETED? JMP CLOLD,I YES. RETURN. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP DEFLU NO. CONTINUE TO CLEAR REQUESTS. * LDA CLASN GET THE CLASS NUMBER AGAIN. XOR BIT13 EXCLUDE THE NO-DEALLOC BIT (13). STA CLASN JMP CLRTN RETURN FOR FINAL DEALLOCATION. SKP ** CONSTANTS ** SPC 1 D0 DEC 0 D1 DEC 1 D2 ֹ<:6 DEC 2 D3 DEC 3 D4 DEC 4 D13 DEC 13 D63 DEC 63 SD1 DEF 1,I SD2 DEF 2,I SD21 DEF 21,I SD23 DEF 23,I N80 DEC -80 B377 OCT 377 HB377 BYT 377,0 B600 OCT 600 BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 LENBT OCT 17777 NOT15 OCT 77777 SPC 2 HEAD1 ASC 14,DS/1000-3000 LOGGING STATUS LUINF ASC 16, LOG LU LGINF ASC 18, LOGGING CHNG? BYT 15,12 , ASC 5,CHANGES? _* NEWLU ASC 6,NEW LOG LU:_* NEWFI ASC 7,NEW LOG FILE:_* NEWTY ASC 9,NEW LOGGING TYPE:_* ENMSG ASC 5,END LOG3K HEADR ASC 4, HEADER APNDG ASC 5, APPENDAGE WRDDT ASC 8, WORDS DATA * KEEP &DVR AND DRIVR TOGETHER! &DVR ASC 2, AND DRIVR ASC 4, DRIVER NOTHG ASC 4, NOTHING PFILE ASC 3,(FILE NONE ASC 3, DOWN ASC 2,DOWN PARN ASC 1,) "LU" ASC 1,LU "FI" ASC 1,FI "TY" ASC 1,TY "/E" ASC 1,/E "EX" ASC 1,EX "EN" ASC 1,EN "NO" ASC 1,NO "??" ASC 1,?? "HE" ASC 1,HE "AP" ASC 1,AP "DA" ASC 1,DA "DR" ASC 1,DR "UP" ASC 1,UP "SMP" ASC 3,SMP ".LU" ASC 2, LU CLASS ASC 3, CLASS BLNKS EQU WRDDT SPC 1 @LUIN DEF LUINF @LGIN DEF LGINF+4 @HEDR DEF HEADR @APND DEF APNDG @WRDT DEF WRDDT @&DVR DEF &DVR @DRVR DEF DRIVR @NOTH DEF NOTHG SPC 1 CONSL NOP ADDR NOP CLASN NOP TEMP NOP TESTL NOP MPNTR NOP ASCII BSS 3 SPC 1 BSS 0 SIZE OF LOG3K. SPC 1 END LOG3K r< GV 91750-18133 2013 S C0122 &LUMAP +              H0101 |ASMB,R,Q,C NAM LUMAP,18,30 91750-16133 REV.2013 800317 ALL EXT DSTIO,EXEC,CNUMD,KCVT,.MVW,XLUEX,D$OVR EXT #MSTC,#RSAX,#LOGR *# EXT IO3K,#LU3K EXT #NODE,#LMPE,#SPLU,#LUMP,PGMAD SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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: LUMAP * SOURCE: 91750-18133 * RELOC: 91750-16133 * PGMR: JOHN LAMPING * * WRITTEN BY LYLE WEIMAN [MARCH 1979] * MODIFIED BY JOHN LAMPING [NOVEMBER 1979] * * * * LUMAP IS THE DS/1000 PROGRAM WHICH PERFORMS THE REMOTE I/O. * IT IS PART OF THE DVV00/LUQUE/LUMAP TRIUMVIRATE. * * REMOTE "EXEC" CALLS ARE ISSUED VIA CALLS TO SUBROUTINE * "DSTIO", WITHOUT WAITING FOR THE REPLY. * * THESE ARE "NO-WAIT" CALLS, THEREFORE LUMAP IS NOT A BOTTLENECK * TO SYSTEM "MAPPED-I/O" TRAFFIC. * *NOTE: PROVISION HAS BEEN MADE FOR "VIRTUAL TERMINAL" * I/O TO/FROM HP 3000 NODES. TO ALLOW THIS CAPABILITY, REMOVE * THE TWO CHARACTERS *# IN COLUMNS 1 & 2 FROM ALL LINES * WHICH HAVE THEM, RE-ASSEMBLE, AND CODE A MODULE ANSWERING * A CALL TO IO3K WHICH HAS A "DSTIO-LIKE" CALLING SEQUENCE * (SEE INTERNAL CODE). PROVISION MUST ALSO BE MADE FOR SETTING UP * A MAP ENTRY WHEN A REMOTE HP 3000 SESSION "SIGNS ON", AND FOR * CLEARING IT UPON TERMINATION OF THE SESSION. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2001 790716 * *  * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * DSTIO, LUMAP * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24) (5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(bP13) #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP LUMAP EQU * CLA,INA TURN ON STA D$OVR SESSION OVERRIDE LDA #LUMP SAVE CLASS NUMBER STA #MSTC IN "#CMGT" (WITH "NO-DEALLOCATE" BIT) IOR =B40000 ADD "SAVE BUFFER" BIT STA CLASS AND SAVE WITH THAT LDA #SPLU CONFIGURE CONTROL WORD IOR BIT15 WITH "TRUE LU" BIT STA RTRLU RETRY STA STPLU STOP STA SPCLU REPLY JSB CNUMD CONVERT LOCAL DEF *+3 NODE NUMBER DEF #NODE TO ASCII DEF .NOD. * * SET UP TRANSACTION TABLE (TT) * * LDA NTTEN NEGATIVE # TT ENTRIES STA CNTR LDA @TT ADDRESS OF TT CLB SLUP EQU * LOOP STB A,I (0 IN 1ST WORD OF ENTRY DENOTES EMPTY) ADA TTSIZ INCREMENT TO NEXT ENTRY ISZ CNTR END OF SET-UP? JMP SLUP NO, CONTINUE * * HERE TO AWAIT NEXT TRANSACTION (CLASS BUFFER). * MAY BE ONE OF THREE KINDS: * * 1) NEW REQUEST. SCAN TRANSACTION TABLE (TT). * IF AN EMPTY "TRANSACTION TABLE" (TT) ENTRY * CANNOT BE FOUND, THEN DRIVER IS CALLED TO RE-TRY THE REQUEST * AFTER ONE SECOND. IF AN ENTRY CAN BE FOUND, THEN A SET-UP * IS MADE TO SEND THE REQUEST TO THE REMOTE NODE. SUBROUTINE * "DSTIO" IS CALLED, AND RETURN IS REQUESTED WITHOUT WAITING * FOR THE REPLY. THE TRANSACTION SEQUENCE NUMBER (ASSIGNED BY * #RSAX) IS USED TO UNIQUELY IDENTIFY THIS REQUEST. ALL INFORMATION * REQUIRED TO SEND THE REPLY BACK TO THE ORIGINAL RNEQUESTOR IS * SAVED IN THE "TT" UNDER THIS KEY. LUMAP AWAITS THE NEXT * CLASS BUFFER. * * 2) A REPLY TO THE "DSTIO" CALL. THE SEQUENCE NUMBER IN THE * "DS HEADER" IS USED TO SCAN THE TRANSACTION TABLE, LOOKING FOR * THE ORIGINAL REQUEST. IF NO MATCH IS FOUND, THE CLASS BUFFER * IS DISCARDED. OTHERWISE, THE REPLY INFORMATION, AND DATA, * IF ANY, ARE SENT BACK TO THE ORIGINAL REQUESTING PROGRAM * VIA THE DRIVER, USING A CLASS-I/O CALL (COMPLETIONS OF THESE * REQUESTS ARE DESCRIBED IN # 3, BELOW). THE TT ENTRY IS * CLEARED, AND LUMAP GOES BACK TO AWAIT THE NEXT REQUEST. * * 3) COMPLETION OF THE CLASS-I/O "WRITE" (THESE ARE DISCARDED). * GET EQU * JSB EXEC OBTAIN NEXT REQUEST DEF *+8 DEF D21I DEF CLASS @DVDT DEF DVDTA DRIVER "HEADER" AREA & DATA DEF DVSIZ SIZE OF AREA DEF VEQT "VIRTUAL EQT"/SEQ.#(ON REPLIES) DEF TOVAL I/O TIME-OUT TO SET/LNTH DS HEADER(REPLIES) DEF IPRM3 RETURN READ/WRITE CODE JMP BADCL OUR CLASS # IS BAD--CLEAR IT & QUIT DST ABREG SAVE REGISTERS SPC 2 LDA IPRM3 IF REQUEST WAS A "WRITE", THEN IT'S CPA D2 ONE OF MY OWN REPLIES TO DRIVER. JMP DUMP (IGNORE IT) LDA TOVAL IS THIS A REPLY? SSA,RSS JMP SRPLY YES. SZB,RSS IS THIS A GOOD REQUEST? JMP DUMP NO, IGNORE IT JSB DSCRD YES, FIRST CHUCK OLD BUFFER HED NEW REQUEST INITIATION SECTION * THIS IS A NEW REQUEST TO BE INITIATED. * LDA @DVDT MOVE DRIVER HEADER LDB @NODE OUT OF JSB .MVW I/O BUFFER DEF DVHDL DRIVER HEADER LENGTH NOP * * * SCAN TT FOR AN AVAILABLE ENTRY. * LDA NTTEN NEGATIVE # TT ENTRIES STA CNTR LDA @TT NULUP EQU * SEARCH LOOP LOOKING FOR AVAILABLE ENTRY LDB A,I IS j! SZB,RSS THIS ONE EMPTY? JMP NURQ YES, START NEW REQUEST * * IF THIS ENTRY HAS THE SAME "ORIGINAL REQUESTOR EQT/DVT" ADDRESS, * THEN THE ORIGINAL REQUEST FOR IT MUST HAVE TIMED OUT, AND IT IS * OBSOLETE (BECAUSE THE ORIGINAL REQUEST'S EQT/DVT REMAINS "BUSY" THROUGHOUT * THE EXECUTION OF THE REQUEST). * STA TEMP ADA @.C1 ADVANCE TO ORIGINAL EQT/DVT ADDRESS OF ENTRY LDB A,I LOAD THE EQT/DVT ADDRESS FOR THE ENTRY CPB VEQT DOES IT MATCH THIS ONE? JMP NX1 YES, WE'LL JUST USE THIS ENTRY. LDA TEMP NO, RECOVER TABLE ADDRESS, AND ADA TTSIZ ADVANCE TO NEXT ENTRY ISZ CNTR END OF TABLE? JMP NULUP NO, CONTINUE JMP RETRY NO TABLE SPACE NOW. TRY AGAIN LATER. * NX1 EQU * HERE TO RE-USE TABLE ENTRY LDA TEMP * * HERE WE HAVE AN AVAILABLE TT ENTRY. NURQ EQU * JSB SETPT SET UP POINTERS LDA @BUFR SET ADDRESS OF ACTUAL DATA STA @@@@ INTO "DSTIO" CALL LDA @PRM1 SET PARAMETER POINTER STA @@@1 INTO DSTIO CALL * LDA CONWD SET REQUEST CODE STA @RC,I SAVE IN TT AND D3 IOR =B100000 SET "NO-ABORT" INDICATION STA RCODE LDA DSEQN SAVE DRIVER-ASSIGNED SEQUENCE STA @DSEQ,I NUMBER IN TT LDA VEQT STA @EQT,I SAVE ORIGINAL EQT/DVT ADDRESS IN TT LDA REQLN SET REQUEST LENGTH STA @ORLN,I SAVE IN TT STA DLEN LDA REQLN VERIFY DATA WILL FIT JSB CKLEN IN OUR BUFFER LDB CONWD MUST ALSO CHECK LDA IPRM2 SECOND BUFFER BLF,SLB IF THIS IS JSB CKLEN A WRITE/READ * *# LDA RLU LOAD "REMOTE LU" WORD *# SSA,RSS NEGATIVE? *# JMP X1 NO, DON'T CHECK FOR I/O TO HP 3000 *# CMA,INA *# CPA #LU3K SAME AS LU TO HP 3000? *# JMP STDLS YES, I/O TO HP 3000 l{ LDA RLU STRIP OFF "OPTION" BITS AND =B377 LDB CONWD IS THE BLF,BLF TRANSPARENT BIT RBL,RBL SET? SLB STA RLU YES, SUPPRES SPECIAL FEATURES IOR SIGNB SIGNAL USE OF "TRUE" LU STA XLU LDA CONWD AND =B3700 MASK ONLY SUB-FUNCTION BITS STA XLU+1 LDA RCODE GET THE REQUEST CODE AGAIN AND D3 MASK ONLY REQUEST CODE PART CPA D3 IS THIS A "CONTROL" REQUEST? JMP CNTRL YES. SPC 2 LDB CONWD SLB,RSS ASCII "WRITE" REQUEST? JMP ASCWR YES * * * ASCII "READ" REQUEST. * LDA RLU GET THE RAL PROMPT INDICATION BLF,SLB Z BIT SET? JMP WREAD YES, MUST DO WRITE/READ SSA,RSS SHOULD WE PROMPT? JMP XQUT NO. * * CHANGE ORDINARY "READ" INTO "PROMPT READ" * CLB SET SECOND BUFFER LENGTH STB IPRM2 TO ZERO * * MAKE PROMPT READ * WREAD LDB XLU+1 SET "INTERACTIVE WRITE/READ" BIT ADB =B4000 STB XLU+1 LDB @BUFR MAKE SECOND BUFFER STB @@@1 POINT TO OUR AREA SSA,RSS SHOULD WE PROMPT? JMP XQUT NO LDB IPRM2 POINT TO CLE,SSB,RSS WORD CONTAINING JMP WREA1 FIRST CHARACTER CMB,INB PAST USERS CLE,ERB WRITE BUFFER WREA1 ADB @@@1 SEZ,RSS LOWER BYTE? JMP WREA2 NO LDA B,I YES, PUT AND =B177400 A SPACE ADA =B40 THERE INB ADVANCE TO FIRST FREE WORD WREA2 LDA .NOD. STORE FIRST DIGIT OF ADA =B4000 NODE NUMBER WITH STA B,I "(" IN FRONT LDA .NOD.+1 STORE INB REST OF STA B,I NODE LDA .NOD.+2 NUMBER INB STA B,I LDA =A)_ STORE CLOSING INB B ") " STA B,I CMB COMPUTE ADB @@@1 NEW CMB,INB LENGTH STB IPRM2 JMP XQUT DO REQUEST SKP * "ASCII" WRITE REQUEST. * IF SPECIFICALLY DIRECTED TO DO SO, * THE USER-SPECIFIED MESSAGE WILL BE PRECEDED BY A * MESSAGE (GENERATED BY THIS PROGRAM) INDICATING ITS SOURCE & TIME * ASCWR EQU * LDA RLU SHOULD WE INHIBIT SSA,RSS THE MESSAGE HEADER? JMP XQUT YES. JSB EXEC GET TIME-OF-DAY DEF *+3 DEF D11 DEF PARAM * JSB CNUMD CONVERT DAY NUMBER DEF *+3 DEF PARAM+4 DAY DEF .DAY. JSB KCVT CONVERT SECONDS DEF *+2 DEF PARAM+1 STA .SEC. JSB KCVT CONVERT MINUTES DEF *+2 DEF PARAM+2 STA .MIN. JSB KCVT CONVERT HOURS DEF *+2 DEF PARAM+3 STA .HR. * * FILL IN PROGRAM'S NAME, OR (SYS) * LDA IDADR IS THE ID SEGMENT ADDRESS OF SZA,RSS CALLING PROGRAM KNOWN? JMP NOPRG NO, FILL IN (SYS) CMA,INA YES, 'PGMAD' WILL FILL IN NAME STA IDADR JSB PGMAD DEF *+3 DEF .PRG. FILL IN PROGRAM NAME DEF IDADR FROM ID SEGMENT ADDRESS LDA @PRGM LOAD ADDRESS OF "PRGM " RSS NOPRG LDA @SYS LOAD ADDRESS OF "(SYS I/O)" LDB @SRCP MOVE SOURCE PROCESS NAME INTO AREA JSB .MVW DEF D6 NOP LDA @MHED MOVE MSG HDR INTO AREA IMMEDIATELY LDB @MXX PRECEDING DATA BUFFER STB @@@@ SET DATA ADDRESS FOR "DSTIO" CALL JSB .MVW DEF MHEDL NOP LDA DLEN WAS ORIGINAL REQUEST LDB MHEDL LENGTH SPECIFIED IN SSA,RSS CHARACTERS? JMP *+3 NO, WORDS RBL CHARACTERS. CONVERT HEADER LENGTH TO CMB,INB NEGATIVE # CHARACTERS ADA BB ADD HEADER LENGTH STA DLEN STORE COMBINED LENGTH SKP * ***** MAKE "DSTIO" CALL XQUT EQU * SPC 2 JSB DSTIO EXECUTE REMOTE I/O REQUEST DEF *+8 DEF RNODE REMOTE NODE NUMBER DEF RCODE REQUEST CODE DEF XLU DOUBLE-WD LU/SUBFUNCTION @@@@ NOP ADDRESS OF BUFFER STORED HERE DEF DLEN DATA LENGTH @@@1 NOP OPTIONAL PARAM/"PROMPT" BUFFER STORED HERE DEF IPRM2 2ND OPTIONAL PARAM/"PROMPT" BUFFER LEN JMP DSERR ERROR RETURN XQ5 EQU * STA @SEQ#,I SAVE TRANSACTION SEQUENCE NUMBER JMP GET AWAIT NEXT CLASS BUFFER SPC 2 * RETRY ENTRY FOR CASE WHERE PARAMETERS ARE IN TT ENTRY * RETR1 LDA @EQT,I GET PARAMETERS STA VEQT FROM LDA @DSEQ,I TT ENTRY STA DSEQN CLA CLEAR STA @RC,I TT ENTRY * * HERE TO FORCE DRIVER TO RE-TRY REQUEST LATER * RETRY EQU * JSB XLUEX DEF *+7 DEF K2N NO-ABORT DEF RTRLU DEF D0 BUFFER DEF D0 IS A DUMMY DEF VEQT ORIGINAL EQT/DVT ADDRESS DEF DSEQN SEQUENCE NUMBER NOP IGNORE ERRORS JMP GET AWAIT NEXT CLASS BUFFER SPC 2 * HERE TO SEND REQUEST TO HP 3000 * STDLS EQU * *# JSB IO3K *# DEF *+5 *# DEF RCODE 1,2 OR 3 *# DEF RLU SESSION # *# DEF @@@@,I BUFFER ADDRESS *# DEF DLEN BUFFER LENGTH *# JMP DSERR --ERROR RETURN-- *# JMP XQ5 AWAIT REPLY SPC 2 SPC 2 CNTRL EQU * HERE TO EXECUTE "CONTROL" REQUEST JSB DSTIO SEND REQUEST CODE DEF *+5 DEF RNODE DEF RCODE DEF XLU @PRM1 DEF IPRM1 JMP DSERR -ERROR- RETURN JMP XQ5 NORMAL RETURN HED "SEND REPLY TO ORIGINAL REQUESTOR" SECTION * HERE WHEN WE HAVE THE REPLY TO A "MAPPED I/O" REQUEST ʠ * SRPLY EQU * * * !! WE NEED TO GET EXTENDED STATUS WORDS TO PASS TO DRIVER. !! * * OBTAIN TRANSACTION SEQUENCE NUMBER, AND SET UP POINTERS TO * VARIOUS PARTS OF DS HEADER. SPC 1 * NOTE: OUR "DVDTA" BUFFER CONTAINS THE USER DATA (IF ANY), * FOLLOWED BY THE "DEXEC/DSTIO" REPLY INFO. WE REQUIRE THE * TRANSACTION SEQUENCE NUMBER FROM THIS, IN ORDER TO FIND THE * ORIGINAL REQUESTOR FROM OUR TT TABLE. SPC 2 LDB #MSTC GET CLASS NUMBER JSB #LOGR LOG THIS REPLY JSB DSCRD BLEW IT, DISCARD BUFFER LDA @DVDT COMPUTE ADDRESS OF DS HEADER ADA ABREG+1 STA @STR ADA =L#SEQ-#STR ADVANCE TO SEQUENCE # STA @HSEQ SAVE ADDRESS OF SEQUENCE # LDB A,I OBTAIN ITS TRANSACTION SEQUENCE NUMBER STB TSEQ# SAVE LOCALLY SO WE HAVE DIRECT ADDRESS ADA =L#EC1-#SEQ IN SEARCH. ADVANCE TO ERROR CODE STA @HERR SAVE ADDRESS OF ERROR CODE ADA =L#EC2-#EC1 ADVANCE TO 2ND ERROR CODE WORD STA @HER2 ADA =L#ENO-#EC2 ADVANCE TO REPORTING NODE # STA @HENO SAVE ADDRESS OF REPORTING NODE # ADA CONS1 ADVANCE TO A-REGISTER RETURN AREA STA @HEQ5 ADA =L#XML-#EQ5 ADVANCE TO B-REGISTER RETURN AREA STA @HXML LDA TOVAL LDB DVDTA CPA D1 MA RETRANSMISSION REQUEST? JMP SRP1 YES, SEQUENCE NUMBER IS FIRST WORD SZA WAS THERE A TRANSACTION TIME-OUT? JMP SRP2 NO. LDB VEQT YES, SET THE SEQUENCE NUMBER FOR THE SRP1 STB TSEQ# T.T. SEARCH. SRP2 JSB #RSAX RELEASE TCB DEF *+3 DEF D6 DEF TSEQ# * * SEARCH TRANSACTION TABLE FOR AN ENTRY WHICH * MATCHES THIS ONE'S TRANSACTION SEQUENCE NUMBER * LDA NTTEN SET # ENTRIES COUNTER STA CNTR LDA @TT SRLUP LDB A,I IS ENTRY SZB,RSS EMPTY? JMP SRLP1 YES LDB A NO, GET INFNB TRANSACTION LDB B,I SEQUENCE NUMBER CPB TSEQ# IS THIS THE ONE WE WANT? JMP SRP5 YES * NO MATCH. CONTINUE THE SEARCH SRLP1 ADA TTSIZ ADVANCE TO NEXT ENTRY ISZ CNTR END OF LOOP? JMP SRLUP NO, CONTINUE * * NO ENTRY FOUND. IF 'LUMAP' WAS ABORTED & SUBSEQUENTLY RE-SCHEDULED, * ITS TABLES WOULD BE EMPTY, BUT REPLIES MAY STILL BE COMING IN. * WE CAN DO NOTHING BUT IGNORE THIS BUFFER. THE USER PROGRAM WILL * EVENTUALLY TIME-OUT. * JMP GET IGNORE THIS BUFFER * * HAVE FOUND THE ENTRY. SET UP POINTERS * SRP5 EQU * JSB SETPT SET UP THE POINTERS * LDA TOVAL MA RETRANSMISSION CPA D1 REQUEST? JMP RETR1 YES, TELL DRIVER TO RETRY SZA NO, TRANSACTION TIME-OUT? JMP SRP6 NO. LDA "DS SET ERROR "DSO5" LDB "05 DST @HERR,I LDA #NODE STORE LOCAL NODE # IOR SIGNB STA @HENO,I IN AREA SRP6 EQU * * SET UP "DRIVER REPLY" HEADER (DRIVER SEQUENCE #, * (A) - REGISTER RETURN STATUS, TRANSMISSION LOG, ETC.) LDA @HENO,I WAS THERE SSA,RSS AN ERROR RETURNED? JMP XQ1 NO. DLD @HERR,I YES, LOAD ERROR CODE JMP DSERR HANDLE IT XQ1 LDA @DVDT COMPUTE THE ADDRESS OF THE REPLY DATA, ADA MRPLY BACK UP TO ALLOW ROOM FOR DVR HDR STA @RPLY SET ADDRESS FOR SENDING REPLY TO DRIVER LDB @HEQ5,I PASS I/O STATUS STB A,I TO DRIVER INA LDB @HXML,I PASS TRANSMISSION LOG STB A,I TO DRIVER LDB PRPLY LDA @RC,I WAS ORIGINAL AND D3 REQUEST CPA D1 A "READ" ? RSS JMP XQ3 NO, DON'T ADJUST THE LENGTH LDB @ORLN,I YES. WAS ORIGINAL REQUEST LENGTH SSB,RSS SPECIFIED IN CHARACTERS? JMP XQ2 NO LDB PRPLY YE ^S, RBL CONVERT REPLY LENGTH TO CHARACTERS ADB @HXML,I INCLUDING # CHARS IN USER DATA CMB,INB RETURN A NEGATIVE NUMBER OF CHARS JMP XQ3 XQ2 EQU * ORIGINAL RQST LNTH SPECIFIED IN WORDS LDB @HXML,I USE USER DATA LENGTH ADB PRPLY XQ3 EQU * STB DLEN STORE LENGTH * JSB XLUEX SEND THIS INFO TO DRIVER DEF *+8 DEF D18I DEF SPCLU @RPLY NOP SET TO ADDRESS OF DRIVER REPLY DATA DEF DLEN DEF @EQT,I ORIGINAL REQUEST EQT/DVT ADDRESS DEF @DSEQ,I DRIVER SEQUENCE NUMBER DEF #MSTC NOP IGNORE ERRORS * CLEAR EQU * HERE TO CLEAR TT ENTRY CLA STA @RC,I JMP GET SPC 2 BADCL EQU * HERE IF CLASS # IS BAD CLA CLEAR CLASS NUMBER STORED IN 'RES' STA #LUMP JSB EXEC & TERMINATE. IF A NEW RQST COMES IN, LUQUE WILL DEF *+2 NOTIFY US. DEF D6 SPC 2 SKP * ERRORS SECTION DS03 EQU * HERE FOR ILLEGAL LENGTH DLD "DS03 * * HERE ON "DS" ERRORS. * "DS08" ERRORS ARE TRAPPED, AND RETRIED BY SENDING THEM * BACK TO THE "LU MAPPING" DRIVER, WHICH RE-TRIES A FIXED * NUMBER OF TIMES. * DSERR EQU * CPA "DS IS THIS A "DS08" ERROR? RSS JMP DSER1 CPB "08 RSS JMP DSER1 NO, PRINT ERROR JMP RETR1 * DSER1 EQU * DST #LMPE STORE ERROR LDA @HENO,I LOAD REPORTING NODE NUMBER ELA,CLE,ERA CLEAR SIGN BIT STA #LMPE+2 JSB XLUEX SEND "STOP" DEF *+7 DEF K2N NO-ABORT DEF STPLU "SPECIAL" LU + 'STOP' CODE DEF D0 DUMMY DEF D0 BUFFER DEF @EQT,I ORIGINAL EQT/DVT ADDRESS DEF @DSEQ,I DRIVER SEQUENCE NUMBER NOP IGNORE ERRORS JMP CLEAR CLEAR TT ENTRY SPC 2 * SUBROUTINEO TO SET UP THE TT POINTERS * SETPT NOP STA @RC INA STA @SEQ# INA STA @ORLN INA STA @EQT INA STA @DSEQ JMP SETPT,I RETURN TO CALLER SPC 2 * * CHECK REQUEST LENGTH IN A, JUMP TO DS03 IF ILLEGAL * CKLEN NOP SSA,RSS WAS LENGTH IN CHARACTERS? JMP *+4 NO CMA,INA YES, CONVERT INA TO WORDS ARS ADA MAXBL BIGGER THAN THE LIMIT? SSA,RSS JMP DS03 YES, ERROR JMP CKLEN,I NO, OKAY SPC 2 * * SUBROUTINE TO DISCARD BUFFER FROM CLASS * DSCRD NOP JSB EXEC DO CLASS GET WITH DISCARD DEF *+5 DEF D21I DEF #MSTC DEF DVDTA DEF D0 NOP IGNORE ERRORS JMP DSCRD,I * * DUMP JSB DSCRD JMP GET SKP * DATA SECTION * SUP * EQUATES .RQST EQU 9 SIZE OF DRIVER REQUEST HEADER .RPLY EQU 4 SIZE OF DRIVER REPLY HEADER .MXBL EQU 512 MAXIMUM ALLOWABLE USER DATA SIZE * CONS1 ABS #EQ5-#ENO MAXBL ABS -.MXBL-1 MRPLY ABS -.RPLY NEGATIVE OF DRIVER REPLY HEADER LENGTH PRPLY ABS .RPLY POSITIVE OF DRIVER REPLY HEADER LENGTH M1 DEC -1 D0 DEC 1 D1 DEC 1 D2 DEC 2 D3 DEC 3 SIGNB DEF 0,I SIGN BIT K2N OCT 100002 I/O WRITE REQUEST, NO-ABORT D6 DEC 6 D11 DEC 11 "DS03 ASC 2,DS03 "DS EQU "DS03 "05 ASC 1,05 "08 ASC 1,08 PARAM BSS 5 D21I DEF 21,I XLU OCT 0,0 DOUBLE-WORD LU/SUBFUNCTION * * WARNING: DO NOT DISTURB THE ORDER OF THE FOLLOWING * TABLES!!! * * * "DRIVER HEADER" AREA. * * * RNODE NOP REMOTE NODE NUMBER RLU NOP REMOTE LU CONWD NOP ORIGINAL REQUEST 'CONWD' REQLN NOP ORIGINAL REQUEST LENGTH IPRM1 NOP 1ST OPTIONAL PARAMETER IPRM2 NOP 2ND OPTIONAL PARAMETER IPRM3 NOP RETURNED AS READ/WRITE CODE FOR LAST CLASS-I/O IDADR NOP CALLING PROGRAM'S ID SEGMENT ADDRESS, OR ZERO DSEQN NOP DRIVER-ASSIGNED SEQUENCE NUMBER .DVHL EQU *-RNODE # WORDS IN DRIVER HEADER DVHDL ABS .DVHL SIZE OF HEADER * * "MESSAGE HEADER" AREA: * "MESSAGE FROM NODE # NNNNNN PRGM AAAAA AT DAY DDDDD, HH :MM :SS * MHEDR ASC 9,MESSAGE FROM NODE # .NOD. BSS 3 SRCP BSS 6 SOURCE PROCESS ASC 4, AT DAY .DAY. BSS 3 ASC 1, .HR. NOP ASC 1, : .MIN. NOP ASC 1, : .SEC. NOP OCT 6412 CARRIAGE RETURN/LINE FEED .HEDL EQU *-MHEDR MESSAGE HEADER LENGTH DVSIZ ABS .MXBL MHEDL ABS .HEDL LENGTH OF MESSAGE HEADER @BUFR DEF BUFFR+.DVHL ADDR OF DATA PORTION OF NEW RQST * * * END OF FIXED-ORDER TABLES. * @MXX DEF MXX @SYS DEF SYS SYS ASC 6, (SYS I/O) @PRGM DEF PRGM PRGM ASC 3, PRGM .PRG. BSS 3 STORAGE FOR PROGRAM NAME @SRCP DEF SRCP ADDRESS WHERE TO STORE PROGRAM NAME OR (SYS I/O) @NODE DEF RNODE @MHED DEF MHEDR VEQT NOP ABREG BSS 2 TEMP NOP CNTR NOP TSEQ# NOP THIS TRANSACTION'S SEQUENCE NUMBER CLASS NOP CLASS NUMBER WITH NO-DEALLOCATE RTRLU NOP OCT 3400 RETRY FUNCTION CODE STPLU NOP OCT 3500 STOP FUNCTION CODE SPCLU NOP OCT 3700 REPLY FUNCTION CODE DLEN NOP D18I OCT 100022 CLASS WRITE, NO-ABORT BIT15 OCT 100000 RCODE NOP TOVAL NOP STORAGE FOR TIME-OUT VALUE @STR NOP ADDRESS OF STREAM @HSEQ NOP ADDRESS IN BUFFER OF TRANSACTION SEQ. # @HERR NOP @HER2 NOP @HENO NOP @HEQ5 NOP @HXML NOP SKP * TRANSACTION TABLE DEFINITIONS * * FOLLOWING POINTERS DESCRIBE THE FORMAT & SIZE OF EACH * TT ENTRY. * (DO NOT DISTURB ORDER!) * @RC NOP PNTR TO ORIGINAL REQUEST CODE * NOTE: IF 1ST WORD IS ZERO, ENTRY IS EMPTY @SEQ# NOP PNTR TO TRANSACTION SEQUENCE NUMBER ENTRY @ORLN NOP PNTR TO ORIGINAL REQUEST LENDZXTGTH WORD @EQT NOP PNTR TO ORIGINAL REQUESTOR'S EQT/DVT ADDRESS @DSEQ NOP PNTR TO DRIVER-ASSIGNED SEQUENCE NUMBER .TSIZ EQU *-@RC # WORDS IN EACH ENTRY @TT DEF TTABL SPC 2 * DEFINE SIZE & # ENTRIES IN TRANSACTION TABLE SPC 2 .NENT EQU 64 # TABLE ENTRIES NTTEN ABS -.NENT NEGATIVE # ENTRIES IN TABLE TTSIZ ABS .TSIZ # WORDS PER ENTRY * DEFINE OFFSET FROM REQUEST CODE TO EQT/DVT ADDRESS ENTRIES @.C1 ABS @EQT-@RC * MXX BSS .HEDL-.RQST SPACE FOR MESSAGE HEADER BUFFR BSS .MXBL BSS 4 EXTRA SPACE FOR APPENDED PROMPT DVDTA EQU BUFFR SUP TTABL EQU * TRANSACTION TABLE REP .NENT BSS .TSIZ A EQU 0 B EQU 1 END LUMAP BZ H\ 91750-18134 2013 S C0122 &LUQUE +              H0101 ASMB,R,Q,C HED LUQUE 91750-16134 REV.2013 800305 ALL NAM LUQUE,18,25 91750-16134 REV.2013 800305 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: LUQUE * SOURCE: 91750-18134 * RELOC: 91750-16134 * PGMR: JOHN LAMPING * * WRITTEN BY LYLE WEIMAN [MARCH 1979] * MODIFIED BY JOHN LAMPING [OCTOBER 1979] * EXT EXEC,RMPAR,CLRQ,RNRQ,#GRPM,XLUEX EXT #QRN,#LUMP,#NRVS EXT #LMPE,#SPLU SUP * * * * LUQUE IS THE DS/1000 PROGRAM SCHEDULED BY THE "VIRTUAL TERMINAL" * DRIVER WHEN AN I/O REQUEST IS MADE TO A "MAPPED" LU. * LUQUE DOES NOT HANDLE THE REQUEST, BUT ONLY ISSUES THE CLASS-I/O * "READ" REQUEST, WHICH ALLOWS THE DRIVER TO PASS INFORMATION ABOUT * THE REQUEST (INCLUDING DATA, IN THE CASE OF "WRITE" REQUESTS) * TO 'LUMAP', THE PROGRAM WHICH ACTUALLY CONVERTS THE I/O REQUEST * INTO A "DEXEC" CALL. * * IF AN IMMEDIATE REJECT OF THE REQUEST OCCURS DUE TO * INSUFFICIENT SYSTEM AVAILABLE MEMORY (SAM), OR THE NODE IS * QUIESCENT, LUQUE SENDS A "STOP" TO THE DRIVER. * * * IF AN ERROR OCCURS, THIS FACT IS RECORDED IN " #LMPE ", AN * ENTRY POINT IN SSGA, POSSIBLY INCLUDING THE NEXT TWO LOCATIONS, * IF THE ERROR CODE IS ASCII. #LMPE IS ONLY SET ON ERRORS. THAT IS, * ITS VALUE ONLY RECORDS THE LAST ERROR CONDITION, IF ANY. THUS, IF * YOU ARE HAVING TROUBLE WITH "LU MAPPING", YOU MAY (IF YOU'VE INCLUDED * PROGRAM "IOMAP" IN THE TROUBLESOME NODE) USE "IOMAP" TO RETURN THE * ERROR CODE(S) FROM #LMPE. BEAR IN MIND, HOWEVER, THAT #LMPE DOES * NOT NECESSARILY REFLECT TH0E LAST ERROR YOU SAW (THERE MAY BE OTHER * USERS OF "LU MAPPING" AT THE SAME NODE). HOWEVER, IF YOU ARE THE * ONLY USER OF "LU MAPPING" AT A GIVEN NODE, AND YOU CHECK #LMPE * IMMEDIATELY AFTER YOU FIND AN ERROR, YOU CAN FIND OUT WHAT WENT * WRONG. * * THOSE ERROR CODES SET BY 'LUQUE' ARE SHOWN BELOW: * * #LMPE CAUSE ACTION * ----- -------------------------------------- --------- * 1 SCHEDULE "SPECIAL" LU NOT DEVICE TYPE 0 -- IGNORE IT * 2 SCHEDULE NOT FROM "LU MAPPING" DRIVER IGNORE IT * 3 SCHEDULE PARAMETER IS NON-EXISTANT LU IGNORE IT * 4 DS/1000 QUIESCENT RN IS SPECIFIED IN #QRN * IS BAD (AN ERROR OCCURRED ON ATTEMPT * TO CHECK ITS STATUS) SEND 'STOP' * 5 NODE IS QUIESCED SEND 'STOP' * 6 LUMAP'S CLASS IS BAD " " * 7 NOT ENOUGH SYSTEM AVAILABLE MEMORY " " * 8 ERROR ON ATTEMPT TO SCHEDULE 'LUMAP' * (MOST LIKELY, 'LUMAP' IS NOT IN SYSTEM) " " * 9 REMOTE NODE NUMBER NOT FOUND IN NRV " " * 10 DS/1000 NOT INITIALIZED, OR SHUT DOWN " " * 11 ERROR EXIT TAKEN ON CLASS # ALLOCATION " " * 12 NO CLASS #S AVAILABLE " " * * OTHER ASCII VALUES (> 20000B) OF #LMPE INDICATE "DS" OR OTHER * SORT OF ERROR. LOCATIONS #LMPE & #LMPE+1 WILL CONTAIN A 4-CHARACTER * ASCII ERROR CODE, DEFINED IN DS/1000 MANUALS IF "DS" ERROR, OR * RTE MANUALS OF OTHER ERROR. #LMPE+2 CONTAINS THE REPORTING NODE * NUMBER SKP LUQUE EQU * JSB RMPAR RECOVER PARAMETERS DEF *+2 DEF PARAM CLA CLEAR "LUMAP" ERROR CODE STA LMPE LDA #SPLU SPECIAL LU SZA,RSS SET UP? JMP EXIT NO, NOT MUCH TO DO IOR BIT15 SET "TRUE LU" BIT STA STPLU SUBFUNCTION FOR STOP STA SPCLU SUBFUNCTION FOR READ * LDA #GRPM IS DS/1000 INITIALIZED SZA,RSS OR SHUT DOWN? JMP ERR10 UNINITIALIZED OR SHUT DOWN. * JSB RNRQ CHECK FOR QUIESCENT SYSTEM DEF *+4 DEF NWGLC LOCK WORD:NO-WAIT,NO-ABORT,GLOBAL LOCK & CLEAR DEF #QRN QUIESCENT SYSTEM RN DEF EQT4 RETURN STATUS HERE JMP ERR4 BAD RN, ERROR # 4 LDA EQT4 IS THIS SYSTEM CPA K7 QUIESCED? JMP ERR5 YES, ERROR # 5 LDA #LUMP PICK UP LUMAP'S CLASS NUMBER SZA CLASS ALLOCATED? JMP X JSB CLRQ NO, ALLOCATE A CLASS NUMBER DEF *+4 DEF K1N ASSIGN A CLASS NUMBER, NO-WAIT, NO ABORT DEF CLASS RETURN CLASS NUMBER HERE DEF ZERO NO OWNERSHIP IS ASSIGNED. JMP ERR11 --ERROR EXIT FROM CLRQ LDA CLASS SZA,RSS WAS ONE ALLOCATED? JMP ERR12 NO IOR B200. SET "DO NOT DE-ALLOCATE CLASS" BIT STA #LUMP SAVE X EQU * CCE RAL,ERA SET NO-WAIT BIT IN CLASS WORD. STA CLASS SAVE LOCALLY * JSB EXEC MAKE SURE LUMAP DEF *+3 IS SCHEDULED DEF K10N DEF LUMAP JMP ERR8 ERROR--PROBABLY NO 'LUMAP' * LDB DLEN OBTAIN REQUEST LENGTH SSB,RSS CHARACTERS? JMP *+4 NO CMB,INB YES, CONVERT TO WORDS INB BRS STB LEN SAVE LENGTH * * IF ORIGINAL REQUEST WAS A "WRITE", THEN INCREASE THE * BUFFER LENGTH FROM THE USER'S ORIGINAL LENGTH TO * INCLUDE THE CALLER'S ORIGINAL DATA * LDB HDRSZ LOAD HEADER SIZE ADB LEN ADD DATA SIZE STB LEN JSB #NRVS FIND MASTER TIME-OUT DEF *+3 DEF RNODE REMOTE NODE NUMBER DEF TOVAL JMP ERR9 --ERROR: NODE NOT FOUND LDA TOVAL CONVERT MASTER TIME-OUT TO CENTOSECONDS AND B377 CMA,INA GET # TICKS LEFT ADA B377 MPY D500 TO GO IN EQT SSA DID THIS OVERFLOW? LDA B777. YES, LOAD MAXIMUM TIME-OUT VALUE. CMA,INA CONVERT TO TWO'S COMPLEMENT STA TOVAL SAVE EQT TIME-OUT VALUE. JSB XLUEX READ THE REQUEST TO LUMAP'S CLASS DEF *+8 DEF K17N NO ABORT DEF SPCLU "SPECIAL" LU SUBFUNCTION 3700(8) DEF ZERO DEF LEN DATA LENGTH DEF VEQT "VIRTUAL" EQT DEF TOVAL "MASTER" TIME-OUT VALUE TO SET IN EQT DEF CLASS JMP ERR6X --ERROR, PROBABLY BAD CLASS NUMBER * EXIT JSB EXEC TERMINATE LUQUE DEF *+2 DEF K6 * SKP * * ERROR PROCESSING SECTION * ERR6X EQU * HERE ON BAD CLASS NUMBER ERROR CLA CLEAR CLASS NUMBER STA #LUMP JMP ERR6 SET ERROR CODE # 6, SEND 'STOP' & TERMINATE * ERR12 ISZ LMPE ERROR # 12: LEAVE LMPE = 12 ERR11 ISZ LMPE ERROR # 11: LEAVE LMPE = 11 ERR10 ISZ LMPE ERROR # 10: LEAVE LMPE = 10 ERR9 ISZ LMPE ERROR # 9: LEAVE LMPE = 9 ERR8 ISZ LMPE ERROR # 8: LEAVE LMPE = 8 ERR7 ISZ LMPE ERROR # 7: LEAVE LMPE = 7 ERR6 ISZ LMPE ERROR # 6: LEAVE LMPE = 6 ERR5 ISZ LMPE ERROR # 5: LEAVE LMPE = 5 ERR4 ISZ LMPE ERROR # 4: LEAVE LMPE = 4 ERR3 ISZ LMPE ERROR # 3: LEAVE LMPE = 3 ERR2 ISZ LMPE ERROR # 2: LEAVE LMPE = 2 ERR1 ISZ LMPE ERROR # 1: LEAVE LMPE = 1 LDA LMPE STA #LMPE RE-SET #LMPE ONLY ON ERRORS * * CALL DRIVER TO SEND A STOP * JSB XLUEX DEF *+7 DEF K2N DEF STPLU DEF ZERO DEF ZERO DEF VEQT DEF SEQN NOP IGNORE ERRORS JMP EXIT * SKP * * CONSTANTS AND STORAGE * * * * CLASS NOP LMPE NOP LOCAL STORAGE FOR ERROR CODE B77 OCT 77 B377 OCT 377 B200. OCT 20000 "DO NOT DE-ALLOCATE CLASS" BIT BIT15 .OCT 100000 B777. OCT 77777 D500 DEC 500 NWGLC OCT 140006 GLOBAL LOCK & CLEAR, WITHOUT WAITING, NO ABORT ZERO OCT 0 K1N OCT 140001 ALLOCATE CLASS#, NO-WAIT, NO-ABORT K2 DEC 2 K3 DEC 3 K2N OCT 100002 I/O WRITE REQUEST, NO-ABORT K6 DEC 6 K7 DEC 7 K10N OCT 100012 SCHEDULE W/O WAIT, NO-ABORT K17N OCT 100021 LUMAP ASC 3,LUMAP HDRSZ DEC 9 SIZE OF HEADER LEN NOP SPCLU NOP "SPECIAL" LU NUMBER OCT 3700 MUST FOLLOW SPCLU STPLU NOP "STOP" LU AND SUBFUNCTION OCT 3500 MUST FOLLOW STPLU TOVAL NOP STORAGE FOR TIME-OUT VALUE TO SET (BY DRIVER) EQT4 NOP PARAM BSS 5 VEQT EQU PARAM "VIRTUAL" EQT ADDRESS RNODE EQU PARAM+1 REMOTE NODE NUMBER DLEN EQU PARAM+2 BUFFER LENGTH SEQN EQU PARAM+3 SEQUENCE NUMBER * * SIZE BSS 0 * END LUQUE  I S 91750-18135 2013 S C0122 &#MAUP +              H0101 bASMB,R,Q,C HED <#MAUP> MA INITIALIZATION * (C) HEWLETT-PACKARD CO. 1980 NAM #MAUP,7 91750-1X135 REV 2013 800415 ALL ENT #MA1,#MA2,#MA3 * EXT $LIBR,$LIBX,.MVW,.LDX EXT #PRNT,#ABRT,#READ,#SYSR,#NODE,#PRSB,#EXFR,$OPSY EXT #MARN,#MARL,#MCTR,#MTBL EXT #MA1.,#MA2.,#RNSB,#CLSB PRINT EQU #PRNT ABORT EQU #ABRT READ EQU #READ ERMSG EQU #SYSR QUERY EQU #EXFR RNSUB EQU #RNSB CLSUB EQU #CLSB * @NODE DEF #PRSB @RL DEF #PRSB+4 RETRY LIMIT @MTO DEF #PRSB+8 @MA DEF #PRSB+20 "MA" (MA INDICATOR) @MATO DEF #PRSB+24 (OPTIONAL) MA TIMEOUT SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * #MAUP * ------------- * SOURCE PART # 91750-18135 * REL. PART # 91750-1X135 * PROGRAMMER TOM MILNER * WRITTEN 07.12.79 * * USED AS 3 SUBROUTINES FOR 'DINIT'. IF MA IS GENERATED * IN THE SYSTEM, THESE THREE ROUTINES (THRU DINIT) INITIALIZES THE * MA TABLE, AND ATTEMPTS TO BRING ALL CHANNELS UP. * * INITIAL CALL TO DETERMINE SPACE REQUIREMENTS * * JSB #MA1 * < A-REG RETURNS WITH #WORDS REQUIRED > * * * CALL TO INITIALIZE INTERNAL MA VALUES * * < #MTBL CONTAINS ADDRESS OF ALLOCATED SAM> * < = NUMBER OF NRV ENTRIES > * JSB #MA2 * * CALL FOR EACH NRV ENTRY (DETERMINES IF MA REQUIRED FOR THIS NODE) * * < #PRSB HAS PARSE BUFFER = CPU#,LU,TIMEOUT,LEVEL,'N','MA',MATO > * < = MASTER TIMEOUT VALUE > * JSB #MA3 * * #SIZE EQU 10 MA TABLE ENTRY SIZE (IN WORDS) SKP #MA1 NOP CLB STB M CLEAR NODE COUNTER N LDA $OPSY TEST FOR DMS RAR,SLA STB DMS1 JSB PRINT "HOW MANY NODES NEED MA?" DEF MAMS1 JMP *+3 MA1.A JSB QUERY REPEAT QUESTION AFTER PRINTING ERROR DEF ERMS6 "BAD NUMBER OF NODES" JSB READ ANY? CPA D1 NUMERIC? RSS . YEP OK JMP MA1.A . NO ASK AGAIN SSB POSITIVE? JMP MA1.A . NO ASK AGAIN STB M SAVE NODE COUNT * DLD @RL,I GET RETRY LIMIT - IF NONE USE DEFAULT SZA,RSS RETRY LIMIT SPECIFIED? JMP DRL . NO GET DEFAULT CPA D1 NUMERIC INPUT JMP DRL+1 . YEP GO FOR IT CPB "/D" DEFAULT REQUESTED? JMP DRL . YEP DO IT JSB QUERY "INVALID RETRY LIMIT" DEF ERMS3 JMP MA1.A+2 DRL LDB MARL DEFAULT RETRY LIMIT STB RL SAVE FOR NOW CMB,INB ADB D15 RANGE LESS THAN OR EQUAL 15? SSB JMP DRL-3 . NO BADO BADO... LDB RL ADB N1 RANGE GREATER THAN OR EQUAL 1? SSB JMP DRL-3 . NO BADO BADO... * LDB M LSR 16 := , := 0 MPY ESIZE TIMES WORDS PER ENTRY JMP #MA1,I RETURN W/ = NUMBER WORDS NEEDED SPC 2 #MA2 NOP STA N SAVE NUMBER OF NRV ENTRIES LDA M MA NEEDED? SZA,RSS JMP #MA2,I . NO CMA,INA STA #MCTR SAVE NUMBER OF MA ENTRIES LDA RL STA #MARL SAVE MA RETRY LIMIT LDA #MTBL STA PTR TEMPORARY PTR FOR #MA3 * JSB RNSUB ALLOCATE RN DEF #MA1. * CCA JSB CLSUB ALLOCATE CLASS DEF #MA2. JMP #MA2,I SPC 2 SPC 1 * FILL IN MA TABLE. 'M' HAS REMAINING MA ENTRIES. 'N' HAS * REMAINING NRV ENTRIES. 'PTR' CONTAINS NEXT MA ENTRY LOCATION. * #MA3 NOP IOR UPPER CMA,INA MAKE POSITIVE # OF UPLIN TICKS MPY D5 CONVERT UPLIN TICKS TO SECONDS STA MSTO SAVE MASTER TIMEOUT * CCA ADA N DECREMENT # REMAINING NRV ENTRIES STA N * DLD @MA,I CHECK IF MA SPECIFIED SZA,RSS JMP CKCNT NOT SPECIFIED, CHECK COUNTS CPB "MA" CORRECT REQUEST JMP *+3 JSB ERMSG "INVALID MA SPECIFICATION" DEF ERMS1 * CCA ADA M DECREMENT REMAINING MA NODES STA M SSA,RSS COUNT ROLLED OVER? JMP *+3 . NO OK JSB ERMSG "INCORRECT NUMBER OF MA NODES" DEF ERMS6 * DLD @NODE,I SAVE NODE # STB @TBL+1 CPB #NODE MA SPECIFIED TO LOCAL NODE? RSS JMP *+3 . NO OK JSB ERMSG "CANNOT HAVE MA TO LOCAL NODE" DEF ERMS5 * DLD @MATO,I GET OPTIONAL TIMEOUT SZA,RSS JMP DTO NOT GIVEN, GET DEFAULT CPA D1 NUMERIC? JMP DTO+1 . YEP USE IT CPB "/D" DEFAULT REQUESTED? JMP DTO JSB ERMSG "INVALID MA TIMEOUT" DEF ERMS2 DTO LDB MATL DEFAULT TIMEOUT SSB CHECK FOR NEGATIVE NUMBER JMP DTO-2 BADO BADO RBL,RBL ALLOW FOR STATE WORD STB @TBL+2 * * VERIFY THAT # RETRYS * MA TIMEOUT <= MASTER TIMEOUT * RBR,RBR LDA B MPY #MARL RETRYS * MATO CMA,INA STA TMP SAVE FOR NOW DLD @MTO,I GET MASTER TIMEOUT FROM STRING SZA,RSS GET DEFAULT IF LDB MSTO NONE SPECIFIED SZB,RSS GET MASTER TIMEOUT IF LDB MSTO ZERO SPECIFIED CPB "/D" OR GET MASTER TIMEOUT LDB MSTO IF DEFAULT SPECIFIED ADB TMP SSB JMP BADTO BAD TIMEOUT *-- MOVE MA TABLE ENTRY INTO SAM LDA @TBL LDB PTR JSB MOVE STB PTR --> NEXT MA ENTRY * * CHECK FOR VALID NUMBERr OF REMAINING MA ENTRIES * (IE., N >= M) * CKCNT LDA N CMA ADA M SSA JMP #MA3,I JSB ERMSG "INCORRECT NUMBER OF MA NODES" DEF ERMS6 SPC 2 BADTO JSB ERMSG "MA TIMEOUT * RETRYS > MASTER TIMEOUT" DEF ERMS4 SPC 2 MOVE NOP JSB $LIBR TURN OFF INTERRUPTS NOP DMS1 JMP MOVE2 'NOP'ED IF DMS JSB .LDX DEF ESIZE MWI MOVE BACK INTO SAM JMP MOVE3 MOVE2 JSB .MVW MOVE BACK INTO SAM DEF ESIZE NOP MOVE3 JSB $LIBX TURN INTERRUPTS ON DEF *+1 DEF *+1 JMP MOVE,I SKP *----------------------------------------------------------* * CONSTANTS *----------------------------------------------------------* A EQU 0 B EQU 1 * "/D" ASC 1,/D "MA" ASC 1,MA N1 DEC -1 D1 DEC 1 D5 DEC 5 D15 DEC 15 MATL DEC 3 DEFAULT TIMEOUT SECONDS MARL DEC 13 DEFAULT MAX RETRY LIMIT BIT13 OCT 020000 ESIZE ABS #SIZE UPPER OCT 177400 ALRN OCT 040020 ALHC OCT 000001 @TBL DEF *+1 INITIAL MA TABLE ENTRY OCT 0 +0 NODE NUMBER WILL BE FILLED IN OCT 0 +1 MASW OCT 1 +2 VA OCT 2 +3 VT1/VT2 OCT 1 +4 VR OCT 0 +5 VF OCT 0 +6 VC OCT 0 +7 VCC/VCD OCT 0 +8 LERC OCT 0 +9 LERN SUP MAMS1 DEF *+3 DEF *+1 ABS ERMS1-*-1 ASC 19,ENTER # OF MA NODES [,RETRY LIMIT]? _ ERMS1 DEF *+3 DEF *+1 ABS ERMS2-*-1 ASC 13,INVALID MA SPECIFICATION! ERMS2 DEF *+3 DEF *+1 ABS ERMS3-*-1 ASC 10,INVALID MA TIMEOUT! ERMS3 DEF *+3 DEF *+1 ABS ERMS4-*-1 ASC 21,INVALID MA RETRY LIMIT! EXCEEDS RANGE 1-15 ERMS4 DEF *+3 DEF *+1 ABS ERMS5-*-1 ASC 20,(MA TIMEOUT * RETRYS) > MASTER TIMEOUT! ERMS5 DEF *+3 DEF *+1 d ABS ERMS6-*-1 ASC 15,CANNOT HAVE MA TO LOCAL NODE! ERMS6 DEF *+3 DEF *+1 ABS ERMS7-*-1 ASC 15,INCORRECT NUMBER OF MA NODES! ERMS7 EQU * UNS *----------------------------------------------------------* * STORAGE *----------------------------------------------------------* PTR BSS 1 M BSS 1 N BSS 1 RL BSS 1 TMP BSS 1 MSTO BSS 1 SIZE EQU * END T< J T 91750-18136 2013 S C0122 &MATIC              H0101 sASMB,Q,C HED MA 'WATCH DOG' TIMER * (C) HEWLETT-PACKARD CO. 1980 NAM MATIC,19,30 91750-16136 REV 2013 800423 ALL (MA) SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 EXT #MARN,#GRPM,#MCTR,#MTBL,#MARL,#MHCT,DTACH EXT RNRQ,EXEC,XLUEX,$LIBR,$LIBX,.MVW,.LDX EXT #NRVS,$OPSY,#LEVL,#NODE SPC 2 * MATIC * -------------- * SOURCE PART # 91750-18136 * REL. PART # 91750-16136 * PROGRAMMER TOM MILNER * WRITTEN 06.19.79 SPC 2 * MATIC IS THE 'WATCH DOG' TIMER FOR MESSAGE ACCOUNTING (THE * DS/1000 END-TO-END PROTOCOL). IT SHOULD BE SCHEDULED TO RUN * EVERY SECOND (UPLIN CURRENTLY DOES THIS). ITS OPERATION IS * AS FOLLOWS: * * 1. ACCESS TO THE MA TABLE IS DISABLED (BY RESOURCE NUMBER). * 2. THE NEXT MA ENTRY IS MOVED TO A LOCAL BUFFER (FOR EASY * ACCESS. * 3. IF THE TRANSMISSION TIMEOUT CLOCK (VT1) IS RUNNING... * 3A. VT1 IS DECREMENTED (CLOCK TICK). * 3B. IF A TIMEOUT OCCURS (VT1=0) THEN THE CANCELATION * TIMER (VCC) IS INCREMENTED. * 3C. IF VCC < 4 THEN A CANCEL MESSAGE IS SENT. * 3D. IF VCC >= 4 THEN A 'NO RESPONSE' MESSAGE IS SENT * TO THE LOCAL GRPM TO INFORM #MAPP THAT NOTHING HAS * COME FROM THE OTHER SIDE OF THE CHANNEL. * 4. IF THE IDLE CLOCK IS RUNNING (VT2) THEN... * 4A. VT1 IS DECREMENTED. * 4B. IF VT1 = 0 THEN A 'RECEIVER READY' MESSAGE IS SENT * TO THE OTHER NODE. * 5. IF THE 'DIRTY BIT' IS SET THEN THE MA TABLE ENTRY IS * WRITTEN BACK. * 6. ACCESS TO THE MA TADBLE IS RE-ENABLED. * 7. THE ABOVE STEPS ARE REPEATED FOR EVERY MA TABLE ENTRY SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SPC 1 A EQU 0 B EQU 1 SKP MATIC EQU * JSB DTACH DEF *+1 JSB CONFG ONE TIME CHECK FOR DMS DLD #MCTR (-) NUMBER OF MA ENTRIES SZA,RSS ANY ENTRIES? JMP EXIT . NO RETURN, NOTHIN' TO DO... STA CTR ELB,CLE,ERB CLEAR SIGN BIT (DEBUG FLAG) STB LINK CLA STA DIRTY INITIALIZE DIRTY BIT TO 'CLEAN' * CYCLE NOP ... FOR TIMING... NOP NOP JSB RNRQ LOCK MA TABLE DEF *+4 DEF LK DEF #MARN MA RESOURCE NUMBER DEF TMP (DUMMY ENTRY) ZERO NOP * LDB LINK --> NEXT MA TABLE ENTRY JSB LODWD GET NODE SSA DUMMY ENTRY? JMP FINI . YES EXIT LOOP JSB FETCH GET ENTRY * LDA VA OUTSTANDING CPA VS MESSAGES ? JMP TIME? . NO LDA VT1 IF TIMER IS NOT SZA,RSS RUNNING, SET IT LDA D2 TO TWO TIMER STA VT1 "TICKS" * * CHECK FOR TRANSMISSION TIMEOUT * TIME? EQU * LDA VT1 SZA,RSS CLOCK RUNNING? JMP IDLE . NO CHECK IDLE CLOCK ISZ DIRTY SET DIRTY BIT ADA N1 TICK STA VT1 SZA TIMEOUT? JMP IDLE . NO CHECK IDLE CLOCK * * ACK TIMED OUT * LDA VCC CHECK FOR TOO MANY CANCELS INA STA VCC BUMP CONSECUTIVE CANCEL COUNTER CMA ADA #MARL SSA,RSS VCC EXCEEDS MAX? JMP CAN . NO SEND (ANOTHER) CANCEL MSG * * TOO MANY CONSECUTIVE TIMEOUTS; SEND 'NO RESPONSE' TO GRPM * LDA .NR JSB FMT LDA MSS+#STR MAKE REQUEST LOOK LIKE IOR BIT14 A REPLY... STA MSS+#STR CLA SEND TO LU=0 JSB SEND JMP FINI * * SEND 'CAN' MESSAGE TO NODE & RESET TIMER * CAN LDA TMAX STA VT1 LDA .CAN JSB FMT FORMAT MA MESSAGE * JSB #NRVS FIND LU OF NODE DEF *+2 DEF NODE JMP FINI E (ERROR RETURN) JSB SEND CLASS WRITE/READ * * CHECK IDLE TIMER; IF TIMEOUT SEND 'RR' * IDLE LDA VT2 SZA,RSS IDLE CLOCK RUNNING? JMP FINI . NO END OF LOOP ISZ DIRTY INDICATE ENTRY MODIFIED ADA N1 TICK STA VT2 SZA TIMEOUT? JMP FINI . NO * LDA .RR RECEIVER READY (AND IDLE) MESSAGE JSB FMT FILL REQUEST BUFFER * JSB #NRVS DEF *+2 DEF NODE JMP FINI (ERROR RETURN) JSB SEND CLASS WRITE/READ * * FINISHED W/ THIS ENTRY; RESTORE IF MODIFIED * FINI LDA DIRTY CHECK DIRTY BITS SZA 'DIRTY' ENTRY JSB STORE . YES RESTORE ENTRY * JSB RNRQ UNLOCK MA TABLE DEF *+4 DEF UNLK DEF #MARN DEF TMP NOP * LDA LINK ADA RECLN --> NEXT ENTRY STA LINK ISZ CTR JMP CYCLE CONTINUE IF MORE * EXIT JSB EXEC BYE BYE DEF *+4 DEF D6 DEF D0 DEF N1 SAVING RESOURCES... SKP *----------------------------------------------------------- * SUBROUTINES *----------------------------------------------------------- SPC 2 * SEND- WRITES OUT REQUEST BUFFER; =LU * BSS 1 (STORAGE) SEND NOP IOR BIT15 BYPASS SESSION SST STA LU * LDA #GRPM SET THE IOR BIT15 NO STA SEND-1 WAIT BIT!!! * JSB XLUEX CLASS WRITE/READ DEF *+8 DEF CLS20 DEF LU DEF ZERO NO DATA DEF ZERO DATA LENGTH = 0 @MSS DEF MSS REQUEST BUF DEF MSSLN REQUEST LENGTH DEF SEND-1 GRPM'S CLASS NOP JMP SEND,I LU NOP CONWD OCT 010100 CONTROL WORD SPC 2 * FMT- FORMAT LOCAL REQUEST BUFFER, = MA MESSAGE * BSS 1 (STORAGE) FMT NOP STA CFMT-1 SAVE MA MESSAGE CLA STA MSS CLEAR BUFFER LDA @MSS LDB @MSS INB JSB .MVW DEF MSSLN NOP LDA STREM STREAM WORD STA MSS+#STR LDA #NODE STA MSS+#SRC LDA NODE STA MSS+#DST ASSUME 'NODE' IS DESTINATION NODE LDA #LEVL STA MSS+#LVL LDA #MHCT SET HOP COUNT STA MSS+#HCT LDA VS ADA N1 NS:=VS-1 SZA,RSS ADA DIFF ADJUST FOR ROLLOVER LDB STATE CPB .DOWN IF CHANNEL IS DOWN CCA SET INITIALIZATION INDICATOR STA MSS+#MAS LDA VR STA MSS+#MAR LDA VC STA MSS+#MAC CCA STA MSS+#REP MA INDICATOR LDA FMT-1 MA MESSAGE STA MSS+#REP+1 LDA LLU SET MA ASSIGNMENT BIT IOR BIT11 (BIT11) IN THE STA LLU LAST LU WORD JMP FMT,I SPC 2 * LODWD- GET WORD FROM SAM --> SAM * LODWD NOP DMS3 JMP *+4 NOP IF DMS XLA B,I RSS LDA B,I JMP LODWD,I SPC 2 * BEGIN-FETCH * FETCH NOP STA NODE LDA LINK -->NEXT ENTRY (SAVE FOR STORE) LDB @REC -->LOCAL BUFFER DMS1 JMP *+5 'NOP'ED IF DMS JSB .LDX DEF RECLN MWF JMP *+4 JSB .MVW DEF RECLN NOP *-- UNPACK CHANNEL RECORD CLA LDB .TBL+1 STATE WORD WHEN PACKED LSR 2 ISOLATE STATE RAL,RAL STA STATE LSR 8 ISOLATE MAX TIMEOUT VALUE ALF,ALF STA TMAX LSR 2 VS OFFSET (VSO) WHEN PACKED ADB VA CALCULATE VS SSB ADB OFFST ADJUST FOR ROLLOVER STB VS VS:=VA+OFFSET FROM VA LDB .TBL+3 VT1 AND VT2 WHEN PACKED CLA LSR 8 ISOLATE VT2 ALF,ALF STA VT2 STB VT1 LDB .TBL+7 LSR 12 BLF X LSR 4 STB VCC CANCEL COUNTER STA VCD DOWN COUNTER JMP FETCH,I SPC 1 MACTR NOP NUMBER OF MA TABLE ENTRIES @REC DEF .TBL --> START OF PACKED RECORD RECLN DEC 10 LENGTH OF MA ENTRY .NON DEC 1 NON-MA STATE DIFF OCT 077777 (SUBTRACTION) CONSTANT FOR ROLLOVER OFFST OCT 100001 (ADDITION) CONSTANT FOR ROLLOVER SPC 2 * STORE- PACKS AND RESTORES CHANNEL RECORD * STORE NOP CLA STA DIRTY SET DIRTY BITS TO 'CLEAN' *-- PACK CHANNEL RECORD LDA VCD ALF LDB VCC LSR 4 STA .TBL+7 LDA VT2 LSL 8 LDB VT1 LSR 8 STA .TBL+3 TIMERS (VT1/VT2) LDA TMAX RAL,RAL IOR STATE LSL 4 LDB VA CMB,INB ADB VS CALCULATE VSO = VS-VA SSB ADB DIFF ADJUST FOR ROLLOVER LSR 4 STA .TBL+1 STATE WORD (MSW) WHEN PACKED LDA NODE STA .TBL RESTORE NODE NUMBER * JSB $LIBR TURN OFF INTERRUPTS NOP LDA @REC -->LOCAL BUFFER LDB LINK -->SAM DMS2 JMP ST2 'NOP'ED IF DMS JSB .LDX DEF RECLN MWI MOVE BACK INTO SAM JMP ST3 ST2 JSB .MVW MOVE BACK INTO SAM DEF RECLN NOP ST3 JSB $LIBX TURN INTERRUPTS BACK ON DEF *+1 DEF *+1 JMP STORE,I END-STORE * END-FETCH SKP *----------------------------------------------------------- * CONSTANTS *----------------------------------------------------------- STREM OCT 010000 STREAM WORD BIT11 OCT 004000 MA ASSIGNMENT BIT BIT14 OCT 040000 REPLY BIT BIT15 OCT 100000 N1 DEC -1 D0 DEC 0 D2 DEC 2 D6 DEC 6 .RR DEC 1 .CAN DEC 8 .NR DEC 16 * .DOWN OCT 0 .UP OCT 2 .PEND OCT 3 * CLS20 DEF 20,I LK OCT 040001 UNLK OCT 040004 MSSLN ABS #REP+2+#LSZ *-----------------------R*($------------------------------------ * STORAGE *----------------------------------------------------------- CONFG NOP CONFIGURE IF DMS (ROUTINE OVERLAYED) CLA CCB ADB CONFG ADDRESS OF CALL STA B,I NOP CALL LDB $OPSY RBR,SLB DMS? RSS JMP CONFG,I . NO RETURN STA DMS1 STA DMS2 STA DMS3 JMP CONFG,I RETURN (END-CONFG) * ORG CONFG LINK BSS 1 . ADDRESS OF ENTRY NODE BSS 1 . NODE # OF CHANNEL IDX BSS 1 . INDEX INTO MA TABLE DIRTY BSS 1 . DIRTY BITS STATE BSS 1 . CHANNEL STATE TMAX BSS 1 . MAX TIMEOUT TICKS VS BSS 1 . SEND SEQUENCE # .TBL EQU * WORD ZERO OF TABLE ENTRY WHEN PACKED VT2 BSS 1 . RECEIVER IDLE TIMER VCD BSS 1 . # TIMES CHANNEL DOWN VA BSS 1 . ACKNOWLEDGEMENT VARIABLE VT1 BSS 1 . ACKNOWLEDGEMENT TIMER VR BSS 1 . RECEIVE SEQUENCE # VF BSS 1 . RECEIVE FLAGS VC BSS 1 . CANCEL FLAGS VCC BSS 1 . # CONSECUTIVE CANCELATIONS LERC BSS 1 . LAST ERROR / QUALIFIER REPORTED LERN BSS 1 . LAST NODE REPORTING ERROR * TMP BSS 1 CTR BSS 1 MSS BSS #REP+3+#LSZ LLU EQU MSS+#REP+1+#LSZ * SIZE EQU * END MATIC * K W 91750-18137 2013 S C0122 &MSTAT +              H0101 ~ASMB,C,Q HED MSTAT: 91750-1X137 REV 2013 (C) HEWLETT-PACKARD CO. 1980 NAM MSTAT,7 91750-1X137 REV 2013 791119 M SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: MSTAT * SOURCE: 91750-18137 * RELOC: 91750-1X137 * PGMR: DAN GIBBONS * *************************************************************** SPC 3 ENT FSTAT * EXT .ENTR,$CDIR EXT .MVW * PRAM NOP FSTAT NOP JSB .ENTR DEF PRAM LDA $ADR GET ADDRESS OF RTE-M FILE DIRECTORY RSS LDA 0,I RAL,CLE,SLA,ERA RESOLVE INDIRECT JMP *-2 ADA N1 STA ENTAD SAVE ADDR OF ADDR OF DIR. END INA LDB PRAM GET ADDRESS OF CALLERS BUFFER MVNXT JSB .MVW MOVE 4 WORD DIRECTORY ENTRY TO USERS BUFR DEF K4 NOP CPA ENTAD,I END OF CARTRIDGE DIRECTORY? CLA,RSS YES JMP MVNXT NO, MOVE ANOTHER ENTRY STA 1,I SET NEXT BUF WORD = 0 FOR END JMP FSTAT,I RETURN * ENTAD NOP K4 DEC 4 N1 DEC -1 $ADR DEF $CDIR * * SIZE EQU * * END B LR 91750-18138 2013 S C0122 &NATCH              H0101 oASMB,R,L NAM NATCH,7 91750-1X138 REV.2013 800229 ALL, W/O S.M. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 #ATCH * * NAME: NATCH * SOURCE: 91750-18138 * RELOC: PART OF 91750-12015 * PRGMR: JIM HARTSELL * * #ATCH NOP DUMMY #ATCH ROUTINE. CLA LDB #ATCH,I JMP 1,I * END  MS 91750-18139 2013 S C0122 &NCLON              H0101 ~ASMB,R,L NAM NCLON,7 91750-1X139 REV.2013 800229 ALL, W/O S.M. * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 #CLON * * NAME: NCLON * SOURCE: 91750-18139 * RELOC: PART OF 91750-12015 * PRGMR: JIM HARTSELL * * #CLON RPL 2001B REPLACE "JSB #CLON" WITH "RSS". * END  NT 91750-18140 2013 S C0122 &NONMA +              H0101 ASMB,R,Q HED DUMMY MA ROUTINES * (C) HEWLETT-PACKARD CO. 1980 NAM NONMA,7 91750-1X140 REV 2013 800415 ALL NMA ENT #MAAS,#MAPP,#MAQS,#MA1,#MA2,#MA3 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * NONMA * --------- * SOURCE PART # 91750-18140 * REL. PART # 91750-1X140 * PROGRAMMER TOM MILNER * WRITTEN 06.27.79 * * DUMMY LIBRARY TO BE USED IN PLACE OF MESSAGE ACCOUNTING * WHEN MESSAGE ACCOUNTING IS NOT DESIRED. SPC 2 #MAAS NOP MA ASSIGNMENT ROUTINE LDA #MAAS,I GOOD INA RETURN STA #MAAS ADDRESS CLA MA SEQUENCE NUMBER CLB INDICATE NO ERROR JMP #MAAS,I SPC 2 #MAPP NOP MA PRE/POST PROCESSOR (IN GRPM) ISZ #MAPP (RETURN TO P+2) JMP #MAPP,I SPC 2 #MAQS NOP MA QUIESCENCE ROUTINE JMP #MAQS,I SPC 2 #MA1 EQU * MA INITIALIZATION ROUTINES #MA2 EQU * #MA3 NOP CLA JMP #MA3,I END :u OU 91750-18141 2013 S C0122 &NONSM +              H0101 ASMB,R,L,C HED NONSM 91750-1X141 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM NONSM,7 91750-1X141 REV.2013 800407 ALL, W/O S.M. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #DISM,#DSSM,#RMSM,#MSSM ENT #SCSM,#ATCH,#UPSM,#OVR ENT D$OVR * SUP * * NAME: NONSM * SOURCE: 91750-18141 * RELOC: PART OF 91750-12012 * PRGMR: JIM HARTSELL * * DUMMY MODULE FOR DS/1000 NETWORKS WITH NO SESSION MONITOR NODES ANYWHERE * IN THE NETWORK OR IF THIS NODE WILL NEVER ACCESS A SESSION MONITOR NODE. * #UPSM RPL 0 REPLACE "JSB #UPSM" WITH "NOP". #DISM RPL 0 REPLACE "JSB #DISM" WITH "NOP". #DSSM RPL 0 REPLACE "JSB #DSSM" WITH "NOP". * D$OVR EQU * #OVR OCT 0 DUMMY REMOTE SESSION OVERRIDE FLAG. * #ATCH EQU * DUMMY #ATCH ROUTINE. #RMSM NOP DUMMY #RMSM ROUTINE. CLA LDB #RMSM,I JMP 1,I * #MSSM EQU * DUMMY #MSSM ROUTINE. #SCSM NOP DUMMY #SCSM ROUTINE. SZA,RSS ISZ #SCSM JMP #SCSM,I * END ^ PV 91750-18142 2013 S C0122 &OPERL              H0101 ASMB,R,L,C HED OPERM 91750-16142 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM OPERM,19,30 91750-16142 REV.2013 800418 L SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 1 ENT OPERM,CNOPT ENT CAM.O,ECH,C.BUF EXT EXEC,#SLAV,#GET,#GETR,#RSAX EXT BL..,CN..,LA..,TM..,TO..,IT..,ON..,SY.. EXT .MVW,PARSE,#NODE,#RPB EXT #ST07,.ENTR * * NAME: OPERL * SOURCE: 91750-18142 * RELOC: 91750-16142 * PGMR: JERRY BELDEN * DATE: 18 JUN 79 * * OPERM IS THE CCE MONITOR WHICH RECEIVES OPERATOR REQUESTS INIT- * IATED BY A REMOTE CPU. THIS MONITOR OPERATES ON STREAM 7. * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CGPODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP SUP OPERM LDA B,I GET INPUT PARAMETER STA CLSN NO - NORMAL SCHEDULE - SAVE CLASS NUMBER * OPER1 JSB #GETR WAIT FOR REQUEST DEF *+4 DEF CLSN CLASS # A.RQB DEF RQB REQUEST BUFFER DEF C#OLW MAX LENGTH JMP DON3 IGNORE THE COMMUNICATION ERROR * CLA CLEAR CLB ERROR DST RQB+#EC1 LOCATIONS. STA RQB+#ENO * LDA RQB+#DST IS THIS A LOCAL INA,SZA REQUEST FROM COMND? JMP REMOT NO, REAL DS LDA CLSN YES, AND CLMSK DE-ALLOCATE IOR BIT13 BUFFER STA TEMP JSB EXEC DEF *+5 DEF .21 DEF TEMP DEF RQB DEF .0 LDB RQB+#EHD GET LIST LU JMP OPER2 * REMOT JSB #GET DE-ALLOCATE BUFFER DEF *+6 AND LOG IF NEEDED DEF CLSN DEF RQB DEF C#OLW DEF .0 DEF .0 JMP DON3 IF ERROR, TERMINATE CLB GET REMOTE FLAG * OPER2 STB LOCLU SAVE LOCAL LU OR 0 CLA STA OUTFL RESET OUTPUT FLAG * LDA RQB+#CML GET LENGTH SZA,RSS IF ZERO...SEND BACK ZERO TO THEM JMP DONE * CPA .2 IF COMMAND = "XX", RSS JMP PARS LDA RQB+#CMS I.E. LOGON/OFF TO CPA "XX" NON-SESSION NODE, RSS JMP PARS LDA RQB+#LGC (EXCEPT SPECIAL UPLIN LOG-OFF, CPA N1 JMP RLEAS IN WHICH CASE IGNORE REQUEST) SZA,RSS IF LOG-OFF, REPLY WITH DEST SID = 0, JMP DONE DLD "RS04 ELSE DST RQB+#EC1 REPLY WITH "S.M. NOT INSTALLED". LDA #NODE SET ASCII BIT AND NODE NUMBER. IOR BIT15 STA RQB+#EmNO JMP DONE GO SEND REPLY FOR ERROR. * RLEAS JSB #RSAX RELEASE TCB FOR IGNORED DEF *+4 NO-REPLY UPLIN DEF .7 LOG-OFF REQUEST. DEF RQB+#SEQ DEF RQB+#STR * JMP OPER1 GO WAIT FOR ANOTHER REQUEST. SKP * * CODE FOR COMND INSERTED HERE * PARS ARS CONVERT MESSAGE LENGTH (CHARS) STA ECH TO WORD COUNT JSB PARSE USE SYSTEM'S PARSER DEF *+4 DEF RQB+#CMS INPUT BUFFER DEF RQB+#CML CHARACTER COUNT DEF MRSLT PARSED PARAMETER BUFFER CCA SUBTRACT ONE FROM THE ADA P.CNT PARAMETER COUNT SINCE NOT PASSING STA P.CNT THE COMMAND AS A PARAMETER * * CHANGE PARAMETER TYPE 2 TO 3 * LDA N8 SET LOOP COUNTER STA CNT TO 8 LDA DMRLT GET PARSE RESULT BUFFER ADDRESS PARLP LDB A,I GET PARAMETER TYPE CPB .2 IS IT 2? INB YES, INCREMENT IT TO 3 STB A,I STORE BACK INTO BUFFER ADA .4 INCREMENT TO NEXT PARAMETER ISZ CNT INCREMENT THE COUNT JMP PARLP GO DO NEXT PARAMETER * LDB DMRLT GET ADDRESS OF THE FIRST PARAMETER INB POINT TO ACTUAL PARAMETER LDB B,I GET PARAMETER STB OPP STORE AS STOP WORD IN COMMAND TABLE * * GET COMMAND ADDRESS * LDA C.TAB GET COMMAND TABLE ADDRESS CMND? CPB A,I IF COMMAND SAME AS IN TABLE JMP CALL THEN GO SET UP COMMAND ADDRESS (CAD.) ADA .2 SKIP ADDRESS AND POINT TO NEXT COMMAND JMP CMND? CHECK NEXT ENTRY IN TABLE * CALL INA GET POINTER TO COMMAND ADDRESS LDA A,I THEN FETCH COMMAND ADDRESS STA CAD. AND STORE SKP * * CALL ACTION ROUTINE * CLA CLEAR ERROR CODE STA ER TO PASS TO ACTION ROUTINE JSB CAD.,I CALL ACTION ROUTINE DEF CALR DEF P.ޕCNT PARAMETER COUNT DEF P.RAM PARAMETER LIST DEF ER ERROR CODE * CALR LDA ER DID THE ROUTINE PASS BACK SZA AN ERROR? JMP ELOG GO REPORT ERROR * DONE LDA OUTFL ANY OUTPUT ? SZA JMP DON1 YES CONTINUE STA RQB+#RLN NO, SO INDICATE DON1 LDB LOCLU LOCAL ORIGINATION SZB JMP DON2 YES LDA RQB+#RLN SAVE LENGTH IN WORDS INTO REPLY ADA L#RLN ADD STANDARD LENGTH OF PARMB STA LEN SAVE AS REPLY LENGTH * LDA RQB+#STR GET STREAM TYPE IOR BIT14 SET IN FOR REPLY STA RQB+#STR SAVE AS REPLY STREAM * LDA A.RQB MOVE REPLY LDB A#RPB INTO #SLAV JSB .MVW DEF C#OLW NOP * JSB #SLAV SEND REPLY DEF *+4 DEF LEN DEF .0 DEF .0 NOP IGNORE THE ERROR RETURN * JMP OPER1 WAIT FOR ANOTHER REQUEST SKP * * LOCAL ORIGINATOR - DO OUTPUT * DON2 SZA,RSS ANY OUTPUT ? JMP DON3 NO JSB EXEC LOCAL, SO OUTPUT DIRECTLY DEF *+5 DEF .2 DEF LOCLU DEF RQB+#MSG DEF RQB+#RLN (+ WORDS) * * NOTE THAT #ST07+1 CONTAINS A NON-ZERO # IF OPERM WAS * SCHEDULED BY UPLIN OR LSTEN. OTHERWISE, MUST TERMINATE * & DEALLOCATE CLASS. * DON3 LDA #ST07+1 CHECK FOR CLASS # XOR CLSN EQUAL TO THAT AND CLMSK OF DS SZA,RSS JMP OPER1 RUNNING UNDER DS, GO TO 'GET' * JSB EXEC TERMINATE, NO RESOURCES SAVED DEF *+2 DEF .6 SKP * * COMMAND TABLE * C.TAB DEF *+1 ASC 1,BL DEF BL.. ASC 1,CN DEF CN.. ASC 1,LA DEF LA.. ASC 1,TM DEF TM.. ASC 1,TO DEF TO.. ASC 1,IT DEF IT.. ASC 1,ON DEF ON.. ASC 1,EX DEF EX.. * OPP NOP END OF TABLE DEF SY.. * SKP * * ERROR HANDLER * ELOG LDB BLNK SET DEFAULT TO POSITIVE SSA POSITIVE OR NEGATIVE? LDB BSIGN NEGATIVE, GET MINUS SIGN STB ESGN SAVE ASCII SIGN SSA NEGATIVE? CMA,INA YES SET POSITIVE CLB CLEAR B FOR DIVIDE DIV .10 DIVIDE BY 10. TWO DIGIT ERRORS ONLY ADB B60 MAKE REMAINDER ASCII ADA B60 MAKE QUOTIENT ASCII ALF,ALF POSITION QUOTIENT TO UPPER HALF IOR B PUT IN SECOND DIGIT STA ERCDE PUT INTO ERROR MESSAGE * LDA AERBF TRANSFER TO REPLY BUFFER LDB A#MSG DESTINATION JSB .MVW DEF .4 NOP LDA .4 STA RQB+#RLN SAVE LENGTH IN WORDS IN REPLY ISZ OUTFL INDICATE SOME OUTPUT JMP DONE * ERBUF ASC 2,CMND ESGN NOP SIGN ERCDE NOP ERROR CODE IN ASCII * BLNK ASC 1, BSIGN ASC 1, - SKP * * CENTRAL OUTPUT ROUTINE - CALLED FROM ACTION ROUTINES IN * PLACE OF EXEC 2. OUTPUT TO REMOTE SITES GOES BACK IN * THE REPLY SO ONLY ONE LINE OF OUTPUT IS ALLOWED. LAST * CALL TO THIS SUBROUTINE DICTATES WHAT IS RETURNED. * OCODE NOP EXEC CODE NOP OUTPUT LU OBUFF NOP OUTPUT BUFFER OLENG NOP OUTPUT LENGTH * CNOPT NOP ENTRY POINT JSB .ENTR DEF OCODE LDA OLENG,I CHECK LENGTH SPECIFIER SSA,RSS JMP CNOP1 IN WORDS CMA,INA CONVERT BYTES TO WORDS CLE,ERA CNOP1 SZA,RSS ANYTHING THERE ? JMP CNOP2 NO STA RQB+#RLN SAVE BUFFER LENGTH ISZ OUTFL INDICATE OUTPUT WAITING LDA OBUFF MOVE MESSAGE TO REPLY BUFFER LDB A#MSG JSB .MVW DEF RQB+#RLN NOP CNOP2 JMP CNOPT,I SKP * * EXIT ACTION ROUTINE * EX.. NOP JMP DONE SKP * * CONSTANTS * .0 DEC 0 .2 DEC 2 .4 '*($DEC 4 .6 DEC 6 .7 DEC 7 .10 DEC 10 .21 DEC 21 N1 DEC -1 N8 DEC -8 N18 DEC -18 N64 DEC -64 B60 OCT 60 BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 CLMSK OCT 17777 "XX" ASC 1,XX "RS04 ASC 2,RS04 * DMRLT DEF MRSLT A#MSG DEF RQB+#MSG A#RPB DEF #RPB AERBF DEF ERBUF * A EQU 0 B EQU 1 SPC 2 * * VARIABLES * RQB BSS #OLW LOCAL BUFFER FOR REQUEST/REPLY C.BUF EQU RQB+#CMS CAM.O NOP LOG LU * CAD. NOP COMMAND ADDRESS FORM C.TAB MRSLT BSS 4 \ ORDERED COMMAND PARAMETER P.RAM BSS 28 > PARAMETER LIST P.CNT NOP / PARAMETER COUNT ECH NOP INPUT WORD COUNT CNT NOP LOOP COUNTER ER NOP ERROR CODE FOR ACTION ROUTINES CLSN NOP TEMP NOP C#OLW ABS #OLW L#RLN ABS #RLN+1 HEADER LEN + 1 FOR MSG LEN WORD LEN NOP OUTFL NOP OUTPUT PENDING FLAG LOCLU NOP LU IF LOCAL ORIGIN OR 0 * END OPERM * Q ] 91750-18143 2013 S C0122 &OPERM              H0101 ASMB,R,Q,C HED OPERM 91750-16143 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM OPERM,19,30 91750-16143 REV.2013 800227 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 1 ENT OPERM EXT MESSS,#SLAV,#GET,#RSAX EXT #NODE,#RPB,#ATCH,DTACH RQB EQU #RPB SUP * * NAME: OPERM * SOURCE: 91750-18143 * RELOC: 91750-16143 * PGMR: JIM HARTSELL, ET AL * * MODIFIED BY JDH FOR DS REQUEST EQUATED OFFSETS 790220 * MODIFIED BY GAB FOR 91750 PRODUCT 790604 * MODIFIED BY JDH FOR REMOTE SESSION 790822 * * OPERM IS THE DS/1000 SLAVE MONITOR WHICH RECEIVES OPERATOR REQUESTS * INITIATED BY A REMOTE CPU. THIS MONITOR OPERATES ON STREAM 7. * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV XXXX 790531 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP OPERM LDA B,I GET INPUT PARAMETER YSTA CLSN SAVE CLASS NUMBER JSB DTACH DETACH IN CASE DINIT DEF *+1 WAS RUN UNDER SESSION * OPER1 JSB #GET WAIT FOR REQUEST. DEF *+6 DEF CLSN CLASS # DEF RQB REQUEST BUFFER DEF C#OLW MAX LENGTH DEF TEMP NO DATA. DEF B0 JMP OPER1 IGNORE ERROR * CLA CLEAR ERROR LOCATIONS. CLB DST RQB+#EC1 LDA #NODE INITIALIZE FOR LOCAL NODE #. STA RQB+#ENO LDA C#MHD INITIALIZE LEN PARAM. STA LEN * LDA RQB+#CML GET LENGTH SZA,RSS IF ZERO...SEND BACK ZERO TO THEM JMP DONE * CPA B2 IF COMMAND = "XX" RSS JMP GTSES LDA RQB+#CMS I.E. LOGON/OFF TO NON-SESSION NODE, CPA "XX" RSS JMP GTSES LDA RQB+#LGC (EXCEPT SPECIAL UPLIN LOG-OFF) CPA N1 JMP RLEAS (IN WHICH CASE IGNORE REQUEST) SZA,RSS IF LOG-OFF, REPLY WITH DEST SID = 0, JMP DONE ELSE LDA "04" JMP RSERR REPLY WITH "S.M. NOT INSTALLED". * RLEAS JSB #RSAX RELEASE TCB FOR IGNORED DEF *+4 NO-REPLY UPLIN DEF B7 LOG-OFF REQUEST. DEF RQB+#SEQ DEF RQB+#STR * JMP OPER1 GO WAIT FOR ANOTHER REQUEST. * GTSES LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (IF ANY). STA TEMP SAVE SESSION ID FOR CALL * JSB #ATCH ATTACH TO THE SESSION CONTROL BLOCK. DEF *+2 (IF ANY) DEF TEMP * INA,SZA CHECK STATUS. JMP XCUTE SUCCESSFUL ATTACH. * LDA "01" "SCB NOT FOUND". RSERR STA RQB+#EC2 STORE ERROR TYPE. LDA "RS" STA RQB+#EC1 LDA RQB+#ENO SET "ASCII" BIT. IOR BIT15 STA RQB+#ENO CLA JMP DONE GO SEND REPLY FOR ERROR. * XCUTE JSB MESSS CALL SYSTEM MSG PROCESSOR WITH MESSAGE DEF *+3  DEF RQB+#CMS THE REPLY WILL COME IN THE SAME AREA DEF RQB+#CML * CMA,INA MAKE SYSTEM REPLY LENGTH POSITIVE BYTES CLE,ERA MAKE THIS POSITIVE WORDS SEZ INA DONE STA RQB+#RLN SAVE LENGTH IN WORDS INTO REPLY ADA L#MSG ADD STD LENGTH OF PARMB & LENGTH WORD STA LEN SAVE AS REPLY LENGTH * JSB DTACH DETACH FROM POSSIBLE SESSION CNTRL BLK DEF *+1 * LDA RQB+#STR GET STREAM TYPE IOR BIT14 SET IN FOR REPLY STA RQB+#STR SAVE AS REPLY STREAM * JSB #SLAV SEND REPLY DEF *+4 DEF LEN DEF B0 DEF B0 NOP IGNORE THE ERROR RETURN * JMP OPER1 WAIT FOR ANOTHER REQUEST * B EQU 1 B0 OCT 0 B2 OCT 2 B7 OCT 7 N1 DEC -1 B377 OCT 377 BIT14 OCT 40000 BIT15 OCT 100000 "01" ASC 1,01 "04" ASC 1,04 "RS" ASC 1,RS "XX" ASC 1,XX TEMP NOP CLSN NOP C#OLW ABS #OLW C#MHD ABS #MHD L#MSG ABS #MSG LEN NOP * END OPERM ! R[ 91750-18144 2013 S C0122 &OTCNV              H0101 ASMB,R,Q,C HED OTCNV 91750-16144 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM OTCNV,19,20 91750-16144 REV.2013 791219 SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT OTCNV * EXT EXEC,DTACH,#GETR,#GRPM,#CVBF,#OTCV,.MVW EXT #BREJ,#NRVS,$CVT1,CNUMD,REIO,$TIME,#QCLM EXT XLUEX,#INCV,#OCV0 * SUP * ************************ * NAME: OTCNV * * * SOURCE: 91750-18144 * THIS VERSION RUNS IN * * RELOC: 91750-16144 * MESSAGE FORMAT * * PGMR: JIM HARTSELL * LEVEL 1 NODES * * * * * ************************ * * * OTCNV IS AN OUTGOING-MESSAGE CONVERTER THAT CONVERTS MESSAGES FROM * THE LOCAL UPGRADE LEVEL "DOWN" TO THE FORMAT REQUIRED BY THE DESTINA- * TION NODE. THE LOCAL UPGRADE LEVEL IS INDICATED BY #LEVL (IN RES). * THE DESTINATION UPGRADE LEVEL IS FOUND BY SEARCHING THE NRV. * A GIVEN VERSION, OR "LEVEL" OF OTCNV WILL NOT KNOW ABOUT HIGHER LEVEL * FORMATS. THESE WILL BE CONVERTED AT THE DESTINATION NODE BY INCNV. * ALL VERSIONS OF OTCNV CAN CONVERT DOWN TO LEVEL 0. * * FOR EXAMPLE: THE GENERAL DS SOFTWARE AT A NODE WHICH OPERATES AT * UPGRADE LEVEL 1 ONLY KNOWS HOW TO BUILD MESSAGES FOR LEVEL 1 FORMAT. * IT DOESN'T KNOW ABOUT OTHER LEVEL FORMATS. BEFORE SENDING THE REQUEST, * #MAST AND #SLAV CHECK THE DESTINATION NODE UPGRADE LEVEL IN THE NRV. * IF THE DESTINATION LEVEL IS LOWER THAN` THE LOCAL NODE LEVEL, THE * REQUEST IS SENT TO OTCNV TO BE CONVERTED "DOWN" BEFORE BEING SENT. * * TO EXTEND OTCNV FOR THE NEXT UPGRADE LEVEL, * * 1. SET MAX, HDR EQUATES FOR NEW LEVEL. * 2. REPLACE GLOBAL EQUATE BLOCK WITH NEW FORMAT DEFINITIONS. * 3. ADD ENTRY TO FMTBL & TOTBL. * 4. ADD FROMX AND TOX TABLE. * 5. ADD ENTRY TO SPECL (ADD "EXT" IF ROUTINE REQUIRED). * * MAX EQU 37 MAX REQ SIZE FOR ALL LEVELS. HDR EQU 13 MAXIMUM HEADER SIZE, ALL LEVELS. SKP * * THE FOLLOWING GLOBAL EQUATE BLOCK MUST DEFINE MESSAGE HEADER FORMAT * FOR LEVEL OF NODE IN WHICH THIS VERSION OF OTCNV IS RUNNING. * * * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SIDtN EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP BASE EQU * FWA OTCNV FOR GETTING REL ADDR. SPC 3 * ******************************************* * * * * * C O N V E R S I O N T A B L E S * * * * * ******************************************* SPC 2 * * WHEN CONVERTING FROM A NEWER FORMAT TO THE NEXT LOWER LEVEL, THE * FORMAT LEVEL NUMBER OF THE OLDER FORMAT IS USED AS THE OFFSET INTO * BOTH THE "FROM TABLE" (FMTBL) AND THE "TO TABLE" (TOTBL). IN OTHER * WORDS, WHEN THE OLDER FORMAT IS LEVEL 0, THEN OFFSET 0 IN BOTH TABLES * SPECIFIES CONVERSION FROM FORMAT LEVEL 1 (FROM1) TO FORMAT LEVEL 0 (TO0). * SPC 3 FMTBL DEF *+1 DEF FROM1 FROM LEVEL 1. DEF FROM2 FROM LEVEL 2. * . * . * . SPC 5 TOTBL DEF *+1 DEF TO0 TO LEVEL 0. DEF TO1 TO LEVEL 1. * . * . * . SPC 3 * * TABLE OF ENTRY POINTS FOR OPTIONAL EXTERNAL REQUEST-SPECIFIC * CONVERSION ROUTINES. USE SUBROUTINE NAMES OF THE FORM #OCV0, #OCV1,... * IF APPLICABLE FOR THAT LEVEL. IF NO REQUEST-SPECIFIC CONVERSION * IS NEEDED, JUST USE THE DUMMY "NULL". * SPECL DEF *+1 DEF #OCV0 LEVEL 1 TO LEVEL 0 SPECIFICS (EXT). * . * . * . * * TABLES CONTINUED NEXT PAGE.... SPC 3 Zo* * THE FOLLOWING TABLES WORK IN PAIRS TO SPECIFY MAPPING FROM ONE FORMAT * LEVEL TO ANOTHER, I.E., FROM1-TO0, FROM2-TO1, ETC. THE SAME OFFSET IS * USED INTO BOTH TABLES FOR EACH WORD THAT IS TRANSFERRED. * * THE "FROM" HALF SPECIFIES AN OFFSET FOR EVERY WORD TO BE TRANSFERRED TO * THE NEXT LEVEL. THE FIRST AND SECOND WORDS SPECIFY THE SIZE OF THE * HEADER FOR THE REQUEST AND REPLY, RESPECTIVELY. THE THIRD WORD INDICATES * THE # OF *REQUEST* WORDS TO BE MOVED (NEG) TO THE NEXT LOWER FORMAT LEVEL. * * THE "TO" HALF SPECIFIES THE TARGET OFFSET INTO THE OLDER FORMAT WHERE * THE CORRESPONDING WORD FROM THE NEWER FORMAT IS TO BE STORED. THE FIRST * AND SECOND WORDS SPECIFY THE SIZE OF THE HEADER FOR THE REQUEST AND * REPLY, RESPECTIVELY. THE THIRD WORD INDICATES THE # OF *REPLY* WORDS * TO BE MOVED (NEG) TO THE NEXT LOWER FORMAT LEVEL. * * WARNING: THE SIZE OF THE FORMAT LEVEL 0 REQUEST HEADER AT "TO0" IS * TEMPORARILY MODIFIED BY OTCNV FOR PTOP AND DLIST (7 WORD HEADER) * REQUESTS. * SPC 3 FROM1 DEC 13 SIZE OF FORMAT 1 REQUEST HEADER. DEC 13 SIZE OF FORMAT 1 REPLY HEADER. DEC -4 NEG. # WORDS TRANSFERRED IF *REQUEST*. B1 DEC 1 WORD 1 = STREAM WORD. DEC 2 WORD 2 = SEQUENCE #. DEC 3 WORD 3 = SOURCE NODE #. B4 DEC 4 WORD 4 = DEST. NODE #. DEC 5 WORD 5 = EC1. B6 DEC 6 WORD 6 = EC2. B7 DEC 7 WORD 7 = ERROR NODE NUMBER. * FROM2 DEC 0 RESERVED FOR LEVEL 2 CONVERTER. * . * . * . SPC 2 TO0 DEC 4 SIZE OF FORMAT 0 REQUEST HEADER. DEC 7 SIZE OF FORMAT 0 REPLY HEADER. DEC -7 NEG. # WORDS TRANSFERRED IF *REPLY*. DEC 1 WORD 1 = STREAM WORD. DEC 2 WORD 2 = SEQUENCE #. DEC 3 WORD 3 = SOURCE NODE #. DEC 4 WORD 4 = DEST. NODE #. DEC 5 WORD 5 = EC1. 0] DEC 6 WORD 6 = EC2. DEC 7 WORD 7 = ERROR NODE NUMBER. * TO1 DEC 0 RESERVED FOR LEVEL 2 CONVERTER. * . * . * . SKP A EQU 0 B EQU 1 * OTCNV JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * LDA TO0 SAVE SIZE OF FORMAT LEVEL 0 STA SAVET REQUEST HEADER. * * GET A REQUEST TO BE CONVERTED (FORMAT LEVEL SHOULD BE THAT * OF NODE IN WHICH OTCNV IS RUNNING). * OTGET LDA RQBA RESET ADDR OF OUTPUT BUFFER. STA RQADR LDA SAVET RESTORE SIZE OF FORMAT LEVEL 0 STA TO0 REQUEST HEADER. * CLA CLEAR ERROR FLAG. STA TEMP * JSB #GETR GET A REQUEST (AND DATA). DEF *+6 DEF #OTCV CLASS # FOR OTCNV. RQBA DEF RQB INTERNAL REQUEST BUFFER. DEF C#MAX MAXIMUM REQUEST LENGTH. DEF #CVBF+1 EXTERNAL DATA BUFFER. DEF #CVBF MAXIMUM DATA LENGTH. ISZ TEMP ERROR RETURN. SET FLAG. * STA RQLEN SAVE ACTUAL REQUEST LENGTH. STB DAINL SAVE ACTUAL DATA LENGTH. * JSB EXEC CLEAR BUFFER IN S.A.M. DEF *+5 DEF CLS21 DEF #OTCV DEF #CVBF+1 DEF B0 NOP IGNORE ERROR RETURN. * LDA TEMP ERROR ON ORIGINAL "GET"? SZA JMP OTGET YES. * LDA RQB+#STR NO. IF REPLY, RAL SSA,RSS JMP GTFMT LDA RQB+#ENO AND #ENO BIT 15 IS SET, SSA,RSS JMP GTFMT LDA RQB+#EC1 AND #EC1 = "DS", CLB CPA "DS" STB DAINL CHOP OFF THE DATA. * * GET FORMAT LEVEL # OF RECEIVED REQUEST (SHOULD BE LEVEL OF NODE * IN WHICH OTCNV IS RUNNING). * GTFMT LDB RQB+#STR FIRST CHECK BIT 12 OF STREAM WORD. BLF SLB,RSS JSB LOST ERROR (NO RETURN ON JSB). LDA RQB+#LVL GET "FORMAT LEVEL" WORD. AND B17 ZISOLATE BITS 0-3. ADA N1 DECREMENT DOWN ONE LEVEL. STA NXTLV SAVE AS "NEXT LEVEL". * LDA RQB+#STR GET REPLY BIT IN LSB. RAL,RAL AND B1 STA ADJMT 0 = REQUEST, 1 = REPLY. LDB RQB+#DST GET DESTINATION NODE SZA (DEPENDS WHETHER REQUEST OR REPLY). LDB RQB+#SRC STB DSTND * JSB #NRVS SEARCH THE NRV FOR THE NODE #. DEF *+4 DEF DSTND DEF TEMP DEF OLEVL FORMAT LEVEL # OF DEST. NODE. JSB LOST ERROR (NO RETURN ON JSB). * IOR BIT15 BYPASS SESSION SST. STA DSTLU SAVE LU FOR DEST. NODE. LDA NXTLV INCOMING LEVEL MINUS 1. CMA NEGATIVE INCOMING LEVEL (ACTUAL). ADA OLEVL ADD DESTINATION LEVEL #. SSA,RSS JMP SFAIL ERROR IF DEST LEVEL .GE. INCOMING LEVEL. * * STORE DESTINATION FORMAT LEVEL NUMBER IN THE REQUEST NOW (BECAUSE * WE ONLY HAVE THE GLOBAL EQUATE BLOCK FOR THE LEVEL OF THIS NODE). * LDA OLEVL CHECK LEVEL OF DESTINATION NODE. SZA JMP LV1UP * LDA RQADR,I CLEAR BIT 12 (IF DEST. = LEVEL 0). AND NOT12 STA RQADR,I JMP NXLEV * LV1UP LDB RQADR STORE DESTINATION LEVEL NUMBER. ADB C#LVL LDA B,I AND B7760 IOR OLEVL STA B,I * * IF CONVERTING PTOP OR DLIST REQUEST TO FORMAT LEVEL 0, MODIFY * THE HEADER SIZE SPECIFICATION AT "TO0". * NXLEV LDA ADJMT ADA NXTLV COMBINE ADJMT AND NXTLV. SZA IF BOTH ARE ZERO JMP BCONV (CONVERTING REQ TO LEVEL 0), LDA RQADR,I CHECK STREAM WORD OF REQUEST. AND B77 CLB SET DEFAULT MOD = NONE. SZA IF STREAM ZERO, CPA B1 OR DLIST, RSS CPA B4 OR PTOP, LDB B7 SET MOD = 7 WORD HEADER. SZB STB TO0 STORE NEW SIZE IF REQUIRED. * * BEGIN CONVERSION TO NEXT LOWER LQEVEL. * BCONV LDB NXTLV FIND "FROM" INDEX TABLE. ADB FMTBL LDB B,I GET POINTER TO REQ HEADER SIZE. STB FPTR ADB ADJMT IF REPLY, BUMP POINTER. STB FSZPT POINTER TO "FROM" HEADER SIZE. LDA B,I GET SIZE OF THE HEADER (POS.). ADA RQADR ADD TO START OF HEADER. STA BODAD ADDRESS OF BODY OF REQUEST. ISZ FPTR ISZ FPTR POINT TO # WORDS TO MOVE (IF REQUEST). * * CLEAR THE TEMPORARY BUFFER. * LDA TMPBF STA TPTR LDB N#HDR CLA CLRTM STA TPTR,I ISZ TPTR INB,SZB JMP CLRTM * * MOVE CURRENT HEADER TO TEMPORARY BUFFER (NEWER FORMAT). * LDA RQADR LDB TMPBF JSB .MVW DEF FSZPT,I NOP * * SET UP POINTERS AND COUNTERS FOR OLDER FORMAT. * LDB NXTLV FIND "TO" INDEX TABLE. ADB TOTBL LDB B,I GET POINTER TO REQ HEADER SIZE. STB TPTR ADB ADJMT IF REPLY, BUMP POINTER. STB TSZPT POINTER TO "TO" HEADER SIZE. LDA B,I GET THE SIZE OF THE HEADER. CMA,INA STA TEMP SAVE FOR CLEARING BUFFER. ADA BODAD STA RQADR ADDR OF OLDER HEADER. * LDA FSZPT,I COMPUTE DIFFERENCE IN SIZE CMA,INA FROM OLDER TO NEWER FORMAT. ADA TSZPT,I ADA RQLEN ADD TO CURRENT SIZE. STA RQLEN ISZ TPTR ISZ TPTR POINT TO # WORDS TO MOVE (IF REPLY). * * CLEAR TARGET AREA FOR OLDER FORMAT OF REQUEST. * LDB RQADR CLA CLEAR STA B,I INB ISZ TEMP JMP CLEAR * * CONVERT FROM NEWER FORMAT TO NEXT LOWER LEVEL * LDA FPTR,I GET # WORDS TO MOVE FOR REQUEST. LDB ADJMT SZB IF REPLY, LDA TPTR,I CHANGE TO # WORDS TO MOVE FOR REPLY. STA TEMP ISZ FPTR ISZ TPTR * CONV LDA FPTR,I GET A WORD-INDEX INTO NEWER FORMAT. ADA N1 ADJUST TO ZERO. ADA TM0PBF ADDR OF WORD IN NEWER FORMAT REQUEST. LDA A,I CONTENTS OF WORD. LDB TPTR,I GET A WORD-INDEX INTO OLDER FORMAT. ADB N1 ADJUST TO ZERO. ADB RQADR ADDR OF WORD IN OLDER FORMAT REQUEST. STA B,I STORE FROM NEW TO OLD LOCATION. * ISZ FPTR BUMP POINTERS. ISZ TPTR ISZ TEMP INCR. # WORDS TO MOVE. JMP CONV LOOP TILL DONE. * * PERFORM REQUEST-SPECIFIC CONVERSION, IF ANY. * LDB NXTLV GET CURRENT LEVEL NUMBER. ADB SPECL ADD TO TABLE OF REQUEST-SPECIFIC LDB B,I ROUTINES AND GO DO IT. STB TEMP LDA RQADR LDB RQLEN JSB TEMP,I JMP ERROR ERROR RETURN. STB RQLEN SAVE POSSIBLY MODIFIED LENGTH. * * CHECK IF ANOTHER LEVEL. * LDA NXTLV CPA OLEVL REACHED LEVEL # OF DEST NODE? JMP SEND YES. ADA N1 NO. DECR TO NEXT LOWER LEVEL #. STA NXTLV JMP NXLEV KEEP ON CONVERTING. * * CONVERSION COMPLETED. * SEND LDA RQLEN ADA RQADR STA BODAD CLB TSTLN LDA RQLEN CMA,INA IF REQUEST LENGTH IS ADA B6 LESS THAN 7 WORDS, SSA JMP CONF STB BODAD,I PAD IT OUT TO 7. ISZ BODAD ISZ RQLEN JMP TSTLN * * SEND CONVERTED REQUEST TO DRIVER ON GRPM'S CLASS. * CONF LDA RQLEN ADD NUMBER OF WORDS ADA C#LSZ IN LOCAL APPENDAGE AREA STA RQLEN FOR THIS (SENDING) NODE. * LDA RQADR,I GET STREAM WORD. AND MSK CLEAR RETRY CNTRS. IOR #BREJ INITIALIZE TO REQUIRED VALUE. STA RQADR,I * LDA #GRPM SET UP TO SEND TO GRPM. STA CLASS * SHIP JSB XLUEX SEND REQUEST. DEF *+8 DEF CLS20 DEF DSTLU DESTINATION LU. DEF #CVBF+1 ADDRESS OF DATA BUFFER. DEF DAINL DATA LENGTH. RQADR NOP ADDRESS OF NEW REQUEST. DEF RQ3LEN LENGTH OF NEW REQUEST. DEF CLASS GRPM'S OR INCNV'S CLASS. JSB LOST ERROR. (NO RETURN ON JSB). * JMP OTGET GO GET NEXT MESSAGE. * * ERROR IN REQUEST-SPECIFIC ROUTINE. CONVERSION HAS GONE DOWN AT LEAST * ONE LEVEL. ERROR REPLY CAN BE ANY LEVEL BELOW THAT OF NODE IN WHICH * OTCNV IS RUNNING. SEND TO INCNV TO CONVERT BACK UP. * ERROR LDA #INCV CLASS # FOR INCNV. STA CLASS CLA STA DSTLU JMP SHIP GO SEND TO INCNV. * * REPORT ERROR IN NODAL ROUTING VECTOR (NRV). * SFAIL LDA NXTLV INA FORMAT LEVEL # RECEIVED. CCE JSB $CVT1 STA EMSG+7 * LDB RQADR SOURCE NODE NUMBER. ADB C#SRC (RELATIVE POSITION FROM LEVEL LDA B,I TO LEVEL IS NOT SUPPOSED TO STA TEMP CHANGE!) * JSB CNUMD DEF *+3 DEF TEMP DEF EMSG+15 * JSB REIO DISPLAY ON SYS CONSOLE. DEF *+5 DEF ICOD2 DEF B1 DEF EMSG DEF ELEN NOP IGNORE ERROR RETURN. * JSB LOST (NO RETURN ON JSB) * EMSG ASC 18, RECV'D LEVEL XX MSG FROM NODE XXXXX ELEN DEC 18 SPC 5 * * DUMMY REQUEST-SPECIFIC CONVERSION ROUTINE. * NULL NOP JMP NULL,I SKP * * IF WE CAN'T SEND REPLY, SEND IT TO QCLM (CAN BE ANY FORMAT LEVEL). * LOST NOP (JSB FOR COMPUTING ADDRESS) LDA RQADR,I IS IT A REPLY? RAL SSA,RSS JMP OTGET NO. * LDB RQADR YES. SEND IT TO QCLM. ADB B4 STB TEMP POINT TO WORD 5 OF "QCLM BUFFER". LDA @OTCN GET BASE ADDRESS OF "OTCNV". CMA,INA GET RELATIVE ERROR ADDRESS ADA LOST AND STA TEMP,I PASS ERROR ADDR TO QCLM. ISZ TEMP DLD "DS08 SET ERROR TO "DS08". DST TEMP,I ISZ TEMP ISZ TEMP DLD $TIME RECORD TIME OF ERROR. DST TEMP,I ISZ TEMP ISZ TEMP2<:6 LDA PNAME PASS NAME OF "OTCNV". STA TEMP,I ISZ TEMP DLD PNAME+1 DST TEMP,I * LDA #QCLM GET CLASS NUMBER FOR QCLM. SZA,RSS JMP OTGET IF NO QCLM, FORGET MESSAGE. * JSB EXEC MAILBOX WRITE/READ TO QCLM. DEF *+8 DEF CLS20 DEF B0 DEF RQADR,I DEF D12 DEF B1 TYPE 1. DEF B0 DEF #QCLM NOP IGNORE ERROR RETURN. * JMP OTGET GO BACK TO GET NEXT MESSAGE. SKP * * CONSTANTS AND STORAGE. * B0 OCT 0 B17 OCT 17 B77 OCT 77 N1 DEC -1 D12 DEC 12 BIT15 OCT 100000 ICOD2 OCT 100002 CLS20 OCT 100024 CLS21 OCT 100025 CLASS NOP NOT12 OCT 167777 B7760 OCT 177760 MSK OCT 170077 "DS" ASC 1,DS "DS08 ASC 1,DS08 PNAME ASC 3,OTCNV @OTCN DEF BASE * NXTLV NOP OLEVL NOP FPTR NOP TPTR NOP BODAD NOP DAINL NOP RQLEN NOP FSZPT NOP TSZPT NOP ADJMT NOP TEMP NOP DSTND NOP DSTLU NOP OCT 10100 (DSTLU+1) "Z" BIT & "WRITE". SAVET NOP * N#HDR ABS -HDR C#MAX ABS MAX C#LVL ABS #LVL C#SRC ABS #SRC C#LSZ ABS #LSZ * * TEMPORARY BUFFER TO HOLD OLDER FORMAT OF REQUEST. * TMPBF DEF *+1 BSS HDR * * BUFFER FOR CURRENT REQUEST AND HEADER EXPANSION. * RQB BSS MAX+#LSZ BUFFER FOR INCOMING REQUEST. * BSS 0 SIZE OF MODULE (+ #CVBF). * END OTCNV a< Sb 91750-18145 2013 S C0122 &PGMAD              H0101 pASMB,Q,C HED I.D. SEG. ADDRESS ROUTINE *(C) HEWLETT-PACKARD CO. 1980* NAM PGMAD,30 91750-1X145 REV.2013 800419 MEF ENT PGMAD EXT .CBT,.LBT,.MBT,.MVW,.SBT,.ENTP,$LIBR,$LIBX,$OPSY SUP * NAME: PGMAD * SOURCE: 91750-18145 * RELOC: 91750-1X145 * PGMR: C.C.H. [ 04/19/80 ] * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * PGMAD ACCEPTS A USER-SUPPLIED ADDRESS OF A 3-WORD ARRAY WHICH * CONTAINS THE ASCII CODE FOR THE NAME OF A PARTICULAR PROGRAM. * OPTIONALLY, IF THE FIRST WORD OF THE ARRAY IS A ZERO, THIS INDICATES * A REQUEST TO RETURN THE ASCII NAME, ETC. FOR THE CALLING PROGRAM. * PGMAD RETURNS THE I.D. SEGMENT ADDRESS OF THE PROGRAM, THE STATUS, * AN INDICATION OF THE TYPE OF I.D. SEGMENT (I.E.,LONG/SHORT), AND THE * FATHER'S I.D. SEGMENT ADDRESS./ * A DORMANT PROGRAM, ALSO IN THE TIME LIST, HAS STATUS SET =100000B. * >>CAUTION: SHORT ID ADDRESS REPORTED= +(ADDRESS-13B) [KEY WORD FORMAT]. * * IF THE USER SUPPLIES A NEGATIVE I.D. SEGMENT ADDRESS VIA PARAMETER * 'IDAD', THEN PGMAD WILL RETURN RETURN 3 WORDS, CONTAINING THE * ASCII PROGRAM NAME, TO THE BUFFER DEFINED BY THE 'NAME' PARAMETER. * >>CAUTION: SHORT ID ADDRESS MUST BE= -(ID ADDR.-13B) [KEY WORD FORMAT]. * * PGMAD CALLING SEQUENCE: * * JSB PGMAD * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS ] * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * [DEF IDAD] [OPT. IF PARAM NEG: ASCII RETURNED; ELSE,0/+(ID ADDR)] * [DEF ISTAT] [OPTIONAL ADDRESS FOR RETURN OF PROGRAM STATUS] * [DEF IDTYP] [OPTIONAL ADDRESS FOR RETURN OF I.D. SEGMENT TYPE] * [DEF FATHA] [OPTIONAL ADDRESS FOR RETURN OF FATHER'S I.D. ADDRESS] * = I.D. SEGMENT ADDRESS. * = PROGRAM STATUS. [ DORMANT, IN TIME LIST =100000B] * = 0: STANDARD I.D. SEGMENT. * = 1: SHORT I.D. SEGMENT. * * FORTRAN CALLING SEQUENCE: CALL PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * * PGMAD ERROR DETECTION: * * A. ADDRESS OF NAME-ARRAY NOT SUPPLIED. * B. CHARACTER #5 OF USER-SUPPLIED PROGRAM NAME IS NULL. * C. I.D. SEGMENT WITH EQUIVALENT PROGRAM NAME CANNOT BE FOUND. * * -- RETURN TO WITH: * 1. & AND 'IDAD' & 'ISTAT' ALL SET = 0. * 2. AND 'IDTYP' ARE SET =1. SKP NAME NOP POINTER TO ASCII NAME ARRAY. P1 DEF A POINTER FOR RETURN OF ID SEG. ADDRESS. P2 DEF B POINTER FOR RETURN OF PROGRAM STATUS. P3 DEF TEMP POINTER FOR RETURN OF ID SEG. TYPE. P4 DEF TEMP+1 POINTER FOR RETURN OF FATHER ID ADDRESS. PGMAD NOP ENTRY/EXIT JSB $LIBR NOP OF THIS SUBROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES. DEF NAME DEFINE PARAMETER STORAGE AREA. FIRST JMP CONFG CONFIGURE IF DMS, THEN FIRST =NOP. LDA NAME GET THE ADDRESS OF THE ASCII ARRAY. SZA,RSS DID THE CALLER SUPPLY AN ADDRESS? JMP ERREX NO--ERROR! * CLE,ELA FORM A BYTE ADDRESS STA NAMBA FOR THE USER'S ASCII BUFFER. SPC 1 * RESET POINTERS TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST IDAD SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION DST P1 AND RE-INITIALIZE FOR NO PARAMETERS. DLD P3 GET 'IDTYP' & 'FATHA' ADDRESSES--IF ANY. DST IDTYP SAVE PARAMETER ADDRESSES. DLD DTEMP GET DEF'S TO DUMMY PARAMETER STORAGE. DST P3 RE-SET FOR NO 'IDTYP' & 'FATHA' PARAMS. INB INITIALIZE I.D. POINTER STB KEYPT TO TEMPORARY STORAGE. CLA LDA IDAD,I GET THE ID ADDRESS--IF ANY. CMA,SSA,INA IF THE ADDRESS IS NOT NEGATIVE, JMP ASCNM THEN, USER IS SUPPLYING THE ASCII NAME. SPC 1 * DETERMINE ASCII PROGRAM NAME FROM USER'S I.D. SEGMENT ADDRESS. SPC 1 SEGAD STA IDSEG SAVE I.D. SEGMENT ADDRESS. LDB KEYWD GET KEYWORD TABLE ADDRESS. KEYCK LDA B,I GET THE KEYWORD ENTRY. [DMS: XLA B,I] NOP SZA,RSS IF THIS IS THE ENO OF THE TABLE, JMP ERREX THEN TELL THE CALLER OF HIS ERROR! * CPA IDSEG IF THE USER'S IS A VALID I.D. SEGMENT, JMP GETNM THEN CONTINUE PROCESSING THE REQUEST. INB ELSE, ADVANCE TO THE NEXT ENTRY, JMP KEYCK AND CONTINUE THE SEARCH. * GETNM JSB GETID MOVE NEEDED ID INFO TO LOCAL BUFFER. LDA LOCBA GET SOURCE BYTE ADDRESS. LDB NAMBA GET USER BUFFER BYTE ADDRESS. JSB .MBT MOVE THE FIVE DEF D5 NAME CHARACTERS NOP TO THE USER'S BUFFER. LDA B40 PAD THE LAST WORD JSB .SBT WITH AN ASCII SPACE. JMP ESTAT COMPLETE THE PROCESSING. SPC 1 * DETERMINE I.D. SEGMENT ADDRESS FROM USER'S ASCII PROGRAM NAME. SPC 1 ASCNM LDA XEQT GET CALLER'S I.D. SEGMENT ADDRESS. LDB NAME,I IF THE CALLER SPECIFIED SZB,RSS ZERO AS THE FIRST ASCII NAME JMP SEGAD PARAMETER, THEN RETURN DATA ON CALLER. * LDB KEYWD GET ADDRESS OF KEYWORD TABLE. STB KEYPT SET POINTER TO TOP OF TABLE. PLOOP LDA B,I GET KEYWORD-TABLE ENTRY. [DMS: XLA B,I] NOP SZA,RSS IF THIS IS THE END-OF-LIST (0), JMP ERREX THEN GO TO RETURN AN ERROR INDICATION. * STA IDSEG SAVE CURRENT ID SEGMENT ADDRESS. JSB GETID MOVE NEEDED IDP INFO TO LOCAL BUFFER. LDA LOCBA GET BYTE ADDR. OF I.D. SEG NAME ENTRY. LDB NAMBA GET BYTE ADDRESS OF USER'S BUFFER. JSB .CBT COMPARE THE FIVE CHARACTER BYTE STRING. DEF D5 NOP JMP ESTAT NAME COMPARES. GO ESTABLISH STATUS ADDR. NOP DOES NOT COMPARE. ISZ KEYPT NO COMPARISON. POINT TO NEXT ENTRY. LDB KEYPT GET NEXT KEYWORD TABLE ADDRESS. JMP PLOOP GO TO CHECK NEXT KEYWORD ENTRY. * ESTAT LDA PSTAT GET STATUS WORD FROM LOCAL ID COPY. AND B17 ISOLATE THE STATUS CODE (BITS# 4-0). CCE,SZA IF STATUS IS NON-DORMANT (#0) JMP SVST TIME LIST CHECKING IS NOT REQUIRED. LDB TBIT GET COPY OF 'T-BIT' WORD. BLF,SLB POSITION 'T' BIT AND TEST IT. ERA PROGRAM IN TIME LIST: STATUS =100000B. SVST STA PSTAT SAVE THE MASKED STATUS CODE. * LDB FBYTA GET BYTE ADDRESS OF FATHER POINTER. JSB .LBT AND GET THE ID NUMBER. SZA,RSS IF IT'S =0, NO FURTHER EFFORT NEEDED, JMP SVDAD SO SKIP TO RETURN 0 TO THE CALLER. STA B MOVE FATHER INDEX TO . ADB M1 COMPUTE THE FATHER'S ID SEGMENT ADDRESS ADB KEYWD FROM AN OFFSET INTO THE KEYWORD TABLE. DMS1 LDA B,I GET KEYWORD TABLE ENTRY.[DMS: XLA B,I] NOP SVDAD STA FATHA,I RETURN THE FATHER'S ID TO THE CALLER. * LDA TYPID GET WORD WITH SEGMENT SIZE (SS) FLAG. LSR 4 RTE-M,III,IV 'SS' BIT IS WORD#15 BIT#4. CLE,ERA SET TO: 0-LONG/1-SHORT ID.SEG. TYPE. CLA,SEZ IF STANDARD I.D. SEG.: =0; ELSE, INA SET =1 FOR SHORT I.D. SEGMENT. STA IDTYP,I RETURN THE I.D. SEGMENT TYPE. LDA IDSEG = I.D. SEGMENT ADDRESS. CLB,SEZ = 0, IF THIS IS SHORT ID. SEG. STB FATHA,I NO PATRIARCH FOR SHORT ID'S. SEZ,RSS IF THIS IS A LONG ID SEGMENT: LDB PSvTAT = PROGRAM'S CURRENT STATUS. * EROUT STA IDAD,I RETURN DATA TO STB ISTAT,I USER'S PARAMETERS--IF ANY. JSB $LIBX RETURN TO THE CALLER DEF PGMAD VIA THE PRIVILEGED PROCESSOR. * ERREX CLA,CCE,INA SET 'IDTYP' & STA IDTYP,I TO 1--FOR ERROR RETURN. CLA RETURN WITH & AND 'IDAD' & CLB 'ISTAT' ALL SET TO ZERO! JMP EROUT GO TO RETURN THE BAD NEWS. * GETID NOP = ID SEGMENT ADDRESS. ADA D12 POINT TO WORD #13 (NAME). LDB LOCAD DESTINATION IS LOCAL ID BUFFER. DMS2 JMP SAMAP NON-DMS: BYPASS; DMS =NOP. LDX D9 MOVE 9 WORDS FROM ACTUAL ID SEGMENT, MWF INTO THE LOCAL BUFFER. JMP GETID,I RETURN. SAMAP JSB .MVW COPY PART OF DEF D9 THE ID SEGMENT NOP WITHOUT CROSS-MAP OPERATIONS. JMP GETID,I RETURN. * SKP ***** DO NOT CHANGE THE ORDER OF THE FOLLOWING STATEMENTS ***** * A EQU 0 B EQU 1 B17 OCT 17 B40 OCT 40 D5 DEC 5 D9 DEC 9 D12 DEC 12 M1 DEC -1 REGDF DEF A DUMMY POINTER: PARAMETER #1. DEF B DUMMY POINTER: PARAMETER #2. DTEMP DEF TEMP DUMMY POINTER: PARAMETER #3. DEF TEMP+1 DUMMY POINTER: PARAMETER #4. FBYTA DBR FATHR BYTE ADDRESS: LOCAL ID FATHER POINTER. LOCAD DEF TEMP+3 ADDRESS OF LOCAL ID COPY'S NAME BYTES. LOCBA DBL TEMP+3 BYTE ADDRESS OF LOCAL ID NAME BYTES. IDAD NOP ADDRESS FOR RETURN OF I.D. SEG. ADDRESS. ISTAT NOP ADDRESS FOR RETURN OF PROGRAM STATUS. IDTYP NOP ADDRESS FOR RETURN OF I.D. SEGMENT TYPE. FATHA NOP ADDRESS FOR RETURN OF FATHER ID SEG. NO. KEYPT NOP POINTER TO CURRENT I.D. SEGMENT ADDRESS. TEMP BSS 13 TEMPORARY BUFFER: PARAMS AND ID SEGMENT. IDSEG EQU TEMP+2 POINTER TO ID SEG ADDRESS. TYPID EQU TEMP+5 POINTER TO ID TYPE 'SS' BIT, IN LOCAL ID. PSTAT EQU TEMP+6 POIN$"TER TO STATUS WORD, IN LOCAL ID COPY. TBIT EQU TEMP+8 POINTER TO 'T' BIT (TIME LIST). FATHR EQU TEMP+11 POINTER TO FATHER INDEX. NAMBA EQU TEMP+12 POINTER TO NAME ARRAY BYTE ADDRESS. KEYWD EQU 1657B BASE PAGE POINTER TO KEYWORD TABLE. XEQT EQU 1717B CURRENTLY EXECUTING ID ADDRESS. * * DMS CONFIGURATION--FIRST PASS, ONLY. * ORG IDAD CODE IN BUFFER TO SAVE SPACE. CONFG CLB LDA $OPSY GET OP-SYSTEM IDENTIFIER. RAR,SLA DMS SYSTEM? STB DMS2 YES, CLEAR PATH TO 'MWF' INSTRUCTION. STB FIRST PREVENT RE-EXECUTION OF THIS CODE. SLA,RSS DMS SYSTEM? JMP FIRST+1 NO, RETURN TO MAIN CODE. DLD XLABI YES, CONFIGURE DST KEYCK INSTRUCTIONS DST PLOOP FOR CROSS-MAP DST DMS1 OPERATIONS. JMP FIRST+1 RETURN. * XLABI XLA B,I * ORR * END ($ T _ 91750-18146 2013 S C0122 &PGMAL              H0101 qASMB,Q,C HED I.D. SEG. ADDRESS ROUTINE *(C) HEWLETT-PACKARD CO. 1980* NAM PGMAL,6 91750-1X146 REV.2013 800105 L EXT $ID#,$IDA,$IDSZ,$XQT,IDGET ENT PGMAD EXT .LBT,.MBT,.SBT,.ENTP,$LIBR,$LIBX * NAME: PGMAL * SOURCE: 91750-18146 * RELOC: 91750-1X146 * PGMR: C.C.H. [ 01/04/80 ] * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * PGMAL ACCEPTS A USER-SUPPLIED ADDRESS OF A 3-WORD ARRAY WHICH * CONTAINS THE ASCII CODE FOR THE NAME OF A PARTICULAR PROGRAM. * OPTIONALLY, IF THE FIRST WORD OF THE ARRAY IS A ZERO, THIS INDICATES * A REQUEST TO RETURN THE ASCII NAME, ETC. FOR THE CALLING PROGRAM. * PGMAL RETURNS THE I.D. SEGMENT ADDRESS OF THE PROGRAM, THE STATUS, * AN INDICATION OF THE TYPE OF I.D. SEGMENT (I.E.,LONG/SHORT), AND THE * FATHER'S I.D. SEGMENT ADDRESS. * A DORMANT PROGRAM, ALSO IN THE TIME LIST, HAS STATUS SET =100000B. * >>CAUTION: SHORT ID ADDRESS REPORTED= +(ADDRESS-13B) [KEY WORD FORMAT]. * * IF THE USER SUPPLIES A NEGATIVE I.D. SEGMENT ADDRESS VIA PARAMETER * 'IDAD', THEN PGMAD WILL RETURN RETURN 3 WORDS, CONTAINING THE * ASCII PROGRAM NAME, TO THE BUFFER DEFINED BY THE 'NAME' PARAMETER. * >>CAUTION: SHORT ID ADDRESS MUST BE= -(ID ADDR.-13B) [KEY WORD FORMAT]. * * PGMAD CALLING SEQUENCE: * * JSB PGMAD * DEF *+2 [ OR *+2+N WHERE N= NUMBER OF OPTIONAL PARAMETERS ] * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * [DEF IDAD] [OPT. IF PARAM NEG: ASCII RETURNED; ELSE,0/+(ID ADDR)] * [DEF ISTAT] [OPTIONAL ADDRESS FOR RETURN OF PROGRAM STATUS] * [DEF IDTYP] [OPTIONAL ADDRESS FOR RETURN OF I.D.SEGMENT TYPE] * [DEF FATHA] [OPTIONAL ADDRESS FOR RETURN OF FATHER'S I.D. ADDRESS] * = I.D. SEGMENT ADDRESS. * = PROGRAM STATUS. [ DORMANT, IN TIME LIST =100000B] * = 0: STANDARD I.D. SEGMENT. * = 1: SHORT I.D. SEGMENT. * * FORTRAN CALLING SEQUENCE: CALL PGMAD(NAME [,IDAD [,ISTAT [,IDTYP]]]) * * PGMAL ERROR DETECTION: * * A. ADDRESS OF NAME-ARRAY NOT SUPPLIED. * B. CHARACTER #5 OF USER-SUPPLIED PROGRAM NAME IS NULL. * C. I.D. SEGMENT WITH EQUIVALENT PROGRAM NAME CANNOT BE FOUND. * * -- RETURN TO WITH: * 1. & AND 'IDAD' & 'ISTAT' ALL SET = 0. * 2. AND 'IDTYP' ARE SET =1. SKP SUP [SUPPRESS EXTENDED LISTING] NAME NOP ASCII NAME ADDR. CONVERTED TO BYTE ADDR. P1 DEF A ADDRESS FOR RETURN OF PARAMETER #1. P2 DEF B ADDRESS FOR RETURN OF PARAMETER #2. P3 DEF PTEM ADDRESS FOR RETURN OF PARAMETER #3. P4 DEF PTEM+1 ADDRESS FOR RETURN OF PARAMETER #4. PGMAD NOP ENTRY/EXIT JSB $LIBR GAIN EXCLUSIVE USE NOP OF THIS SUBROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES. DEF NAME DEFINE PARAMETER STORAGE AREA. LDA NAME GET THE ADDRESS OF THE ASCII ARRAY. SZA,RSS DID THE CALLER SUPPLY AN ADDRESS? JMP ERREX NO--ERROR! * STA SVNAM SAVE ARRAY ADDRESS, TEMPORARILY. CLE,ELA FORM A BYTE ADDRESS STA NAME FOR THE USER'S ASCII BUFFER. SPC 1 * RESET POINTERS TO ALLOW USER TO CALL WITHOUT RETURN-DATA PARAMETERS. SPC 1 DLD P1 GET PARAMETER ADDRESSES-IF ANY. DST IDAD SAVE FOR DATA RETURN. DLD REGDF GET INITIAL PARAMETER DEFINITION DST P1 AND RE-INITIALIZE FOR NO PARAMETERS. DLD P3 GET 'IDTYP' & 'FATHA' ADDRESSES--IF ANY. DST IDTYP SAVE PARAMETER ADDRESSES. DLD DPTEM GET DEF'S TO DUMMY PARAMETER STORAGE. DST P3 RE-SET FOR NO 'IDTYP' & 'FATHA' PARAMS. INB INITIALIZE I.D. POINTER STB KEYPT TO TEMPORARY STORAGE. CLA LDA IDAD,I GET THE ID ADDRESS--IF ANY. CMA,SSA,INA IF THE ADDRESS IS NOT NEGATIVE, JMP ASCNM THEN, USER IS SUPPLYING THE ASCII NAME. SPC 1 * DETERMINE ASCII PROGRAM NAME FROM USER'S I.D. SEGMENT ADDRESS. SPC 1 SEGAD STA IDSEG SAVE I.D. SEGMENT ADDRESS. LDB $ID# GET THE NUMBER OF I.D. SEGMENTS. CMB,INB FORM A COUNTER. LDA $IDA GET THE I.D. SEGMENT ADDRESS. ADCHK CPA IDSEG IF THE USER'S IS A VALID I.D. SEGMENT, JMP GETNM THEN CONTINUE PROCESSING THE REQUEST. ADA $IDSZ ADD OFFSET TO NEXT ID SEGMENT. INB,SZB HAVE ALL ID. SEGMENTS BEEN CHECKED? JMP ADCHK NO, CONTINUE CHECKING. JMP ERREX YES, THE USER'S ADDRESS IS INVALID! * GETNM ADA D12 POINT TO I.D. ASCII NAME WORDS. CLE,ELA FORM SOURCE BYTE ADDRESS. LDB NAME GET USER BUFFER BYTE ADDRESS. JSB .MBT MOVE THE FIVE DEF D5 NAME CHARACTERS NOP TO THE USER'S BUFFER. LDA B40 PAD THE LAST WORD JSB .SBT WITH AN ASCII SPACE. JMP ESTAT COMPLETE THE PROCESSING. SPC 1 * DETERMINE I.D. SEGMENT ADDRESS FROM USER'S ASCII PROGRAM NAME. SPC 1 ASCNM LDA $XQT GET CALLER'S I.D. SEGMENT ADDRESS. LDB SVNAM,I IF THE CALLER SPECIFIED SZB,RSS ZERO AS THE FIRST ASCII NAME JMP SEGAD PARAMETER, THEN RETURN DATA ON CALLER. * JSB IDGET GET I.D. SEGMENT ADDRESS DEF *+2 USING L'S ROUTINE, DEF SVNAM,I AND USER-SPECIFIED NAME. STA PTEM+2 SAVE I.D. SEGMENT ADDRESS. SZA,RSS IF THE PROGRAM WAS NOT FOUND, JMP ERREX TAKE THE ERROR EXIT; ELSE, F * ESTAT LDB KEYPT,I GET THE I.D. SEGMENT ADDRESS, AGAIN. ADB D15 POINT TO I.D. SEGMENT WORD #16, STB PSTAT AND SAVE THE STATUS WORD ADDRESS. LDA B,I GET STATUS WORD FROM I.D. SEGMENT. AND B77 ISOLATE THE STATUS CODE (BITS# 5-0). SZA IF STATUS IS NON-DORMANT (#0) JMP SVST TIME LIST CHECKING IS NOT REQUIRED. ADB D2 POINT TO, AND RETRIEVE WORD #18 LDB B,I OF THE I.D. SEGMENT (RES,T,MULTIPLE). BLF,SLB POSITION THE 'T' BIT AND TEST IT. LDA BIT15 PROGRAM IN TIME LIST: STATUS =100000B. SVST STA STWRD SAVE THE MASKED STATUS CODE. SZA,RSS IF STATUS =0, IT'S DORMANT, SO JMP FATH? NO MAPPING IS REQUIRED. * STA B SAVE MASKED CODE FOR INDEXING. ADA M10B TEST FOR LOW RANGE CODES: 0 TO 7B. SSA,RSS LOW RANGE (<10B)? JMP HIRNG NO. GO TO TEST FOR HIGH RANGE. * LDA LOTBA YES. GET POINTER TO LOW RANGE TABLE, JMP GMAPS AND GO GET MAPPED STATUS CODE. * HIRNG ADA M37B TEST FOR UNDEFINED RANGE: 10B TO 46B. SSA IF THE STATUS CODE IS <47B, JMP ERREX THEN SOMETHING'S WRONG--FLAG AN ERROR! * STA B SAVE THE HIGH RANGE OFFSET VALUE. ADA M13B TEST FOR OUT-OF-RANGE CODES: >61B. SSA,RSS IF THE STATUS CODE IS >61B, JMP ERREX THEN SOMETHING'S WRONG--FLAG AN ERROR! * LDA HITBA GET THE POINTER TO THE HIGH RANGE TABLE. GMAPS ADA B INDEX TO THE MAPPED EQUIVALENT STATUS. LDB A,I GET THE RTE-M/III/IV EQUIVALENT CODE. CPB M1 IF THE MAPPED CODE = -1 (UNDEFINED), JMP ERREX THEN SOMETHING'S WRONG--FLAG AN ERROR! * STB STWRD SAVE THE MAPPED EQUIVALENT STATUS CODE, * FATH? CCB,CCE COMPUTE A BYTE ADDRESS ADB PSTAT FOR THE FATHER'S ELB ID SEGMENT NUMBER. JSB .LBT GET THS+E FATHER'S ID SEGMENT NO. SZA,RSS IF IT'S =0, NO FURTHER EFFORT NEEDED, JMP STR0 SO SKIP TO RETURN 0 TO THE CALLER. ADA M1 COMPUTE THE MPY $IDSZ FATHER'S ID SEGMENT ADA $IDA ADDRESS, AND RETURN IT STR0 STA FATHA,I TO THE CALLER. * LDA PSTAT RECOVER THE STATUS ADDRESS. LDA A,I GET WORD WITH SEGMENT SIZE (SS) FLAG. LSR 7 RTE-L'S 'SS' BIT IS WORD#16 BIT#7. CLE,ERA SET TO: 0-LONG/1-SHORT ID.SEG. TYPE. CLA,SEZ IF STANDARD I.D. SEG.: =0; ELSE, INA SET =1 FOR SHORT I.D. SEGMENT. STA IDTYP,I RETURN THE I.D. SEGMENT TYPE. LDA KEYPT,I = I.D. SEGMENT ADDRESS. CLB,SEZ,RSS = 0, IF THIS IS SHORT ID. SEG. LDB STWRD = PROGRAM'S CURRENT STATUS. * EROUT STA IDAD,I RETURN DATA TO STB ISTAT,I USER'S PARAMETERS--IF ANY. JSB $LIBX RETURN TO THE CALLER DEF PGMAD VIA PRIVILEGED PROCESSOR. * ERREX CLA,CCE,INA SET 'IDTYP' & STA IDTYP,I TO 1--FOR ERROR RETURN. CLA RETURN WITH & AND 'IDAD' & CLB 'ISTAT' ALL SET TO ZERO! JMP EROUT GO TO RETURN THE BAD NEWS. * SKP * ***** DO NOT CHANGE THE ORDER OF THE FOLLOWING STATEMENTS ***** * LOTBA DEF *+1 LOW RANGE MAP TABLE POINTER. OCT 0,-1,2,3,-1,-1,6,6 MAPPED CODES: 00B TO 07B. * HITBA DEF *+1 HIGH RANGE MAP TABLE POINTER. OCT 100000,3,3,3,3,3,3,2,1,1,4 MAP. CODES: 47B TO 61B. * A EQU 0 B EQU 1 B40 OCT 40 B77 OCT 77 DPTEM DEF PTEM DUMMY POINTER: PARAMETER #3. DEF PTEM+1 DUMMY POINTER: PARAMETER #4. IDAD NOP ADDRESS FOR RETURN OF I.D. SEG. ADDRESS. ISTAT NOP ADDRESS FOR RETURN OF PROGRAM STATUS. IDTYP NOP ADDRESS FOR RETURN OF I.D. SEGMENT TYPE. FATHA NOP ADDRESS FOR RETURN OF FATHER'S ID ADDRESS. KEYPT NOP PO=z$"INTER TO CURRENT I.D. SEGMENT ADDRESS. D2 DEC 2 D5 DEC 5 D12 DEC 12 OFFSET TO I.D. SEGMENT NAME-ENTRY. D15 DEC 15 OFFSET TO I.D. SEGMENT STATUS WORD. BIT15 EQU HITBA M1 DEC -1 M10B OCT -10 M13B OCT -13 M37B OCT -37 PSTAT NOP TEMPORARY STORAGE. PTEM BSS 3 TEMPORARY STORAGE. IDSEG EQU PTEM+2 REGDF DEF A DUMMY POINTER: PARAMETER #1. DEF B DUMMY POINTER: PARAMETER #2. STWRD NOP MASKED STATUS WORD. SVNAM EQU PSTAT TEMPORARY STORAGE FOR NAME ARRAY POINTER. END x$ U ` 91750-18147 2013 S C0122 &PLOG +              H0101 }nASMB,Q,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 PLOG--DS/1000 REQUEST/REPLY BUFFER LOGGING PROGRAM NAM PLOG,19,30 91750-16147 REV 2013 801013 ALL * * NAME: PLOG * * RELOC: 91750-16147 * * SOURCE: 91750-18147 * * PRGR: C. JONAS * * MOD BY: DWT AUG 1978 * CWJ 801013 ENFORCE NON CLONABILITY! * SUP * * THIS PROGRAM IS A SYSTEM DIAGNOSTIC TOOL WHICH PRODUCES A BINARY LOG * OF REQUEST AND REPLY BUFFERS PASSED TO THE NODE OF A DISTRIBUTED SYSTEM * IN WHICH PLOG IS RUNNING. * * SCHEDULING SEQUENCE: * * *RU,PLOG[,CONSOLE LU[,LOG NAMR[,DATA FLAG[,# OF BUFFERS[,DEBUG]]]]] * * WHERE: * CONSOLE LU = (INTERACTIVE) LU # FOR ERROR AND MESSAGE LOGGING. * = -1 IF THE PROGRAM IS SCHEDULED TO CLEAN UP. * DEFAULT IS THE SCHEDULING TERMINAL. * LOG NAMR = LU, IF A TAPE-LIKE DEVICE (MAG. TAPE, CTU, ECT.) * IS TO BE USED AS LOG MEDIUM, OR * = NAMR (IN THE FORM NAME:SECURITY:CARTRIDGE), IF A * FILE IS TO BE USED AS LOG MEDIUM. PLOG WILL * CREATE THE FILE NAMR AND ASSIGN FILE TYPE AND SIZE. * = -1 IF THE CLEAN UP DOES NOT INCLUDE THE LOG FILE. * DEFAULT IS DISC FILE 'PLOG:DS. * DATA FLAG = 0, IF NO DATA FROM REQUEST/REPLY BUFFERS IS TO BE * SAVED, OR * = NON-ZERO, IF DATA FROM REQUEST/REPLY BUFFERS IS TO BE * SAVED. * DEFAULT IS NO DATA. * # OF BUFFERS = # OF MOST RECENT REQ-UEST/REPLY BUFFERS TO LOG IF * DISC IS LOG MEDIUM. * DEFAULT IS 300 BUFFERS. * DEBUG NON-ZERO WILL SET THE DEBUG FLAG (BIT 9 IN #TYPE). * * * PLOG HANGS ON CLASS #PLOG THROUGH WHICH REQUEST/REPLY BUFFERS ARE * RETHREADED BY THE DISTRIBUTED SYSTEM SOFTWARE. PLOG KEEPS A RECORD OF * ITS RESOURCES IN CONSISTING OF #PLOG, ITS CLASS NUMBER, #PRN, ITS * RESOURCE NUMBER, #TYPE, THE LOG TYPE WORD, BITS OF WHICH, IF SET, * MEAN: * * ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! * !--15--14--13--12--11--10---9---8---7---6---5---4---3---2---1---0 * ^ ^ ^ !<----------LOG LU #----------->! * ! ! ! * DISC FULL DATA * LOG BUFFER LOGGED * * AND, IF DISC LOG, #RECS, #SIZE, AND #CRNT, THE RECORD SIZE, * # OF BLOCKS, AND THE CURRENT RECORD NUMBER, RESPECTIVELY * SPC 3 EXT #PLOG,#PKUP,#GETR EXT $TIME,EXEC,IFBRK,KCVT EXT CLOSE,CREAT,OPEN EXT POST,PURGE,RNRQ,WRITF EXT CLRQ EXT PNAME * #CLAS DEF #PLOG CLASS # #PRN DEF #PLOG+1 RESOURCE # #TYPE DEF #PLOG+2 TYPE & LOG LU #RECS DEF #PLOG+3 RECORD SIZE #SIZE DEF #PLOG+4 # OF DISC BLOCKS #CRNT DEF #PLOG+5 CURRENT RECORD # SKP * GLBLK-START * * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * *  * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP PLOG EQU * * * PICK UP PARAMETERS * JSB #PKUP DEF *+4 DEF PMASK DEF INLU DEF DEFLU * * CHECK IF ENTRY TO CLEAN UP * LDA INLU LOAD CONSOLE LU STA CFLG SET THE CLEAN UP FLAG SSA,RSS NEGATIVE LU? JMP SETIN NO, GO SETUP PARAMETERS LDB DEFLU YES STB INLU * INA,SZA IF INLU WAS -1, DO CLEAN UP JMP INERR ELSE, IT IS AN INPUT LU ERROR * JSB CLONE IF THIS IS A CLONE OF PLOG, TERMINATE HIM * LDA #PLOG LOAD CLASS NUMBER FOR CLEAN UP STA CLNUM LDA OUTLU LOAD LOG NAMR SSA,RSS NEGATIVE ALSO? JMP SETLG .NO, GO CLEAN UP LOG FILE JMP TERM2 .YES, LOG FILE IS NOT CLEANED UP * * SET UP CONSOLE LU * SETIN LDB DEFLU LOAD DEFAULT LU SZA,RSS IS CONSOLE LU ZERO? STB INLU YES, USE DEFAULT * JSB CLONE IF THIS IS A CLONE OF PLOG, TERMINATE HIM * * CHECK IF THE CLASS NUMBER WAS NOT CLEANNED UP * LDA #PLOG SZA JMP CUERR * * SET UP LOG NAMR * SETLG LDA PTYPE LOAD DEVICE TYPE SZA,RSS JMP DEFNA JUMP IF DEFAULT (USE 'PLOG) CPA D1 CHECK IF TAPE LU JMP TAPLU DSCLU LDA =B100000 WITH DISC,BIT 15 OF #TYPE = 1 STA #TYPE,I JMP CHKCL TAPLU LDA OUTLU SZA,RSS OUTLU = 0? JMP DEFNA .YES, USE DEFAULT SSA NEGATIVE LOG LU? JMP LUERR .YES, LOG LU ERR IOR B100 .NO, SET BIT TO OUTPUT STA OUTBI AS BINARY STA #TYPE,I WITH TAPE, #TYPE = LOG LU JMP CHKCL DEFNA LDA PLNAM STA NAME DLD PLNAM+1 DST NAME+1 LDA PLSEC STA SEC LDA PLCRN STA CRN LDA =B100000 STA #TYPE,I * * CHECK IF ENTRY TO CLEAN UP LOG FILE * CHKCL EQU * LDA CFLG GET CLEAN UP FLAG INA,SZA CLEAN UP CALL? (A = -1) JMP SETDF .NO, JMP TO SET UP DATA FLAG JSB OPEN .YES, OPEN LOG FILE FOR CLEAN UP PURPOSE DEF *+7 DEF IDCB DEF IERR DEF NAME DEF D3 DEF SEC DEF CRN SSA ANY ERROR? JMP TERM2 .YES, JUST CLEAN UP CLASS # JMP TERM1 .NO, JMP TO CLEAN UP * * SET UP DATA FLAG * SETDF CLA LDB DATAF GET DATA FLAG SZB IS IT SET? LDA =B400 YES--SET FLAG IOR #TYPE,I AND MAKE IT BIT EIGHT IN #TYPE STA #TYPE,I * CLA SZB,RSS DATA FLAG? STA DAMAX NO, DATA LENGTH = 0 LDA RQMAX LOAD HEADER LENGTH ADA DAMAX ADD DATA LENGTH ADA D3 ADD 3 WORD TO HOLD TIME AND HEADER LENGTH INFO. SZB ANY DATA? INA YES, ADD 1 MORE WORD TO HOLD DATA LENGTbH INFO. STA PKLEN STORE AS RECORD SIZE STA #RECS,I SAVE RECORD SIZE LOCALLY & IN RES * * CHECK # OF BUFFER * LDA SIZE GET PASSED SIZE SSA IS IT NEGATIVE? JMP SZERR .YES, ERROR * * SET UP DEBUG FLAG * CLA LDB DEBUG GET DEBUG FLAG SZB IS IT SET? LDA =B1000 YES, SET FLAG IN #TYPE IOR #TYPE,I STA #TYPE,I * * (A) ALLOCATE CLASS NUMBER * CLA STA CLNUM JSB CLRQ GET CLASS WORD DEF *+4 DEF FUNC1 GET CLASS W/ NW, NA DEF CLNUM RETURN NEW CLASS # DEF D0 NO CLASS OWNERSHIP JMP CLALL ERROR RETURN SZA CLASS ALLOCATED? JMP CLALL NO--INFORM USER THEN TERMINATE LDA CLNUM GET ALLOCATED CLASS NUMBER IOR NDEAL SET SAVE CLASS # BIT STA CLNUM AND SAVE FOR DEALC USE * * (B) ALLOCATE RESOURCE NUMBER * JSB RNRQ DEF *+1+3 RETURN ADDRESS DEF ALLOC ALLOCATE GLOBALLY, NO WAIT,NO ABORT DEF #PLOG+1 RESOURCE # STORAGE LOCATION DEF STAT PLACE HOLDER--UNUSED JMP RNALL ERROR RETURN LDA #PRN,I IF #PRN = 0, SZA,RSS RN UNAVAILABLE JMP RNALL IF SO, INFORM USER AND TERMINATE SPC 2 * * (C) ALLOCATE LOG DEVICE/FILE * LDA #TYPE,I DISK LOG FLAG SET? SSA JMP DISC1 YES--BRANCH TO CREAT * JSB EXEC NO--WRITE OUT #TYPE & #RECS WORDS HEADER TO TAPE DEF *+1+4 RETURN POINT DEF NA2 WRITE, NO ABORT DEF OUTBI LOG LU # DEF #PLOG+2 HEADER ADDRESS DEF D2 TWO WORDS LONG DEF THERR ERROR RETURN JMP GOLOG SPC 2 * * CREATE & INITIALIZE DISC FILE FOR LOGGING * DISC1 LDA SIZE GET # OF REQUESTS/REPLIES SZA DID USER SPECIFY? JMP DISC2 YES--BRANCH OUT LDA =D300 IF DEFAULTED, cSAVE 300 BUFFERS DISC2 CLB SET UP REGISTERS TO DETERMINE # OF BLOCKS INA ADD 1 TO # BUFFERS FOR HEADER RECORD MPY PKLEN AND MULTIPLY BY BUFFER LENGTH DIV D128 DIVIDE BY BLOCK LENGTH SZB IF B IS NOT ZERO INA ADD ONE TO NUMBER OF BLOCKS STA BLOKS SAVE # OF BLOCKS FOR CREAT CALL * CLB LDA DATAF SZA,RSS DATA FLAG SET? INB NO, REGULAR TYPE 2 FILE INB YES, TYPE 1 FILE FOR FAST XFER STB FTYPE DISC3 JSB CREAT CREATE THE FILE DEF *+1+7 RETURN POINT DEF IDCB DCB FOR FILE (144 WORDS) DEF IERR STATUS/ERROR WORD (ON SUCCESS = # OF 64W BLOCKS IN FILE) DEF NAME FILE NAME DEF ISIZE BLOCK AND RECORDS SIZES DEF FTYPE DEF SEC WRITE PROTECT SECURITY CODE DEF CRN CARTRIDGE SSA,RSS ANY ERRORS RETURNED? JMP DISC4 NO--BRANCH AROUND CPA M2 YES--DUPLICATE FILE? RSS JMP DOERR NO--INFORM USER OF ERROR AND TERMINATE * * HERE IF PLOG INITIATED FOR FILE LOG & DISC FILE ALREADY EXISTS * LDA .ASK ASK USER IF OLD FILE SHOULD BE PURGED LDB D23 AND ITS LENGTH JSB PRINT PRINT MESSAGE JMP TERM2 ERROR RETURN LDA INLU IOR =B400 SET ECHO MODE STA INLU JSB EXEC GET ANSWER DEF *+1+4 DEF NA1 DEF INLU DEF YE/NO YES/NO BUFFER DEF D1 JMP TERM2 ERROR RETURN LDA YE/NO CMA,INA ADA =AYE O.K. TO PURGE? SZA JMP TERM2 NO, TERMINATE PLOG * JSB OPEN OPEN OLD FILE TO PURGE IT DEF *+1+6 RETURN POINT DEF IDCB TEMPORARY DCB FOR THIS FILE DEF IERR STATUS/ERROR WORD DEF NAME FILE NAME DEF D0 NO UNUSUAL OPTIONS DEF SEC SECURITY CODE  DEF CRN CARTRIDGE SSA IF AN ERROR--TELL USER & TERMINATE JMP DOERR * JSB PURGE PURGE OLD FILE DEF *+1+5 RETURN POINT DEF IDCB TEMPORARY DCB FOR THIS FILE DEF IERR STATUS/ERROR WORD DEF NAME FILE NAME DEF SEC SECURITY CODE DEF CRN CARTRIDGE SSA JMP DOERR JMP DISC3 * DISC4 ARS STA #SIZE,I SET # OF 128W BLOCKS CLA STA CNTR SET FIRST WORD IN PKLIN TO 0 INA STA #CRNT,I SET CURRENT RECORD NUMBER TO ONE JSB WRITF AND WRITE FIRST RECORD, 1ST WORD =0 DEF *+1+5 RETURN POINT DEF IDCB DEF IERR ERROR STATUS WORD--PLACE HOLDER DEF PKLIN RECORD ADDRESS DEF PKLEN RECORD LENGTH DEF #PLOG+5 #CRNT, THE CURRENT RECORD # IN RES SSA ANY ERRORS RETURNED? JMP DHERR YES--INFORM USER & TERMINATE ISZ #CRNT,I NO--BUMP RECORD ADDRESS JSB OPEN OPEN FILE FOR NON-EXCLUSIZE USE DEF *+1+6 THIS WILL ALSO POST FILE DEF IDCB DCB FOR FILE DEF IERR STATUS/ERROR WORD DEF NAME FILE NAME DEF D3 SHARED, UPDATE OPTIONS DEF SEC SECURITY CODE DEF CRN CARTRIDGE SSA ANY ERRORS RETURNED? JMP DHERR YES--INFORM USER & TERMINATE SPC 2 * * READY TO START LOGGING * GOLOG LDA CLNUM GET CLASS # STA #CLAS,I TELL THE DS WE ARE READY (SET #PLOG'S CLASS) JSB IFBRK CLEAR BREAK FLAG DEF *+1 LDA .STAR LDB =D7 JSB PRINT PRINT START MESSAGE JMP TERM1 SPC 2 * * GET LOGGED DATA * GETNX JSB #GETR DEF *+6 DEF CLNUM DEF RQARE DEF RQMAX DEF DAARE DEF DAMAX JMP GTERR ADA C#LSZ ADD THE APPANDAGE LEN STA CNTR SAVE AS REQUEST LENGTH LDA 1 ,LOAD RETURNED DATA LENGTH CMB,INB ADB DAMAX MAX LENGTH - RETURNED LEN SSB LDA DAMAX RETURNED LEN > MAX LEN, USE MAX LEN STA DLEN SAVE DATA LENGTH * LDA CLNUM ALR,RAR CLEAR 'SAVE BUFFER' BIT STA CLNUM JSB EXEC DUMMBY GET TO RELEASE SAM BUFFER DEF *+5 DEF NA21 DEF CLNUM DEF D0 DEF D0 JMP GTERR * LDA CNTR SZA,RSS ZERO LENGTH REQUEST? JMP TERM1 YES--TIME TO QUIT DLD $TIME DST BTIME PUT SYSTEM TIME INTO OUTPUT BUFFER JSB WRTRQ WRITE BUFFER TO LOG DEVICE SPC 2 * * CHECK END OF LOG REQUEST * JSB IFBRK SEE IF USER WANTS TO TERMINATE DEF *+1 SZA,RSS JMP GETNX IF NOT, JUST CONTINUE SPC 2 * * HERE ON BR,PLOG * CLA SHUT OFF PLOG TO DS/1000 STA #CLAS,I JSB EXEC SEND A ZERO LENGTH BUFFER DEF *+1+7 TO SIGNIFY END OF LOG DEF NA18 WRITE W/NO ABORT DEF D0 NO DATA DEF D0 DEF D0 DEF D0 DEF D0 ZERO LENGTH REQUEST PARAMETER DEF CLNUM CLASS WORD JMP ZWERR ERROR RETURN CCE LDA CLNUM GET CLASS # RAL,ERA SET NO WAIT BIT STA CLNUM JMP GETNX AND CONTINUE CLEAN UP SPC 2 * * PROGRAM TERMINATION: * THE SEQUENCE OF TERMINATION IS VERY IMPORTANT SINCE AT * DIFFERENT POINT OF THE PROGRAM, DIFFERENT RESOURCES NEED * TO BE RELEASED. * * RESOURCES ARE ALLOCATED IN THIS ORDER: * A. CLASS NUMBER * B. RESOURCE NUMBER * C. LOG DEVICE/FILE * THEREFORE THEY ARE DEALLOCATED/RELEASED IN THIS ORDER: * A. LOG DEVICE/FILE * B. RESOURCE NUMBER * C. CLASS NUMBER * * * (A) RELEASE LOG DEVICE/FILE * TERM1 LDA #TYPE,I LOAD TYPE OF LOG DEVICE SSA DISC LOG? JMP DTERM DISC, BRANCH AROUND WEOF CALL JSB WEOF WITH BREAK DURING TAPE LOG, WRITE EOF & JMP TERM2 GO ON * DTERM LDA #TYPE,I DISC, SET UP FIRST RECORD FOR FILE STA CNTR LDA #CRNT,I CONTAINS: #TYPE, #CRNT, #SIZE, AND #RECS LDB #SIZE,I DST BTIME LDA #RECS,I STA RQARE CLA,INA SET CURRENT RECORD # TO 1 STA #CRNT,I JSB WRTRQ AND WRITE OUT FIRST RECORD JSB CLOSE THEN CLOSE FILE DEF *+1+1 DEF IDCB IGNORE ANY ERRORS SSA JMP DCERR * * * (B) RELEASE RESOURCE # * TERM2 LDA #PRN,I RESOURCE NUMBER ALLOCATED? SZA,RSS JMP TERM3 NO--BRANCH TERM3 JSB RNRQ YES--RELEASE IT DEF *+1+3 RETURN ADDRESS DEF RN32 CLEAR RN, NO ABORT DEF #PLOG+1 RN IN RES DEF STAT STATUS WORD--UNUSED JMP RRERR CLA STA #PRN,I ERASE VALUE IN RES SPC 2 * * (C) RELEASE CLASS # * TERM3 LDA CLNUM GET CLASS WORD SZA,RSS CLASS NUMBER ALLOCATED? JMP DONE NO--BRANCH AROUND DEALLOCATION. CLA STA #CLAS,I SHUT OFF PLOG TO DS/1000 * * FLUSH BUFFERS AND DEALLOCATE CLASS # * JSB CLRQ DEF *+3 DEF FUNC2 DEF CLNUM JMP RCERR * * DONE -- PLOG TERMINATES * DONE LDA .ENDM PRINT "END PLOG" MESSAGE LDB D6 JSB PRINT NOP * JSB EXEC THEN TERMINATE DEF *+1+3 RETURN ADDRESS DEF D6 REQUEST CODE = TERMINATE DEF D0 THIS PROGRAM, DEF D0 NORMALLY SKP HED PLOG--WRTRQ ROUTINE * * ROUTINE TO WRITE OUT BLOCK AND DO FILE AND TAPE MANAGEMENT * WRTRQ NOP JSB RNRQ LOCK RN DEF *+1+3 RETURN ADDRESS DEF RN1 1 = LOCAL LOCK, W/ WAIT, NO ABORT DEF #PLOG+1 RESOURCE NUMBER DEF STAT PLACE HOLDER--UNUSED JMP LKERR ERROR RETURN  LDA #TYPE,I IF DISC LOG, SSA BRANCH TO WRITF CALL JMP WRTDS * * TAPE WRITE * LDA OUTLU BEFORE WRITE, IOR =B600 GET DYNAMIC STATUS STA TEMP JSB EXEC DEF *+3 DEF NA3 DEF TEMP CONWD NOP IGNORE ERROR FOR NOW STA TEMP STORE STATUS SO WE CAN CHECK LATER * JSB EXEC IF TAPE, WRITE OUT BLOCK OF INFO DEF *+1+4 RETURN ADDRESS DEF NA2 2 = WRITE, NO ABORT DEF OUTBI LOGGING LU # DEF PKLIN OUTPUT BLOCK ADDRESS DEF #RECS,I OUTPUT LENGTH RSS ERROR, SKIP NEXT JUMP JMP UNLK DST EXCER STORE ERROR CODE CCA SET ERROR FLAG STA TEMP * UNLK EQU * JSB RNRQ UNLOCK RN DEF *+1+3 RETURN ADDRESS DEF RN4 4 = CLEAR LOCK, NO ABORT DEF #PLOG+1 RESOURCE NUMBER DEF STAT PLACE HOLDER--UNUSED JMP LKERR ERROR RETURN LDA TEMP GET FLAG WORD SSA ANY ERRORS? JMP TWERR YES--INFORM USER AND B40 EOT CONDITION? SZA,RSS JMP WRTRQ,I NO--RETURN * JSB REWND REWIND TAPE LDA .EOT LDB D18 INFORM USER JSB PRINT NOP JMP TERM2 FLUSH SYSTEM--THEN TERMINATE SPC 2 * * HERE IF FILE IS DISC MEDIUM * WRTDS JSB WRITF WRITE RECORD TO FILE DEF *+1+5 RETURN ADDRESS DEF IDCB DCB FOR FILE DEF IERR STATUS/ERROR WORD DEF PKLIN OUTPUT BLOCK ADDRESS DEF #RECS,I OUTPUT LENGTH DEF #PLOG+5 RECORD NUMBER (IN RES) * SSA,RSS STATUS POSITIVE? JMP WRTD2 YES--BRANCH TO RECORD BUMP CPA M12 NO--EOF ENCOUNTERED? RSS JMP DWERR NO--INFORM USER OF ERROR * LDA B2000 YES--SET FULL BUFFER BIT IN #TYPE IOR #TYPE,I STA #TYPE,I LDA D2 ̾ CURRENT RECORD # = RECORD # 2 STA #CRNT,I JMP WRTDS TRY WRITING RECORD AGAIN * WRTD2 JSB POST POST THE FILE TO MAKE SURE DEF *+1+1 THE RECORD GETS OUT TO THE DISC DEF IDCB SSA IF ANY ERRORS ON POST, JMP DWERR INFORM USER & TERMINATE * ISZ #CRNT,I RECORD WRITTEN, INCREMENT RECORD NUMBER JSB RNRQ UNLOCK RN DEF *+1+3 RETURN ADDRESS DEF RN4 4 = CLEAR LOCK, NO ABORT DEF #PLOG+1 RESOURCE NUMBER ADDR. IN RES DEF STAT PLACE HOLDER--UNUSED JMP LKERR ERROR RETURN JMP WRTRQ,I AND NORMAL RETURN SKP HED PLOG--UTILITY ROUTINES * * ROUTINE TO ADD AN EOF TO MAG TAPE LOG * WEOF NOP LDA OUTLU SET CONTROL BIT IN LU WORD FOR WRITE IOR B100 STA CNTRL JSB EXEC DEF *+1+2 RETURN ADDRESS DEF NA3 CONTROL WRITE-END-OF FILE DEF CNTRL W/ NO ABORT NOP (IGNORE ANY ERRORS) JSB REWND REWIND TAPE BITS FOR REWIND JMP WEOF,I AND RETURN * REWND NOP ROUTINE TO REWIND MAG TAPE LDA OUTLU SET CONTROL BITS IN LU FOR REWIND IOR B400 STA CNTRL JSB EXEC DEF *+1+2 DEF NA3 CONTROL (W/ NO ABORT) DEF CNTRL REWIND NOP ERRORS IGNORED JMP REWND,I SPC 2 * * ROUTINE TO WRITE TO THE OPERATOR'S CONSOLE * PRINT NOP STA .MSG PUT BUFFER ADDRESS STB .MSGL AND BUFFER LENGTH INTO CALL JSB EXEC WRITE TO CONSOLE LU DEF *+1+4 RETURN ADDRESS DEF NA2 2 = WRITE, NO ABORT DEF INLU CONSOLE LU .MSG NOP DEF .MSGL JMP PRINT,I ERROR RETURN ISZ PRINT BUMP TO NORMAL RETURN ADDRESS JMP PRINT,I .MSGL NOP SPC 2 * * ROUTINE TO TERMINATE CLONES OF PLOG * CLONE NOP JSB PNAME GET ACTUAL NAME OF PRCOGRAM DEF *+2 DEF PNAM PROGRAM NAME ARRAY LDA "PLOG+2 LAST 2 CHARS = " "? CPA PNAM+2 RSS JMP PLERR NOPE LDA "PLOG+1 YES, NEXT CHARS = "OG"? CPA PNAM+1 RSS JMP PLERR NOPE LDA "PLOG YES, NEXT CHARS = "PL"? CPA PNAM RSS JMP PLERR NOPE JMP CLONE,I THIS REALLY IS PLOG, SO RETURN SPC 2 * * ROUTINES TO HANDLE ERROR CONDITIONS * PLERR LDA PNAM NO CLONES ALLOWED! STA PLER+2 NAME OF PROGRAM MUST BE PLOG DLD PNAM+1 INSERT BAD NAME DST PLER+3 LDA .PLER LDB D25 JSB PRINT NOP JMP DONE CUERR LDA .CUER CLASS CLEANUP ERROR LDB D23 JSB PRINT NOP JMP DONE RNALL LDA .RNER GET UNALLOCATED RN MESSAGE LDB D19 AND ITS LENGTH JSB PRINT NOP JMP TERM3 CLALL LDA .CLER GET UNALLOCATED CLASS # LDB D22 MESSAGE AND ITS LENGTH JSB PRINT NOP JMP DONE INERR LDA .INER LDB D20 JSB PRINT NOP JMP DONE LUERR LDA .LUER GET ILLEGAL LOG LU MESSAGE LDB D19 AND ITS LENGTH JSB PRINT NOP JMP DONE SZERR LDA .SZER LDB D22 JSB PRINT NOP JMP DONE THERR DST EXCER+2 SAVE A & B REGS.--ERROR CODE LDA .EXER GET ADDRESS OF ERROR CODE LDB D20 AND ITS LENGTH JSB PRINT NOP JMP TERM2 TWERR LDA .EXER LDB D20 JSB PRINT NOP JMP TERM1 ZWERR DST EXCER+2 LDA .EXER LDB D20 JSB PRINT NOP JMP TERM1 GTERR DST EXCER+2 LDA .EXER LDB D20 JSB PRINT NOP JMP TERM1 LKERR LDA .LKER LDB D20 JSB PRINT NOP JMP TERM1 RRERR LDA .RRER LDB D20 JSB PRINT T NOP JMP TERM3 RCERR DST EXCER+2 LDA .EXER LDB D20 JSB PRINT NOP JMP DONE DHERR JSB FIERR JMP TERM1 DOERR JSB FIERR JMP TERM2 DWERR JSB FIERR JMP TERM2 DCERR JSB FIERR JMP TERM2 FIERR NOP CMA,INA SET ERROR CODE POSITIVE STA TEMP JSB KCVT AND CONVERT CODE TO ASCII DEF *+1+1 DEF TEMP STA FILER+8 PUT CODE INTO ERROR MESSAGE LDA .FIER GET ADDRESS OF ERROR MESSAGE LDB D19 AND ITS LENGTH JSB PRINT NOP JMP FIERR,I SPC 2 * * ERROR AND ALLOCATION PROBLEM MESSAGES * PLER ASC 25, ** IS ILLEGAL NAME--PROGRAM MUST BE PLOG .PLER DEF PLER CUER ASC 23, ** ERROR-- RUN PLOG,-1 TO CLEAN UP RESOURCES .CUER DEF CUER EOTMS ASC 18, ** END OF TAPE -- PLOG TERMINATING .EOT DEF EOTMS CLER ASC 22, ** CLASS # UNAVAILABLE -- PLOG TERMINATING .CLER DEF CLER RNER ASC 19, ** RN UNAVAILABLE -- PLOG TERMINATING .RNER DEF RNER LKER ASC 20, ** RN LOCKING ERROR -- PLOG TERMINATING .LKER DEF LKER RRER ASC 20, ** CANNOT RELEASE RN -- PLOG TERMINATING .RRER DEF RRER RCER ASC 23, ** CANNOT RELEASE CLASS # -- PLOG TERMINATING .RCER DEF RCER EXCER ASC 20, ** EXEC ERROR -- PLOG TERMINATING .EXER DEF EXCER LUER ASC 19, ** ILLEGAL LOG LU -- PLOG TERMINATING .LUER DEF LUER INER ASC 20, ** ILLEGAL INPUT LU -- PLOG TERMINATING .INER DEF INER SZER ASC 22, ** ILLEGAL BUFFER SIZE -- PLOG TERMINATING .SZER DEF SZER ASK ASC 23, ** DUPLICATE FILE -- PURGE OLD FILE? (YE/NO) .ASK DEF ASK FILER ASC 19, ** FMP ERROR - -- PLOG TERMINATING .FIER DEF FILER ENDM ASC 6, ** END PLOG .ENDM DEF ENDM STAR ASC 7, ** START PLOG .STAR DEF STAR SPC 2 * * CONSTANTS AND WORK AREAS * D0 DEC 0 DECIMAL CONSTANTS D1 DEC 1 D2 DEC 2 D3 DEC 3 D6 DEC 6 D18 DEC 18 D19 DEC 19 D20 DEC 20 D23 DEC 23 D22 DEC 22 D25 DEC 25 D27 DEC 27 D29 DEC 29 D64 DEC 64 D128 DEC 128 M2 DEC -2 M12 DEC -12 B40 OCT 40 B100 EQU D64 B400 OCT 000400 B2000 OCT 002000 NA1 OCT 100001 EXEC CALL REQUESTS WITH NA2 OCT 100002 NO ABORT BITS SET NA3 OCT 100003 NA18 OCT 100022 NA21 OCT 100025 RN1 OCT 040001 RN4 OCT 040004 RN32 OCT 040040 ALLOC OCT 140020 NDEAL OCT 020000 MASKS FOR SETTING DO NOT DEALLOCATE BIT FUNC1 OCT 140001 NO WAIT, NO ABORT, GET CLASS # FUNC2 OCT 140002 NO WAIT, NO ABORT, DEALLOCATE CLASS # & BUFFERS PNAM BSS 3 STORAGE FOR CURRENT PROGRAM NAME "PLOG ASC 3,PLOG ONLY ALLOWABLE PROGRAM NAME CFLG BSS 1 PLOG CLEAN UP FLAG (-1 => DOING CLEANUP) * * THIS AREA IS USED BY #PKUP AND SHOULD ALWAYS BE IN THIS ORDER * PMASK BYT 5,2 FIVE PARAMETERS, 2ND IS IN NAMR FORMAT INLU BSS 1 CONSOLE LU NAME BSS 10 LOG FILE NAME PTYPE EQU NAME+3 PARAMETER TYPE FROM NAMR SEC EQU NAME+4 LOG SECURITY CRN EQU NAME+5 LOG CRN DATAF BSS 1 DATA FLAG SIZE BSS 1 # OF BUFFERS DEBUG BSS 1 DEBUG FLAG * DEFLU NOP DEFAULT LU OUTLU EQU NAME LOG LU OUTBI NOP LOG LU WITH BINARY WRITE BIT SET PLNAM ASC 3,'PLOG DEFAULT FILE NAME PLSEC ASC 1,DS DEFAULT SECURITY CODE PLCRN DEC 0 DEFAULT CARTRIDGE STAT NOP STATUS WORD FOR EXEC CALLS TEMP NOP TEMPORARY STORAGE AREA IERR NOP CLNUM NOP CLASS WORD CNTRL NOP I/O CONTROL WORD RQMAX ABS #MXR+#LSZ HEADER MAX DAMAX ABS 128-#MXR-#LSZ-4 DATA MAX C#LSZ ABS #LSZ YE/NO NOP FTYPE NOP * ISIZE BSS 2 BLOKS EQU ISIZE # OF DISC BLOCKS PKLEN EQU ISIZE+1 RECORD SIZE * PKLIN BSS 128 CNTR EQU PKLIN BTIME EQU PKLIN+1 RQARE EQU PKLIN+3 DLEN EQU PKLIN+3+#MXR+#LSZ DAARE EQU PKLIN+4+#MXR+#LSZ IDCB BSS 144 BSS 0 END PLOG ZXTTZ Vj 91750-18148 2013 S C0122 &POPEN              H0101 ASMB,Q,C,Z *USE 'ASMB,N' FOR DS/1000 ONLY, AND 'ASMB,Z' FOR DS/1000 & DS/3000 IFN NAM POPEN,7 91750-1X148 REV.2013 800710 ALL RTE-RTE XIF IFZ NAM POPEN,7 91750-1X148 REV.2013 800710 MEF RTE-RTE-MPE XIF UNL IFN HED POPEN (DS/1000) 91750-1X148 * (C) HEWLETT-PACKARD CO 1980 XIF IFZ HED POPEN (DS/1000 & DS/3000) 91750-1X148 * (C) HEWLETT-PACKARD CO 1980 XIF LST * * IFN OPTION * NAME: POPEN * SOURCE: 91750-18148 * RELOC: 91750-1X148 * PRGMR: CHUCK WHELAN * MODIF'D: GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S * MODIF'D: JDH [790220] FOR DS REQUEST EQUATED OFFSETS * MODIF'D: DWT [790531] FOR PHASE FOUR (RELOCATION OF RQB) * MODIF'D: JDH [791010] FOR REMOTE SESSION POPEN "ICLON" PARAM * MODIF'D: DMT [800709] TO CHECK FOR SLAVE NAME = 0 * * IFZ OPTION * NAME: POPEN * SOURCE: 91750-18148 * RELOC: 91750-1X148 * PRGMR: CHUCK WHELAN & JIM HARTSELL * MODIFIED BY DMT [790327] FOR DS/1000 ENHANCEMENTS (NEW D3KMS) * SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 1 ENT POPEN,PREAD,PWRIT,PCONT,PCLOS,PNRPY EXT #MAST,#MSTC,#TTOV,#NODE EXT .MVW EXT .ENTR EXT #RQB RQB EQU #RQB IFZ EXT #LU3K EXT D3KMS,D$INI,D$STW,D$ASC,D$3BF,D$TAG EXT D$RQB,D$NWD,D$ZRO XIF A EQU 0 B EQU 1 SUP * SPC 1 * THIS PROGRAM PERFORMS ALL MASTER PROGRAM TO PROGRAM FUNCTOIONS * IN THE DISTRIBUTED SYSTEM. ON EACH REQUEST IT DOES THE FOLLOWING: * : * 1. MOVES PCB FROM USER AREA TO REQUEST (EXCEPT POPEN) * 2. VERIFIES SUFFICIENT PARAMETERS PASSED IN CALL * 3. MOVES 20 WORD TAG FIELD INTO REQUEST (EXCEPT PCLOS) * 4. SETS STREAM, FUNCTION, AND ORIGINATOR NODE INTO REQUEST * 5. CALLS "#MAST" TO SEND REQUEST (& DATA) AND GET REPLY * 6. IF NO SYSTEM ERROR, MOVES TAG FIELD INTO USER AREA (EXCEPT PCLOS) * 7. EXAMINES STATUS & GIVES "ACEPT", "REJCT", OR ERROR CODE BACK TO CALLER SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREAc #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV XXXX 790420 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, LSTEN, REMAT * * * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SKP IPCB NOP IERR NOP INAM NOP INODE NOP ITAG NOP ICLON NOP ENAM EQU ICLON DS/3000: ENTRY NAME IFZ NOP DS/3000: CONTROL INFORMATION. NOP LOADING OPTIONS. BUFSZ NOP MAX DATA RECORD LENGTH XIF SPC 3 POPEN NOP * * MASTER REQUESTS FOR POPEN COME HERE * * CALL POPEN(IPCB,IERR,INAM,INODE,ITAG [,ICLON]) * JSB .ENTR PICK UP THE USER PARAMETERS DEF IPCB * * MAKE SURE POPEN NAME ISN'T NUMERIC 0. * LDA POPEN SET ERROR RETURN. STA RTRN LDA IERR STA ERRAD LDA N41 PRE-SET ERROR TO -41. LDB INAM GET NAME PARAMETER. SZB,RSS IF NOT PROVIDED, JMP ERR2 REPORT -40. LDB B,I GET VALUXE. SZB,RSS IF ZERO, JMP SETER REPORT -41. * LDB IPCB USER'S PCB ADDRESS LDA INODE,I DESTINATION NODE ADB K3 4TH WORD OF PCB HAS NODE STA 1,I PUT IT THERE STA RQB+#DST SAVE IT * CLA,INA INITIALIZE POPEN FUNCTION CODE = 1. STA POFCN * LDA ICLON CLONING/ENAM PARAMETER SPECIFIED? SZA,RSS JMP BUILD NO. LDB ICLON,I YES. DO THEY WANT CLONING? LDA POFCN (ENAM IS AN ASCII PARAMETER) CPB K1 IOR BIT13 YES. SET BIT 13 OF FUNCTION WORD. STA POFCN * BUILD LDB POPEN SET UP ERROR RETURN LDA IERR JSB BLDRQ SET UP BASIC REQST IPRAM DEF ITAG POFCN NOP FCN = 1 IFZ JMP QOPEN DO POPEN TO 3000 XIF * LDA BIT15 MAKE SURE POPEN ALWAYS STA CONWD BYPASS NO-REPLY OPTION LDA INAM ADDR OF NAME FIELD LDB RPCBA ADDR OF PCB IN REQ BUFFER JSB .MVW MOVE NAME INTO PCB FIELD DEF K3 NOP * LDA IPCB * NODAT LDB DUMAD USE DUMMY AS DATA POINTER STB DBUF CLB STB WRLEN SET WRITE DATA LENGTH = 0 * * * THIS CODE IS USED IN COMMON BY ALL P TO P CALLS * MAIN STB RDLEN SET READ DATA LENGTH STA PCBAD SAVE PCB ADDRESS * LDA K4 STA RQB+#STR SET P TO P STREAM IN REQ * LDA CONWD GET CONTROL WORD SLA,RSS IS NO-REPLY OPTION SET? JMP CMAST .NO, JUST CALL #MAST LDB BIT15 STB #MSTC .YES, SET NO-WAIT OPTION IN #MAST LDB TTOV STB #TTOV ALSO, SET TRANSACTION T/O VALUE IN #MAST * * THE CALL TO #MAST WILL: * 1) GET AN I/O CLASS * 2) INSERT SEQ # & ORIGIN NODE * 3) BUILD MASTER TCB * 4) SEND REQUEST (& DATA) * 5) CALL "#GET" TO AWAIT AND GET REPLY * 6) RETURN REPLY (& DATA) * 7) RETURN CONTROL CMAST EQU * JSB #MAST ISSUE REQUEST CALL DEF *+7  DEF CONWD DEF IRBFL REQUEST LENGTH DBUF NOP DATA BUFFER ADDRESS DEF WRLEN DATA WRITE LENGTH DEF RDLEN DATA READ LENGTH DEF IRBFL MAX EXPECTED REPLY LENGTH * JMP ERR ERROR DETECTED LDA RQB+#FCD FUNCTION CODE CPA K5 IS THIS A PCLOS? JMP NOMOV YES, WE'RE DONE * RPCBA EQU *+1 DLD RQB+#PCB GET PCB PCBAD EQU *+1 DST * SAVE 1ST 2 PCB WORDS IN USER AREA * LDA RTAGA ADDR OF TAG FIELD IN REQUEST LDB TAGAD ADDR OF TAG FIELD IN USER AREA JSB .MVW MOVE 20 WORDS TO USER TAG FIELD DEF K20 NOP * NOMOV LDA RQB+#EC2 SZA WAS ERROR DETECTED? JMP EXIT YES, IERR SET LDB RQB+#FCD SSB WAS REQUEST REJECTED? CLA,INA YES, SET REJECT IERR EXIT STA ERRAD,I RETURN IT TO CALLER CLB STB CLEAR,I CLEAR PARAM CHECK LOC STB #MSTC CLEAR NO-WAIT FLAG STB #TTOV CLEAR XACT T/O VALUE LDA BIT15 LDB MODE GET MODE WORD SSB IS NO-REPLY SET FOR ONE TIME ONLY? IOR K1 .NO, CONWD WILL BE SET FOR NO-REPLY STA CONWD SET CONWD JMP RTRN,I RETURN SKP * * MOVE PCB INTO REQUEST BUFFER MVPCB NOP LDB N2 ADB MVPCB POINT TO ADDR OF PCB ADDR LDB 1,I GET ADDR OF PCB ADDR LDA 1,I GET PCB ADDR LDB RPCBA GET ADDR OF PCB IN BUFFER JSB .MVW MOVE 1ST TWO WORDS TO REQUEST DEF K2 NOP INA POINT TO 4TH PCB WORD LDB 0,I GET DESTINATION NODE STB RQB+#DST SAVE IT JMP MVPCB,I RETURN SPC 2 * * COMMON PARAMETER SET-UP AND TAG FIELD MOVE FOR ALL BUT "PCLOS" BLDRQ NOP STB RTRN RETURN ADDRESS FOR ALL STA ERRAD ADDR OF ERROR PARAMETER * DLD BLDRQ,I GET TAG ADDR, AND FUNC CODE STA CLEAR SAVE LAST PA?RAM ADDR LDA 0,I GET ADDR OF USER'S TAG FIELD SZA,RSS WAS LAST PARAM SPECIFIED JMP ERR2 TOO FEW PARAMETERS IN CALL STB RQB+#FCD SET FUNCTION CODE IFZ LDB #LU3K GET DS/3000 LU CMB,INB,SZB,RSS NEGATE JMP *+3 NO 3000 CPB RQB+#DST IS IT NEGATIVE LU OF 3000? JMP RQEX YES, PERFORM DS/3000 P-TO-P XIF LDB C#PLW REQUEST LENGTH STB IRBFL * STA TAGAD LDB RTAGA ADDR OF TAG FIELD IN REQUEST JSB .MVW MOVE TAG FIELD INTO REQ DEF K20 NOP IFZ ISZ BLDRQ XIF RQEX ISZ BLDRQ ISZ BLDRQ JMP BLDRQ,I RETURN SPC 3 * ERROR PROCESSING SECTION ERR ADB NEG00 SUBTRACT ASCII "00" CPA "DS" IS IT A "DSXX" ERROR? SSB AND >= "00"? JMP ERR47 NO, GIVE -47 LDA 1 ADA N9 NUMERIC PART - 9 CMA,SSA SKIP IF DS00 - DS08 ERR47 LDA K11 MAKE A -47 ERROR ADA N58 A = -47 OR -50 THRU -58 JMP EXIT * ERR2 LDA N40 * * INTERNAL ERROR OCCURRED. SET UP DS/1000 REQUEST BUFFER IN CASE USER * WANTS TO CALL DSERR. (NUMERIC ERROR CODE IS IN A-REGISTER.) * SETER STA RQB+#EC2 STORE ERROR. CLB STB RQB+#EC1 STB RQB+#ECQ LDB #NODE SET ERROR NODE STB RQB+#ENO TO LOCAL. JMP EXIT RETURN WITH IERR. SKP * * SET NO-REPLY OPTION: CALL PNRPY[(IMODE[,ITTOV])] * * IMODE = 0 OR DEFAULT => ONE TIME ONLY * IMODE < 0 => ALL FOLLOWING PTOP CALLS * IMODE > 0 => TURN OFF NO-REPLY OPTION * ITTOV => TRANSACTION TIME-OUT OVERRIDE * IMODE NOP ITTOV NOP PNRPY NOP JSB .ENTR DEF IMODE LDB IMODE IMODE PASSED? SZB LDB IMODE,I .YES, PICK UP MODE PARAMETER STB MODE STORE IT IN MODE LDA BIT15 GET BIT 15 FOR CONWD SZB,RSS MODE = 0? IOR K1 .YES, OR IN NO-REPLY BIT SSB MODE < 0? IOR K1 .YES STA CONWD LDA ITTOV ITTOV PASSED? SZA .NO LDA ITTOV,I .YES, PICK UP TTOV PARAMETER CMA,INA AND =B377 IGNORE ALL BUT THE RIGHT BYTE STA TTOV STORE IT AWAY CLA STA IMODE CLEAR IMODE FOR NEXT CALL STA ITTOV JMP PNRPY,I RETURN * MODE NOP TTOV NOP SKP * * READ REQUESTS * RIPCB NOP RIERR NOP RIBUF NOP RIL NOP RITAG NOP * PREAD NOP JSB .ENTR GET USER PARAMETERS DEF RIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST * LDB PREAD RETURN ADDRESS LDA RIERR JSB BLDRQ BASIC REQUEST PROCESSING RPRAM DEF RITAG K2 DEC 2 IFZ JMP QREAD PERFORM PREAD TO 3000 XIF * LDA BIT15 STA CONWD MAKE SURE PREAD WILL ALWAYS WAIT LDA RIBUF SAVE BUFFER ADDRESS STA DBUF LDB RIL,I SAVE DATA LENGTH STB RQB+#PCB+2 * CLA STA WRLEN CLEAR WRITE DATA LENGTH LDA RIPCB PCB ADDRESS JMP MAIN NOW DO LINE COMM & RETURN SKP * * WRITE REQUESTS * PIPCB NOP PIERR NOP PIBUF NOP PIL NOP PITAG NOP * * PWRIT NOP PWRITE REQUESTS HERE JSB .ENTR PICK UP PARAMETERS DEF PIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDB PWRIT SET UP ERROR RETURN LDA PIERR JSB BLDRQ BUILD BASIC REQST PPRAM DEF PITAG K3 DEC 3 IFZ JMP QWRIT PERFORM PWRIT TO 3000 XIF * LDA PIBUF GET DATA ADDRESS STA DBUF LDA PIL,I GET DATA LENGTH STA RQB+#PCB+2 STA WRLEN * LDA PIPCB CLB JMP MAIN NOW DO LINE COMM & RETURN SKP * * CONTROL REQUESTS * CIPCB NOP CIERR NOP CITAG NOP * * PCONT NOP JSB .ENTR GET PARAMETERS DEF CIPCB  JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDB PCONT SET UP RETURN ADDR LDA CIERR JSB BLDRQ BUILD BASIC REQST CPRAM DEF CITAG K4 DEC 4 IFZ JMP QCONT PERFORM PCONT TO 3000 XIF * LDA CIPCB PCB ADDRESS JMP NODAT DO LINE COMM & RETURN SKP * * CLOSE REQUESTS * FIPCB NOP FIERR NOP * * RTRN EQU * PCLOS NOP JSB .ENTR GET PARAMETERS DEF FIPCB JSB MVPCB MOVE 2 WORD PCB INTO REQUEST BUFR * LDA DFIEA STA CLEAR SAVE LAST PARAM ADDR LDA FIERR SZA,RSS ERROR ADDR SPECIFIED? JMP ERR2 NO, GIVE ERROR STA ERRAD SET ERROR ADDRESS IFZ LDA #LU3K GET 3000 LU CMA,INA,SZA,RSS NEGATE IT JMP *+3 JUMP IF NO 3000 LINK CPA RQB+#DST WAS NEGATIVE LU OF 3000 SPECIFIED? JMP QCLOS YES, DO PCLOS TO 3000 XIF * LDA L#PCB STA IRBFL 11 WORD REQUEST LDA K5 STA RQB+#FCD FUNCTION CODE = 5 * LDA FIPCB PCB ADDRESS JMP NODAT DO COMMUNICATION & RETURN SKP * * DATA AREA * IRBFL NOP WRLEN NOP RDLEN NOP K1 OCT 1 K5 DEC 5 K11 DEC 11 K20 DEC 20 N2 DEC -2 N9 DEC -9 N40 DEC -40 N41 DEC -41 N58 DEC -58 NEG00 OCT 147720 BIT13 OCT 20000 BIT15 OCT 100000 "DS" ASC 1,DS CONWD OCT 100000 ERRAD NOP TAGAD NOP CLEAR NOP DFIEA DEF FIERR RTAGA DEF RQB+#TAG ADDR OF REQ TAG FIELD DUMAD DEF * * * DEFINE REQUEST L#PCB ABS #PCB+3 C#PLW ABS #PLW IFN UNL XIF IFZ SKP * * GENERATE POPEN REQUEST FOR REMOTE DS/3000 COMPUTER. * QOPEN LDA ITAG STA TAGAD * LDA ITAG SZA,RSS JMP ERR2 ILLEGAL NUMBER OF PARAMETERS. * LDA IPRAM POINT TO ADDR OF FIRST PARAM. JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB SETOC SET STREAM, CLASS, ANDc "RFA ". * LDA B25 JSB D$STW FUNCTION CODE = 25 OCTAL. * LDA INAM MOVE PROGRAM NAME (UP TO 28 BYTES). LDB N14 (DELIMITER = BLANK) JSB D$ASC * INA (A) = TOTAL BYTES IN REQUEST. ARS NEED TO INSERT TRAILING BLANKS ADA N17 IN PROGRAM NAME FIELD? STA TEMP SSA,RSS JMP MVENT NO. * LOOP2 LDA BLNKS YES. ADD TRAILING BLANKS JSB D$STW TO FILL OUT 14-WORD FIELD. ISZ TEMP JMP LOOP2 * MVENT LDA ENAM MOVE ENTRY NAME (UP TO 8 BYTES). LDB N4 DELIMITER = BLANK. JSB D$ASC * INA (A) = TOTAL BYTES IN REQUEST. ARS ADA N21 NEED TO INSERT TRAILING BLANKS STA TEMP IN ENTRY NAME FIELD? SSA,RSS JMP MVTAG NO. * LOOP3 LDA BLNKS YES. ADD TRAILING BLANKS TO FILL JSB D$STW OUT 4-WORD FIELD. ISZ TEMP JMP LOOP3 * MVTAG LDA N20 MOVE TAG FIELD. JSB D$NWD * CLA MOVE 2 PARAMETERS. LDA ENAM+1,I JSB D$STW CLA LDA ENAM+2,I JSB D$STW LDA N3 ZERO 3 WORDS. JSB D$ZRO CLA LDA BUFSZ,I GET USER'S MAX BLOCK SIZE. SZA IF NOT SUPPLIED, ZERO, OR SSA NEGATIVE, USE MAXSZ. LDA MAXSZ JSB D$STW * * SET UP PARAMETER MASK AS FOLLOWS: * BIT 9 = PROGRAM NAME * BIT 8 = ENTRY NAME * BIT 7 = 0 * BIT 6 = CONTROL INFO (PARAMS) * BIT 5 = LOADING OPTIONS (FLAGS) * BIT 4 = 0 (STACKSIZE) * BIT 3 = 0 (DLSIZE) * BIT 2 = 0 (MAXDATA) * BIT 1 = 0 * BIT 0 = 0 * LDA DPARM FWA PARAM ADDR LIST. STA TEMP LDA N5 COUNTER. STA CONTR CLA INITIALIZE PARAMETER MASK. * LOOP4 LDB TEMP,I GET ADDR OF NEXT PARAM. LDB B,I SZB IOR B1 SET BIT IF PARAM SPECIFIED. RAL MOVE IT OVER. ISZ TEMP ISZ CONTR JMP LOOP4 LOOP TILL DONE. ALF BITS 0-4 = 0. JSB D$STW * * REQUEST BUFFER READY. D3KMS WILL WRITE IT TO QUEX'S I/O * CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET * IS COMPLETED WHEN THE REPLY ARRIVES. * JSB D3KMS SEND REQUEST AND WAIT FOR REPLY. DEF *+2 DEF BIT15 JMP E3K ERROR RETURN. * JSB PASSP RETURN ERROR CODE AND TAG FIELD. * LDA D$RQB RETURN PCB FROM REPLY. ADA K10 (CURRENTLY NOT USED - ALL ZEROES) LDB IPCB JSB .MVW DEF K3 NOP * LDA ERRAD,I JMP RTRN,I RETURN TO CALLER. * * DPARM DEF *+1 TABLE OF POPEN PARAMETER DEF INAM ADDRESSES FOR BIT MASK. DEF ENAM DEF B0 DEF ENAM+1 DEF ENAM+2 SPC 1 * * SUBROUTINE TO PASS RETURNED ERROR CODE AND TAG * FIELD TO THE USER PROGRAM. * PASSP NOP JSB CLER CLEAR DS/1000 ERROR INDICATOR. LDB D$3BF+8 RETURN ERROR CODE. CLA MAP DS/3000 TO DS/1000 ERROR CODES. CPB CG211 INA CCG & 211 = 1 (REJECT). CPB CL209 LDA N41 CCL & 209 = -41. CPB CL205 LDA N42 CCL & 205 = -42. CPB CG210 LDA N44 CCG & 210 = -44. CPB CL213 LDA N44 CCL & 213 = -44. STA ERRAD,I STA RQB+#EC2 SET DS/1000 ERROR. * LDA D$RQB ADA K13 RETURN TAG FIELD. LDB TAGAD JSB .MVW DEF K20 NOP JMP PASSP,I SPC 1 * CLEAR DS/1000 ERROR CODES. CLER NOP CLA STA RQB+#EC1 STA RQB+#EC2 STA RQB+#ENO STA RQB+#ECQ JMP CLER,I SKP * * GENERATE PREAD REQUEST FOR REMOTE DS/3000 COMPUTER. * QREAD LDA RITAG STA TAGAD SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA RPRAM POINT TO ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDA K4 SET CLASS TO 4 STA D$3BF LDA B22 AND STREAM TO 22. STA D$3BF+2 * CLA JSB D$STW * LDA RIL,I GET USER BUFFER LENGTH. SSA,RSS IF NEGATIVE, JMP *+4 CMA,INA MAKE POSITIVE AND INA CONVERT FROM BYTES CLE,ERA TO WORDS. JSB D$STW STORE IN REQUEST BUFFER. * LDA RIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * * SEND REQUEST TO THE 3000 AND WAIT FOR REPLIES. * JSB D3KMS SEND REQUEST AND GET REPLY. DEF *+6 DEF BIT15 DEF 0 DEF 0 DEF RIBUF,I DEF RIL,I JMP E3K ERROR RETURN. * JSB PASSP SET ERROR CODE. * LDA D$TAG MOVE TAG FIELD. LDB TAGAD JSB .MVW DEF K20 NOP * LDA ERRAD,I JMP RTRN,I RETURN TO USER. SPC 2 SKP * * GENERATE PWRIT REQUEST FOR REMOTE DS/3000 COMPUTER. * QWRIT LDA PITAG STA TAGAD * SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA PPRAM POINT TO ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDA K4 SET CLASS TO 4 STA D$3BF LDA B23 AND CLASS TO 23. STA D$3BF+2 * CLA JSB D$STW * LDA PIL,I GET USER BUFFER LENGTH. JSB D$STW STORE IN REQUEST BUFFER (TCOUNT). * LDA PIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * * SEND REQUESTS TO THE 3000 AND GET THE REPLY. * JSB D3KMS DEF *+4 DEF BIT15 DEF PIBUF,I DEF PIL,I JMP E3K ERROR RETURN. * JSB PASSP RETURN ERROR CODE & TAG TO USER. a LDA ERRAD,I JMP RTRN,I RETURN TO CALLER. SKP * * GENERATE PCONT REQUEST FOR REMOTE DS/3000 COMPUTER. * QCONT LDA CITAG STA TAGAD * SZA,RSS JMP ERR2 ILLEGAL # PARAMETERS. * LDA CPRAM ADDR OF 1ST PARAM (TAG). JSB D$INI INITIALIZE BUFFER STUFFERS. * LDA K4 SET CLASS TO 4 STA D$3BF LDA B24 AND STREAM TO 24. STA D$3BF+2 * LDA N2 CLEAR FIRST 2 APPENDAGE WORDS. JSB D$ZRO * LDA CIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) LDA N20 MOVE TAG FIELD. JSB D$NWD * * SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY. * JSB D3KMS DEF *+2 DEF BIT15 JMP E3K ERROR RETURN. * JSB PASSP RETURN ERROR CODE & TAG FIELD. * LDA ERRAD,I JMP RTRN,I RETURN. SKP * * GENERATE PCLOS REQUEST FOR REMOTE DS/3000 COMPUTER. * QCLOS LDA B6 SET CLASS TO 6 STA D$3BF LDA B22 AND STREAM TO 22 STA D$3BF+2 CLA AND APPENDAGE LEN TO 0. STA D$3BF+7 * JSB D3KMS SEND BREAK REQ TO 3000, DEF *+2 AND GET THE REPLY. DEF BIT15 JMP E3K ERR RETURN * LDA FIERR ADDR OF 1ST PARAM (DUMMY). JSB D$INI INITIALIZE BUFFER STUFFERS. * JSB SETOC SET CLASS, STREAM, AND "RFA ". LDA B26 STORE FCN CODE = 26 OCTAL. JSB D$STW * LDA FIPCB MOVE PCB TO REQUEST. JSB MVPC (EMPTY AT PRESENT) * * SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY. JSB D3KMS SEND REQUEST AND GET REPLY. DEF *+2 DEF BIT15 JMP E3K ERROR RETURN. * JSB CLER CLEAR DS/1000 ERROR INDICATOR. CLA RETURN ERROR CODE ZERO. STA ERRAD,I JMP RTRN,I RETURN. SKP * * MOVE PCB FROM USER ARRAY TO REQUEST BUFFER. * MVPC NOMvNLHP STA TAGPR POINTER TO PCB. LDA N3 STA CONTR MVP1 LDA TAGPR,I JSB D$STW ISZ TAGPR ISZ CONTR JMP MVP1 JMP MVPC,I SPC 3 * * SET UP FOR POPEN/PCLOSE. * SETOC NOP LDA B7 SET CLASS TO 7 STA D$3BF LDA B21 AND STREAM TO 21. STA D$3BF+2 * LDA "RF" STORE "RFA ". JSB D$STW LDA "A" JSB D$STW * JMP SETOC,I RETURN. SPC 3 * D3KMS REPORTED AN ERROR. SET UP DS/1000 HEADER IN CASE USED CALL DSERR. * E3K DST RQB+#EC1 SAVE ASCII ERROR CODE. LDA #NODE STORE NODE # IOR BIT15 AND "ASCII" BIT. STA RQB+#ENO CLA CLEAR QUALIFIER. STA RQB+#ECQ LDA RQB+#EC1 RESTORE ASCII CODE. JMP ERR CONVERT TO NUMERIC. SKP * * CONSTANTS AND WORKING STORAGE. * B0 OCT 0 B1 OCT 1 B6 OCT 6 B7 OCT 7 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B26 OCT 26 K10 DEC 10 K13 DEC 13 N3 DEC -3 N4 DEC -4 N5 DEC -5 N14 DEC -14 N17 DEC -17 N20 DEC -20 N21 DEC -21 N42 DEC -42 N44 DEC -44 CL205 OCT 040315 CL209 OCT 040321 CG210 OCT 000322 CG211 OCT 000323 CL213 OCT 040325 MAXSZ DEC 4096 MAXIMUM USER BUFFER SIZE. "RF" ASC 1,RF "A" ASC 1,A BLNKS ASC 1, TEMP NOP * TAGPR NOP CONTR NOP XIF * LST * BSS 0 SIZE OF POPEN * END ,N Wi 91750-18150 2013 S C0122 &PROGL +              H0101 |ASMB,R,L,C HED PROGL 91750-16150 (C) HEWLETT-PACKARD CO 1980 NAM PROGL,19,30 91750-16150 REV.2013 800407 (ALL) SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 4 **************************************************************** * * NAME: PROGL * SOURCE: 91750-18150 * RELOC: 91750-16150 * PGMR: JOHN LAMPING * * WRITTEN BY CHUCK WHELAN [MAY 1976] * MODIFIED BY DMT [JANUARY 1978] * MODIFIED BY LYLE WEIMAN [JANUARY 1978] * MODIFIED BY CCH [MARCH 1979] TO ELIMINATE REFERENCE TO . * MODIFIED BY PETER BRICKEY [MAY 1979] * MODIFIED BY JOHN LAMPING [AUGUST 1979] * *************************************************************** SPC 3 * * * DS/1000 PROGL MODULE FOR CONCURRENT MULTI-TERMINAL DOWNLOADS * ENT PROGL * EXT EXEC,OPEN,READF,CLOSE,$OPSY,#RQUE,#GETR EXT CNUMD,KCVT,LOCF,.MVW,#PRLU,RMPAR,XLUEX,DTACH * * * #ACTV EQU 4 NUMBER OF ACTIVE DOWNLOADS AT ONE TIME * #TERM EQU 32 NUMBER OF POSSIBLE COMM. LINES * #LSZ EQU 2 DS HEADER APPENDAGE LENGTH SKP * * * "PROGL" IS A DISTRIBUTED SYSTEM COMMUNICATIONS MONITOR. IT * SERVICES ALL SYSTEM DOWNLOAD REQUESTS FROM "CBL" SOFTWARE AT * REMOTE SATELLITES. WHEN A NEW REQUEST IS RECEIVED, THE REQUESTED * ABSOLUTE FILE CONTAINING THE CORELOAD IS TRANSMITTED RECORD-BY- * RECORD USING CLASS I/O WRITE/READ OPERATIONS TO THE COMMUNICATIONS * DRIVER. * * WHEN "PROGL" IS NOT EXECUTING IT IS IN A CLASS I/O GET * SUSPENSION WAITING FOR AN ENTRY TO BE PLACED ON THE CLASS QUEUE * FOR ITS CLASS NUMBER. ENTRIES ARE PLACED ON THIS QUEUE WHEN A * NEW DOWNLOAD REQUEST IS RECEIVED OR A PREVIOUS CLASS I/O WRITE * COMPLETES. * * THE REQUEST PASSED TO "PROGL" BY "QUEUE" HAS THE DOWNLOAD FILE * FILE NUMBER (BINARY) IN THE FIRST WORD. THE DOWNLOAD FILE NUMBER IS * CONVERTED TO AN ASCII FILE NAME CONSISTING OF 'P' FOLLOWED BY THE FIVE * ASCII DIGIT OCTAL EQUIVALENT OF THE NUMBER. * * THE NUMBER OF DOWNLOADS THAT CAN BE ACTIVE AT ANY ONE TIME * IS LIMITED ONLY BY SYSTEM AVAILABLE MEMORY AND THE SIZE OF THE * ACTIVE DOWNLOAD TABLE. IN-PROCESS DOWNLOADS HAVE AN ENTRY IN * THIS TABLE CONSISTING OF LU, SEQ #, THE 144 WORD DCB FOR THE DOWNLOAD * FILE, AND THE FILE NUMBER. IF A NEW REQUEST IS RECEIVED WHILE * THIS TABLE IS FULL, IT IS PLACED IN A TWO WORD (LU, & FILE #) * ENTRY IN A WAIT QUEUE. WHEN AN ENTRY BECOMES AVAILABLE * IN THE ACTIVE TABLE, AN ENTRY IN THE WAIT QUEUE CAN BE ACTIVATED. * THE NUMBER OF ENTRIES IN THE ACTIVE TABLE IS SET AT ASSEMBLY TIME * BY THE ITEM "#ACTV". * * THE LU, SEQ# AND DESTINATION ADDRESS OF THE DOWNLOAD REQUEST ARE * PASSED IN THE REQUEST BUFFER OF EACH CLASS I/O WRITE/READ. THE ROUTINE * INSURES THAT ONLY ONE DOWNLOAD TO A LU IS IN PROCESS BY RE-USING THE SAME * TABLE ENTRY WITH A NEW SEQ # IF A DOWNLOAD IS RESTARTED, AND * IGNORING I/O COMPLETIONS (ERRORS OR NOT) WITH WRONG SEQ. NUMBERS. * * EACH TIME THAT "PROGL" IS ENTERED ON A CLASS WRITE * COMPLETION, IT CHECKS THE RETURNED ERROR STATUS FOR DRIVER * ERRORS AND IF NONE, READS THE NEXT RECORD FROM THE DOWNLOAD * FILE, WRITES IT TO THE DRIVER AND AGAIN SUSPENDS ON ITS CLASS. * * WHEN ALL RECORDS IN THE DOWNLOAD FILE HAVE BEEN SUCCESSFULLY * TRANSMITTED, "PROGL" SENDS A ZERO-LENGTH RECORD TO THE SATELLITE * TO INDICATE THE DOWNLOAD IS COMPLETE. AT THIS TIME, THE FILE IS * CLOSED (UNLESS IT IS OPEN MORE THAN ONCE), THE TABLE ENTRY IS CLEARED, * AND UNLESS A WAIT QUEUE ENTRY CAN BE ACTIVATED, "PROGL" AGAIN SUSPENDS * ON ITS CLASS. * * * OPTIONAL FEATURE: THE USER MAY ELECT TO HAVE 'PROGL' PRINT * A MESSAGE ON A SPECIFIED LU EACH TIME A DOWN-LOAD IS INITIATED, * AND ALSO AT TERMINATION ( SUCCESS OR FAILURE). AN EXAMPLE * MESSAGE IS SHOWN BELOW: *INITIATING VIA LU 7 DOWNLOAD OF FILE:P00000 AT DAY 5, 9 :10AM *DOWNLOAD OF FILE:P00000 AT DAY 5, 9 :11AM WAS SUCCESSFUL * * THE TIME OF INITIATION AND TIME OF TERMINATION ARE PRINTED (NOT * NECESSARILY EQUAL). * * THERE ARE TWO WAYS TO SELECT THIS OPTION: * 1) PROGRAMMATICALLY--WRITE A PROGRAM TO DECLARE '#PRLU' AS AN * EXTERNAL SYMBOL (THIS SYMBOL IS IN SUBSYSTEM GLOBAL AREA, SO * THE PROGRAM MUST BE LOADED GIVING IT ACCESS TO SSGA). * IT SHOULD STORE THE LU ON WHICH YOU WANT THESE MESSAGES IN * * #PRLU. * 2) AT GENERATION TIME--IN THE SECTION WHERE ENTRY POINT REPLACEMENTS * ARE ACCEPTED BY THE RTE GENERATOR, ENTER THE FOLLOWING * LINE (THIS IS AN EXAMPLE, SHOWING HOW TO SPECIFY THAT THE * MESSAGES ARE TO BE PRINTED ON LU 1): * * #PRLX,ABS,1 SKP * * PROGL WAS MODIFIED TO SET THE DRIVER TO NON-DS MODE BEFORE * INITIATING A DOWNLOAD AND TO USE THE NEW CALLING FORMAT WHEN * REQUESTING THIS DOWNLOAD. IT WILL NOW SEND THE DRIVER THE ENTIRE * BUFFER AND LET THE DRIVER FIGURE OUT THE DOWNLOAD ADDRESS AND THE * TRANSMISSION LENGTH. WHEN THE DOWNLOAD FINISHES OR IS TERMINATED * PROGL WILL SET THE DRIVER TO DS MODE. SINCE THE DRIVER ERROR CODES * WERE ALSO CHANGED, PROGL'S ERROR DETECTION WAS CHANGED TO * ACCOMODATE THESE CHANGES. * * FOR TYPE 1 FILES PROGL WILL ADD 3 WORDS TO EACH RECORD SENT * TO THE DRIVER, TWO WORDS WILL BE ADDED AT THE START OF THE RECORD * AND ONE WORD AT THE END. THE FIRST WORD WILL CONTAIN THE RECORD * LENGTH (NUMBER OF ACTUAL DATA WORDS) IN THE HIGH ORDER BYTE, THE * LOW ORDER BYTE IS SET TO 0, WORD 2 WILL g CONTAIN THE DESTINATION * ADDRESS FOR THIS RECORD AND THE LAST WORD WILL CONTAIN THE * CHECKSUM. THE CHECKSUM WILL BE COMPUTED AND INSERTED INTO THE LAST * WORD OF THE RECORD BEFORE THE RECORD IS GIVEN TO THE DRIVER. * * SINCE THE ABOVE SETS UP THE TYPE 1 FILE TO LOOK LIKE A TYPE 7 * FILE THE ONE VERSION OF PROGL WILL BE ABLE TO DOWNLOAD EITHER A * TYPE 1 OR A TYPE 7 FILE USING EITHER DVA65 OR DVA66. PROGL WILL * KNOW THAT IT IS DOWNLOADING A TYPE 1 FILE SINCE, FOR A TYPE 1 * FILE, BIT 15 OF THE SEQ# IS SET. * NOTE: SINCE A TYPE 1 FILE DOES NOT CONTAIN A CHECKSUM THERE * IS NO WAY TO GUARANTEE THAT THE FILE WILL CONTAIN CORRECT DATA * WHEN PROGL RECEIVES IT. * * FOR EITHER TYPE 1 OR TYPE 7 FILE THE DRIVER WILL SEE THE * FOLLOWING FORMAT: * * 15 8 7 0 * +---------------+--------------+ * WORD 1 ! WORD COUNT ! 0 ! * +---------------+--------------+ * * +------------------------------+ * WORD 2 ! DESTINATION ADDRESS ! * +------------------------------+ * * +------------------------------+ * WORD 3 ! DATA ! * +------------------------------+ * ! * ! * ! * ! * V * +------------------------------+ * WORD N-1 ! DATA ! * +------------------------------+ * * +------------------------------+ * WORD N ! CHECKSUM ! * +------------------------------+ SKP * * > PROGL WILL DETERMINE THE TYPE OF THE REQUESTED DOWNLOAD FILE. * IF IT IS A TYPE 1 FILE, ONE RECORD (MAXIMUM OF 128 WORDS) WILL BE * READ. THE WORD COUNT (N) WILL BE PUT INTO THE HIGH ORDER BYTE OF * THE FIRST WORD WHILE THE COMPUTED DESTINATION ADDRESS IS PUT INTO * THE SECOND WORD. THE DESTINATION ADDRESS WILL BE 2 FOR THE FIRST * RECORD AND PROGL WILL START DOWNLOADING WITH THE THIRD WORD OF * THIS RECORD, THEN FOR THE FOLLOWING RECORDS IT WILL BE COMPUTED AS * DA[PRESENT] = DA[PAST] + N[PAST] AND THE ENTIRE RECORD WILL BE * DOWNLOADED. THE N DATA WORDS WILL THEN BE PLACED INTO THE BUFFER * STARTING AT THE THIRD WORD, THE CHECKSUM IS COMPUTED AND PUT INTO * THE LAST WORD (N+3) OF THE BUFFER. THE FOLLOWING FORMAT IS USED * BY PROGL TO CALL THE DRIVER: * * JSB EXEC * DEF *+8 * DEF CONWD 300B+LU * DEF DBUF DATA BUFFER ADDRESS * DEF DLEN N+3 * DEF RQBUF 3 WORD REQUEST BUFFER * WORD 1 = LU * WORD 2 = SEQ # * WORD 3 = DESTINATION ADDRESS * DEF RLEN 3 * DEF CLASS CLASS NUMBER * * PROGL WILL ISSUE A CLASS WRITE TO THE DRIVER AND THEN GO INTO * ITS WAIT STATE UNTIL THE DRIVER RESPONDS. IF THE DRIVER RESPONDS * WITH A GOOD STATUS PROGL WILL PROCEED TO DOWNLOAD THE NEXT RECORD. * ASSUMING GOOD RESPONSES FROM THE DRIVER PROGL WILL CONTINUE TO * DOWNLOAD RECORDS UNTIL IT GETS AN EOF WHEN READING THE FILE, AT * THIS TIME PROGL WILL ISSUE A CLASS WRITE WITH A DATA LENGTH OF 3 * (N=0) AND A 3 WORD DATA BUFFER CONISTING OF 0,0,0 TO SIGNIFY THE * END OF THIS DOWNLOAD. * * IF THE DRIVER RESPONDS WITH AN ERROR STATUS INDICATING A * PROTOC@OL, TIMEOUT OR MEMORY OVERFLOW ERROR PROGL WILL ABORT THIS * DOWNLOAD. THE ABORT WILL BE INDICATED TO THE DRIVER BY ISSUING A * CLASS WRITE WITH A DATA LENGTH OF 3 WORDS AND A 3 WORD DATA BUFFER * CONSISTING OF 0,-3,-3 (DRIVER ERROR). PROGL MAY ALSO INDICATE * AN ABORT TO THE DRIVER IN CASE OF FILE OPEN ERROR (0,-1,-1) OR * A FILE READ ERROR (0,-2,-2). AFTER ABORTING THE DOWNLOAD PROGL * WILL RETURN THE DRIVER TO DS MODE. SKP * * PROGL IS ENTERED HERE INITIALLY PROGL EQU * ENTRY. JSB RMPAR PROGL IS SCHEDULED DEF *+2 WITH ITS CLASS NUMBER DEF DBUF AS A PARAMETER JSB DTACH DETACH FROM ANY SESSION DEF *+1 WE MIGHT HAVE BELONGED TO LDA DBUF SZA,RSS JMP PGET NOT FIRST TIME AND MSKCN GET JUST CLASS NUMBER STA CLAS1 SAVE PROGL'S CLASS IOR B20K ADD DO NOT DE-ALLOCATE BIT STA CLAS2 SAVE FOR BUFFER FLUSHING * INITIALIZE FILE NUMBERS LDB NACTV SET UP LOOP STB CNTR COUNTER = - # ENTRIES LDB D12N LOAD CLOSED MARKER CCA POINT TO FIRST ADA TABAD FILE NUMBER ENTRY BUMP ADA TLENT STB 0,I STORE MARKER ISZ CNTR DONE? JMP BUMP NO. MARK NEXT ONE * * * SUSPEND UNTIL A NEW REQUEST IS WRITTEN TO MONITOR OR COMPLETION * ON A PREVIOUS DRIVER WRITE OCCURS * PGET JSB #GETR WAIT FOR NEXT REQUEST OR I/O COMPLETION DEF *+7 DEF CLAS1 DEF RQBUF DEF D3 DEF BUFR DEF D2 DEF IERR HLT 77B FATAL ERROR, GENERATE MP ADA LSIZE SAVE ACTUAL STA RQLEN REQUEST LENGTH CPA D3 IF REQ LEN IS 3, THIS IS I/O COMPLETION JMP IOCOM PROCESS I/O COMPLETION SZA,RSS IS THERE NO Z BUFFER CMB,INB AND DATA LENGTH INB,SZB,RSS ALSO EQUAL TO 1? JMP REQST YES, HANDLE NEW DOWNLOAD REQUEST IGNO\DR JSB RLEAS NO, RELEASE THIS BUFFER JMP PGET CONTINUE TO WAIT * * PROCESS NEW DOWNLOAD REQUEST * REQST JSB EXEC RELEASE BUFFER AND GET OPTIONAL PARAMETER DEF *+6 DEF D21 DEF CLAS2 DEF BUFR DEF D2 DEF LU LDA D2 IN CASE THIS IS TO BE A TYPE 1 FILE STA DADD SET-UP THE DESTINATION ADDRESS JSB SRCH SEARCH FOR ENTRY IN DOWNLOAD TABLE CLB,RSS THIS LU WASN'T IN TABLE JMP RSTRT FOUND, CLEAR & RESTART * * NO PREVIOUS ACTIVE ENTRY FOR LU CPB CURAD WAS DOWNLOAD TABLE FULL? JMP FULL YES, QUEUE THIS ENTRY LDA LU LU STA CURAD,I STORE IN 1ST WORD OF DOWNLOAD ENTRY JMP RSTR1 * * SAME LU, USE SAME TABLE ENTRY WITH NEW SEQ # & TIME-TAGS RSTRT EQU * JSB PRFAL PRINT OLD FILE NAME & MSG THAT DEF .ABR1 DOWN-LOAD WAS ABORTED JSB CLSE CLOSE PREVIOUS DOWNLOAD FILE SPC 2 RSTR1 EQU * LDA NONDS MUST SET DVA65 TO NON-DS JSB SETMD MODE LDB BUFR FILE # FROM PARMB * * CONVERT FILE # TO BE DOWNLOADED INTO FILE NAME. NEWLD EQU * * CONVERT FILE NUMBER TO ASCII FILE NAME, AND * ALSO CONVERT TIME-OF-DAY TO ASCII. LDA DCBAD GET ADDRESS IN TABLE WHERE ADA D144 FILE # IS TO BE STORED STB 0,I STORE FILE NUMBER THERE. JSB GFNAM * * * OPEN FILE TO BE DOWNLOADED JSB OPEN DO FMGR OPEN DEF *+5 DEF DCBAD,I DCB ADDRESS DEF IERR DEF NAME DEF ZERO * LDA #PRLU DOES USER WISH AN ANNOUNCEMENT OF THIS? SZA,RSS JMP POPN1 NO, CONTINUE STA LUPRN YES, SAVE PRINT LU * JSB LOCF FIND FILE LU DEF *+9 DEF DCBAD,I DEF SRCH DON'T CARE ABOUT THIS ERROR DEF SRCH DON'T CARE ABOUT 'IREC' PARAMETER DEF SRCH DON'T CARE ABOUT 'IR:B' PARAMETER DEF SRCH DON'T CARE ABOUT 'IOFF' PARAMETER DEF SRCH DON'T CARE ABOUT 'JSEC' PARAMETER DEF .DLU SAVE FILE LU HERE DEF .TYP SAVE FILE TYPE HERE JSB KCVT CONVERT FILE LU TO ASCII DEF *+2 DEF .DLU STA .DLU JSB KCVT CONVERT FILE TYPE DEF *+2 DEF .TYP STA .TYP * JSB CNUMD CONVERT LINE LU NUMBER TO ASCII DEF *+3 DEF LU DEF .LU. JSB EXEC PRINT IT DEF *+8 DEF D18N PROTECT OURSELVES AGAINST BOGUS LU DEF LUPRN DEF MSG1 DEF MSG1L DEF D0 DEF D4 DEF CLAS1 USE OUR OWN CLASS NUMBER NOP * POPN1 EQU * * LDA POOLS GET THE POOL SEQUENCE NUMBER INA INCREMENT TO GET SEQ# OF THIS DOWNLOAD SSA MAKE SURE BIT 15 IS 0 CLA,INA RESET POOL STA POOLS IN ANY CASE REPLACE UPDATED POOL LDB IERR GET ERROR STATUS CPB D1 IS THIS A TYPE 1 FILE? IOR BIT15 YES, BIT 15 OF SEQ# FLAGS TYPE 1 FILE STA SEQ# IN ANY CASE, PUT IT IN REQUEST BUFFER STA SEQAD,I AND 2ND WORD OF DOWNLOAD ENTRY CMB,SSB,INB FINALLY CHECK ERROR STATUS JMP NEXT ALL OK, CONTINUE SPC 2 OPNER EQU * STB IERR SAVE POSITIVE ERROR FOR CNUMD LDB #PRLU USER WANT MESSAGES? SZB,RSS JMP ERR1 NO, JUST CLEAR OUT ENTRY STB LUPRN JSB CNUMD DEF *+3 DEF IERR DEF FILER JSB EXEC PRINT FILE-OPEN ERROR MESSAGE DEF *+8 DEF D18N DEF LUPRN DEF MSG3 DEF MSG3L DEF D0 DEF D4 DEF CLAS1 NOP JSB PRFAL PRINT "DOWNLOAD FAILED" MESSAGE DEF .FAIL JMP ERR1 HED SEND NEXT DOWNLOAD RECORD * (C) HEWLETT-PACKARD CO 1979 * * * ENTER HERE WHEN COMPLETION OF PREVIOUS WRITE HAS OCCURRED * IOCOM JSB SRCH FIND DOWNLOAD TABLE ENTRY FOR LU JMP CLEAR LU NOT IN TABLE, RELEASE LINKE LDA SEQAD,I GET SEQ # OF TABLE ENTRY CPA SEQ# DOES IT MATCH? RSS YES JMP IGNOR NO, IGNORE THIS COMPLETION * CHECK DRIVER ERROR STATUS LDA IERR GET ERROR STATUS FROM DRIVER RAR BIT 1 WILL TELL SLA,RSS LSB OF EQT5 JMP ACCPT NO ERRORS, DO NEXT * * DRIVER ERROR OCCURRED * AND B100 TEST FOA A RETRYABLE ERROR CLE,SZA JMP FAIL NONE, SO TREAT AS HARD FAILURE * LDA CURAD,I GET RETRY COUNT ADA RTBIT BUMP RETRY COUNT STA CURAD,I SEZ RETRIES EXHAUSTED? JMP FAIL YES * ISZ ERCNT KEEP RETRY COUNT NOP FOR THOSE INTERESTED JSB EXEC SUSPEND FOR 200 MILLISECS DEF *+6 DEF D12N DEF D0 DEF D1 DEF D0 DEF M20 D0 NOP LDA LU SET UP CONWRD IOR BIT15 FOR RETHREAD CALL STA CONWD JSB #RQUE RE-THREAD REQUEST ONTO CLASS NUMBER DEF *+9 DEF D20N DEF CONWD DEF ZERO DEF ZERO DEF ZERO DEF ZERO DEF CLAS1 DEF CLAS1 SZA,RSS OK? JMP PGET YES * FAIL JSB RLEAS RELEASE CLASS BUFFER JSB PRFAL PRINT "DOWNLOAD FAILED..." MESSAGE DEF .FAL1 JMP ERR3 CLEAR OUT TABLE ENTRY * CLEAR JSB RLEAS RELEASE CLASS BUFFER JMP CLMDE SET DS MODE AND RETURN TO THE GET * ACCPT JSB RLEAS RELEASE CLASS BUFFER SKP * * THIS SECTION IS ENTERED TO GET NEXT RECORD FROM DOWNLOAD FILE. * NEXT LDA SEQ# DETERMINE IF THIS IS A LDB BFAD TYPE 1 FILE SSA CHECK IT JMP *+3 TYPE 1, READF CALL MUST BE MODIFIED LDA LEN7 TYPE 7, RESET THE MAXIMUM LENGTH JMP *+6 AND SKIP THE GARBAGE LDA DADD NOW THE [READ ADDRESS MUST BE MODIFIED CPA D2 UNLESS IT IS THE FIRST RECORD JMP *+2 IT IS ADB D2 OK, ADD 2 WORDS TO START OF BUFFER LDA LEN1 AND READ ONLY 128 WORDS * STA MAXL SET THE READ LENGTH STB RDBUF ITS EITHER MODIFIED OR RESET * JSB READF READ NEXT RECORD DEF *+6 DCBAD NOP DEF IERR RDBUF DEF DBUF THIS IS EITHER DBUF OR DBUF+2 (TYPE 1) DEF MAXL MAX ALLOWED LENGTH DEF LENX ACTUAL LENGTH * LDA IERR WAS THE READ ERRORLESS? CPA M12 IF A TYPE 1 FILE -12 INDICATES EOF JMP EOFND IT WAS SSA JMP ERR2 ERROR IN FILE READ * LDB LENX SSB CHECK FOR EOF JMP EOFND FOUND, WRAP IT UP * LDA SEQ# CHECK THE FILE TYPE SSA,RSS IS IT A TYPE 1 FILE? JMP VCKSM THIS IS NOT A TYPE 1, VERIFY CHECKSUM LDB DADD GET THIS DESTINATION ADDRESS SSB HAS THE ADDRESS GONE NEGATIVE? JMP EOFND YES, ONLY LOAD 32K STB DBUF+1 SAVE IT IN THE SECOND WORD LDA LENX THEN BUILD LENGHT WORD CPB D2 IS THIS THE FIRST TYPE 1 RECORD? ADA M2 YES MODIFY THE LENGTH STA LENX BETTER SAVE IT ADB LENX WHILE WE ARE AT IT, BETTER COMPUTE STB DADD THE NEW DESTINATION ADDRESS ALF,ALF NOW POSITION THE COUNT AND B1774 MAKE SURE BITS 0-7 ARE CLEAR STA DBUF FIRST BUFFER WORD IS DONE LDB LENX AGAIN! ADB D3 THIS TIME FOR THE DRIVER STB LENX * * VERIFY/BUILD CHECKSUM OF NEXT RECORD TO BE DOWNLOADED * VCKSM LDA DBUF GET THE WORD COUNT ALF,ALF AND B377 SZA,RSS IS THIS A ZERO LENGTH RECORD? JMP NEXT YES, IGNORE IT INA INCLUDE DESTINATION ADDRESS CMA,INA STA CNTR WORD COUNTER. CLA LDB DBFAD BUFFER ADDRESSu CKSML ADA 1,I ADD UP THE WORDS. INB ISZ CNTR JMP CKSML STB BUFR SAVE THE CHECKSUM ADDRESS FOR NOW LDB SEQ# SINCE WE HAVE TO DETERMINE IF SSB THIS WAS A TYPE 1 FILE STA BUFR,I YES, SAVE THE CHECKSUM CPA BUFR,I IN ANY CASE, COMPARE THE CHECKSUMS RSS JMP CKSME NOT EQUAL. * * CHECKSUM OK, SETUP TO WRITE THIS RECORD LDA LU GET LU IOR BIT15 SET "TRUE LU" FLAG STA CONWD LDA CURAD,I AND MSKLU INITIALIZE RETRY COUNT STA CURAD,I * * NOW DO CLASS I/O WRITE/READ TO DRIVER * JSB XLUEX DEF *+8 DEF D20N NO ABORT BIT IS SET DEF CONWD WRITE DATA DEF DBUF DATA BUFFER ADDR DEF LENX BUFFER LENGTH DEF RQBUF DEF D3 DEF CLAS1 WRITE IT ON PROGL'S CLASS RSS ERROR * NOW GO INTO SUSPEND ON PROGL'S CLASS UNTIL A DRIVER WRITE COMPLETES * OR A NEW REQUEST IS RECEIVED. JMP PGET JSB PRFAL CLASS-IO ERROR DEF .CLSR JMP CLMDE SET DS MODE THEN GO GET NEW REQUEST * * * ENTER HERE WHEN END OF DOWNLOAD FILE IS DETECTED * RETURN GOOD STATUS FOR A SUCCESSFUL DOWNLOAD * EOFND EQU * LDA #PRLU DOES USER WISH SZA,RSS ANNOUNCEMENTS? JMP EOFN1 NO. STA LUPRN LDA DCBAD GET ADDRESS OF ADA D144 FILE # ENTRY LDB 0,I JSB GFNAM CONVERT FILE NUMBER TO FILE NAME LDA @SUC MOVE 'WAS SUCCESSFUL' TO PRINT BUFFER LDB @RSLT JSB .MVW DEF D8 NOP JSB EXEC DEF *+8 DEF D18N DEF LUPRN DEF MSG2 DEF MSG2L DEF D0 DEF D4 DEF CLAS1 NOP EOFN1 EQU * JSB CLSE CLOSE DOWNLOAD FILE CLA 0= GOOD DOWNLOAD * TERM STA EBUF+1 SET STATUS FOR TRANSMISSION STA EBUF+2 AND IN CHECKSUM LDdA LU IOR BIT15 STA CONWD SET DVA65 CONTROL WORD * JSB XLUEX WRITE FINAL REQUEST DEF *+8 DEF D20N CLASS WRITE/READ TO COMM DRIVER DEF CONWD DEF EBUF DEF D3 DEF RQBUF DEF D3 DEF CLAS1 PROGL CLASS NUMBER NOP * * THIS DOWNLOAD IS OVER * CLEAN OUT DOWNLOAD TABLE ENTRY AND GIVE SPACE TO * ANY ENTRY FOUND IN WAITING QUEUE * CLA STA CURAD,I SET DOWNLOAD ENTRY AS AVAILABLE LDA DS MUST ALSO SET THIS EQT JSB SETMD TO DS MODE LDB WAITA LDA NQUE STA CNTR COUNTER= -# OF WAITQ ENTRIES * CKQUE LDA 1,I SZA SKIP IF SLOT EMPTY JMP ACTIV OTHERWISE, ACTIVATE IT ADB D2 ISZ CNTR JMP CKQUE JMP PGET NOTHING QUEUED, SUSPEND ON 'GET' * * NOW ACTIVATE A WAITING DOWNLOAD REQUEST FROM THE WAIT QUEUE USING * THE ACTIVE DOWNLOAD TABLE SPACE WHICH WAS JUST MADE AVAILABLE * ACTIV STA CURAD,I MOVE LU TO TABLE ENTRY JUST CLEARED STA LU AND PUT IT IN "LU" TOO !!! CLA STA 1,I CLEAR WAIT QUEUE ENTRY INB LDB 1,I PICKUP FILE # AND START DOWNLOADING IT JMP NEWLD * CLMDE LDA DS SET EQT TO DS MODE JSB SETMD BEFORE RETURNING TO JMP PGET WAIT ON THE CLASS GET * * ROUTINE TO SET THE DRIVERS MODE SETMD NOP STA DSCON+1 SAVE FUNCTION LDA LU SET IOR BIT15 DRIVER STA DSCON CONTROL WORD JSB XLUEX SET DRIVER TO CORRECT MODE DEF *+4 DEF D3 DEF DSCON DEF SCODE JMP SETMD,I HED PROGL SUBROUTINES & DATA AREA * (C) HEWLETT-PACKARD CO 1979 * * THIS SUBROUTINE SEARCHES FOR A DOWNLOAD TABLE ENTRY FOR * THE PASSED LU. RETURNS TO P+1 IF NOT FOUND, OTHERWISE P+2 * SRCH NOP LDA NACTV STA CNTR - # OF ACTIVE ENTRIES ALLOWED CLA INITIALIZE ADDR OF EMPTY SLOT STA TPNT LDB TABAD ADDR OF DOWNLOAD TABLE SNXT LDA 1,I PICKUP LU OF THIS ENTRY AND MSKLU MASK POSSIBLE RETRY COUNT CPA LU DOES THIS ONE MATCH LU? JMP SRCHX YES, FOUND DOWNLOAD ENTRY IOR TPNT NO, IS THIS THE 1ST EMPTY SLOT? SZA,RSS SKIP IF EMPTY SLOT ALREADY FOUND STB TPNT STORE ADDR OF 1ST EMPTY SLOT ADB TLENT BUMP TABLE POINTER ISZ CNTR JMP SNXT TRY NEXT * LU NOT IN ACTIVE TABLE LDB TPNT RETURN 1ST EMPTY SLOT INSTEAD RSS RETURN +1 * * FOUND AN ENTRY IN THE ACTIVE DOWNLOAD TABLE FOR THIS LU SRCHX ISZ SRCH RETURN+2 STB CURAD SET ADDRESS OF ENTRY INB STB SEQAD & ADDRESS FOR SEQ # INB STB DCBAD & ADDRESS FOR DCB JMP SRCH,I RETURN * * RELEASE CLASS BUFFER * RLEAS NOP JSB EXEC DO DUMMY CLASS GET DEF *+5 DEF D21 DEF CLAS2 DEF BUFR DEF ZERO JMP RLEAS,I * * CLOSE DOWNLOAD FILE, UNLESS IT IS OPEN FOR ANOTHER DOWNLOAD * CLSE NOP * SET FILE # ENTRY TO INDICATE CLOSED FILE CCA ADA CURAD ADA TLENT LDB 0,I SAVE FILE STB FLNUM NUMBER LDB D12N CLEAR STB 0,I ENTRY * CHECK TO SEE IF THE FILE IS STILL OPEN LDA NACTV SET UP LOOP STA CNTR COUNTER = - # ENTRIES CCA POINT TO FIRST ADA TABAD FILE NUMBER ENTRY BUMP2 ADA TLENT LDB 0,I GET FILE NUMBER CPB FLNUM IF = CURRENT ONE, JMP CLR9 GO DUMMY UP DCB ISZ CNTR MORE TO SEARCH? JMP BUMP2 YES--STAY IN LOOP * CURRENT NUMBER NOT FOUND. CLOSE FILE FOR REAL JSB CLOSE DEF *+3 DEF DCBAD,I DEF IERR JMP CLSE,I * CLEAR WORD 9 OF DCB SO FMP THINKS IT'S CLOSED CLR9 CLA LDB DCBAD ADB D9 STA 1,I JMP CLSE,I * * DOWNLOAD TABLE IS FULL, PUT THIS REQUEST IN WAITING QUEUE * FULL LDA NQUE STA CNTR -QUEUE TABLE SIZE CLA STA TPNT LDB WAITA ADDR OF WAIT QUEUE CKQ LDA 1,I GET LU OF THIS ENTRY CPA LU DOES IT MATCH THIS REQUEST JMP BLDQ YES, THEN SET NEW FILE # IOR TPNT CHECK IF THIS IS 1ST EMPTY SLOT IN QUEUE SZA,RSS SKIP IF NOT STB TPNT SAVE ITS ADDRESS ADB D2 BUMP QUEUE POINTER ISZ CNTR JMP CKQ EXAMINE NEXT ENTRY * * WE NOW KNOW THAT THIS LU WASN'T ALREADY IN WAIT QUEUE LDB TPNT GET ADDRESS OF 1ST EMPTY SLOT SZB,RSS WERE THERE ANY EMPTIES? JMP PGET NO, WE'RE IN TROUBLE LDA LU LU STA 1,I INTO 1ST WORD OF WAIT QUEUE ENTRY * BLDQ INB LDA BUFR FILE # STA 1,I GOES INTO 2ND WORD JMP PGET GO BACK TO SUSPEND ON GET * ERR1 CCA ERROR IN FILE OPEN (A=-1) JMP TERM * HERE WHEN FILE-READ ERROR OCCURS * ERR2 EQU * LDB #PRLU SHOULD WE BOTHER PRINTING ERROR MESSAGE? SZB,RSS JMP ER.2 NO STB LUPRN CMA,INA MAKE ERROR CODE NEGATIVE SO CNUMD CAN CONVERT STA IERR JSB CNUMD DEF *+3 DEF IERR DEF .FILE JSB EXEC PRINT FILE-READ ERROR DEF *+8 DEF D18N DEF LUPRN DEF .RDER DEF D15 DEF D0 DEF D4 DEF CLAS1 NOP JSB PRFAL DEF .FAIL ER.2 EQU * JSB CLSE ERROR IN FILE READ, DO CLOSE LDA M2 (A=-2) JMP TERM SPC 2 ERR3 JSB CLSE DRIVER ERROR, DO CLOSE LDA M3 (A=-3) JMP TERM SPC 2 * HERE ON CHECKSUM ERROR ON READ * CKSME EQU * JSB PRFAL DEF .CKER JMP ER.2 SPC 2 * SUBROUTINE TO CONVERT FILE NUMBER INTO ASCII FILE NAME. * * CA+LLING SEQUENCE: * LDB * JSB GFNAM * * * GFNAM NOP RRL 4 DUAL ROTATE LEFT 4 AND D7 IOR ASCP0 FORM ASCII OF 1ST 2 CHARS STA NAME CLA RRL 3 POSITION 3RD OCTAL DIGIT ALF,RAL MOVE TO LHW RRL 3 GET 4TH DIGIT IOR ASC00 ASCII FOR 3RD & 4TH DIGITS STA NAME+1 CLA RRL 3 5TH DIGIT ALF,RAL TO LHW RRL 3 GET 6TH & FINAL DIGIT IOR ASC00 CONVERT TO ASCII STA NAME+2 LDA #PRLU USER WISH ANNOUNCEMENT? SZA,RSS JMP GFNAM,I NO,RETURN STA LUPRN JSB EXEC YES, INCLUDE TIME-OF-DAY DEF *+3 DEF D11 DEF DBUF JSB CNUMD CONVERT DAY NUMBER DEF *+3 DEF DBUF+4 DEF .DAY LDB AM CONVERT 24-HR TIME TO 12-HR TIME LDA DBUF+3 ADA M12 PM? SSA JMP GFNM1 NO. SZA,RSS 12 NOON? LDA D12 YES STA DBUF+3 LDB PM GFNM1 EQU * STB AMPM LDA DBUF+3 GET HOUR AGAIN SZA,RSS ZERO? LDA D12 YES STA DBUF+3 JSB KCVT CONVERT HOUR NUMBER DEF *+2 DEF DBUF+3 STA .HR JSB KCVT CONVERT MINUTES DEF *+2 DEF DBUF+2 STA .MIN JMP GFNAM,I RETURN TO CALLER SPC 2 * SUBROUTINE TO HANDLE THE REPETITIVE PARTS OF PRINTING * A "DOWN-LOAD FAILED" MESSAGE. * * CALLING SEQUENCE: * JSB PRFAL * DEF * * PRFAL NOP LDA PRFAL,I GET ADDRESS OF MESSAGE ISZ PRFAL BUMP RETURN LDB #PRLU ARE WE SUPPOSED TO SZB,RSS PRINT A MESSAGE? JMP PRFAL,I NO, RETURN TO CALLER STB LUPRN SAVE LU LDB @RSLT MOVE REASON FOR FAILURE INTO JSB .MVW "DOWN LOAD OF..." MESSAGE AREA DEF D8 Z NOP LDA DCBAD GET ADDRESS OF ADA D144 FILE NUMBER LDB 0,I GET FILE NUMBER JSB GFNAM CONVERT THIS TO ASCII & ALSO FORMAT TIME-OF-DAY JSB EXEC PRINT MESSAGE DEF *+8 DEF D18N USE CLASS-I/O DEF LUPRN DEF MSG2 DEF MSG2L DEF D0 DEF D4 LENGTH OF 4 SO WE CAN SEPARATE DEF CLAS1 OUR OWN PRINTOUTS FROM ZERO NOP XMISSION LINE COMPLETIONS JMP PRFAL,I RETURN TO CALLER SPC 2 * * DATA AREA * SUP MSG1 ASC 9, INITIATING VIA LU .LU. BSS 3 MSG2 ASC 9, DOWNLOAD OF FILE: NAME BSS 3 ASC 2,::- .DLU ASC 1, STORAGE FOR FILE DISC LU HERE ASC 1,: .TYP ASC 1, STORAGE FOR FILE TYPE HERE OCT 6412 CARRIAGE RETURN-LINEFEED ASC 4, AT DAY .DAY BSS 3 ASC 1,, .HR NOP ASC 1, : .MIN NOP AMPM BSS 1 'AM' OR 'PM' * .RSLT BSS 8 MSG1L ABS *-MSG1-8 MSG2L ABS *-MSG2-1 * @RSLT DEF .RSLT @SUC DEF *+1 ASC 8, WAS SUCCESSFUL .FAIL ASC 8, HAS FAILED. .ABR1 ASC 8, WAS ABORTED .FAL1 ASC 8, FAILED:LINE ERR .CLSR ASC 8, FAILED:CLASS ER .RDER ASC 12,/PROGL:FILE READ ERROR- .FILE BSS 3 .CKER ASC 8, FAILED:CKSM ERR MSG3 ASC 11,/PROGL:FMP OPEN ERROR- FILER BSS 3 MSG3L ABS *-MSG3 LUPRN NOP AM ASC 1,AM PM ASC 1,PM FLNUM NOP RQLEN NOP IERR NOP CLAS1 NOP CLAS2 NOP ERCNT NOP TPNT NOP CNTR NOP LENX NOP * THE NEXT TWO WORDS MUST BE IN SEQUENCE. CONWD NOP OCT 10300 SUBFUNCTION FOR PROGL WRITES POOLS NOP CURAD NOP SEQAD NOP DSCON BSS 2 * 3 WORD REQUEST AREA RQBUF EQU * LU NOP SEQ# NOP DADD NOP * D1 DEC 1 D2 DEC 2 D18N OCT 100022 NO-ABORT CLASS-I/O 'WRITE' REQUEST CODE D3 DEC 3 D4 DEC 4 D7 DEC 7 D8 DEC 8 D9 DEC 9 D11 DEC 11 D12 DEC 12 D15 DEC 15 D21 DEC 21 D144 DEC 144 M2 DEC -2 M3 DEC -3 M12 DEC -12 M20 DEC fd`-20 BIT15 OCT 100000 B100 OCT 100 B377 OCT 377 B1774 OCT 177400 B20K OCT 20000 D12N OCT 100014 D20N OCT 100024 NONDS OCT 3300 DS OCT 3200 SCODE OCT 70736 RTBIT OCT 1000 INCREMENT FOR RETRY FIELD MSKLU OCT 777 MASK FOR LU WORD MSKCN OCT 17777 MASK TO GET JUST CLASS NUMBER LSIZE ABS #LSZ * TLENT DEC 147 SIZE OF DOWNLOAD TABLE ENTRY NACTV ABS -#ACTV NQUE ABS #ACTV-#TERM MAXL NOP LEN1 DEC 128 LEN7 DEC 255 ASC00 ASC 1,00 ASCP0 ASC 1,P0 * DBFAD DEF DBUF+1 TABAD DEF DT ADDR OF DOWNLOAD TABLE WAITA DEF WAITQ ADDR OF WAITING QUEUE BFAD DEF DBUF ACTUAL ADDRESS OF DOWNLOAD BUFFER * EBUF DEC 0,0,0 TERMINATING BUFFER BUFR BSS 3 THIS MUST BE BEFORE THE FILE INPUT BUFFER DBUF BSS 255 FILE INPUT BUFFER * * THE FOLLOWING RESERVES SPACE FOR THE ACTIVE DOWNLOAD TABLE. * * FORMAT: WORD 1 RETRY COUNT (BITS 15-8), LU (BITS 7-0) * 2 SEQUENCE NUMBER (NOT SAME AS SEQUENCE NUMBERS IN * TCBS) * 3-146 DATA CONTROL BLOCK * 147 FILE NUMBER DT REP #ACTV BSS 147 * * THE FOLLOWING RESERVES SPACE FOR THE WAIT QUEUE WAITQ REP #TERM-#ACTV WAITING QUEUE: LU & FILE # BSS 2 * END PROGL f Xn 91750-18151 2013 S C0122 &PTOPM              H0101 ASMB,R,Q,C HED PTOPM 91750-16151 * (C) HEWLETT-PACKARD CO. NAM PTOPM,19,30 91750-16151 REV.2013 800821 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 EXT EXEC,CLRQ,#OFF,#LOGR,#GETR EXT #SLAV,#RQUE,#PLOG,PGMAD,#NODE EXT #RPB,#SCSM,#ATCH,DTACH RQB EQU #RPB SPC 3 * * NAME: PTOPM * SOURCE:91750-18151 * RELOC: 91750-16151 * PGMR: CHUCK WHELAN * DATE: DEC 1976 * * MODIFICATIONS: * BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S * BY JDH [790220] FOR DS REQUEST EQUATED OFFSETS. * BY DWT [790416] FOR PHASE ONE (NEW MESSAGE HEADER). * BY DWT [790531] FOR PHASE FOUR (RELOCATION OF RQB). * BY DWT [790608] FOR PHASE FIVE (REMOVE O/S DEPENDENCE). * BY JDH [791010] FOR SESSION MONITOR PRE- & POST-PROCESSING. * BY DMT [800812] TO FIX "SLAVE OFF" BUG. * BY DMT [800821] SO SLAVE IS ATTACHED TO SESSION WHEN CLONED AND * FINIS DOES NOT ABORT SLAVE PROGRAM. SPC 3 * THIS IS THE DS/1000-IV VERSION OF PTOPM * * IT RECEIVES NEW REQUESTS FOR THE FOLLOWING P-TO-P FUNCTION CODES: * 1 = POPEN * 2 = PREAD * 3 = PWRIT * 4 = PCONT * 5 = PCLOS (BIT 7= 1 IF GENERATED BY LOCAL "FINIS") * 6 = SLAVE OFF * 7 = SLAVE LIST * * PTOPM MAINTAINS PARALLEL TABLES OF OPEN SLAVE PROGRAM ID SEGMENT * ADDRESSES AND THEIR CORRESPONDING CLASS NUMBERS. THESE TABLES * ARE USED TO DETERMINE THE CLASS NUMBER FOR RETHREADING THE * CLASS BUFFER ON "POPEN","PREAD","PWRIT", AND "PCONT" REQUESTS. * "PCLOS", "SLAVE OFF" AND "SLAVE LIST" REQUESTS ARE HANDLED WITHIN * PTOPM WHICH DOES THE NECESSARY PROCESSING AND SENDS THE REPLY VIA * "#SLAV" (EXCEPT FOR LOCAL "FINIS" REQUESTS WHICH HAVE NO REPLY). SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SKP PTOPM LDA 1,I IS P1=I/O CLASS STA CLASS PTOPM CLASS ALR,RAR CLEAR SAVE BUFFER BIT STA CLAS2 FOR "CLSAM" ROUTINE * * ISSUE GET ON I/O CLASS * GET JSB DTACH DETACH FROM POSSIBLE DEF *+1 SESSION CONTROL BLOCK. * JSB #GETR DEF *+4 DEF CLASS DEF RQB DEF C#PLW JMP EROUT IRRECOVERABLE ERROR STA RQLEN SAVE REQUEST LENGTH * LDA C#FCD CMA,INA ADA RQLEN SSA REQ LENGTH >= MINIMUM? JMP EROUT NO, ERROR LDA C#PLW INA CMA,INA ADA RQLEN SSA,RSS REQ LENGTH < MAXIMUM? JMP EROUT NO ,ERROR * CLA STA RQB+#EC2 INITIALIZE ERROR STA RQB+#ENO FIELDS LDA RQB+#PCB STA IDSEG SAVE POSSIBLE @'ID SEG ADDR LDA RQB+#FCD AND K7 ISOLATE FUNCTION CODE ADA CODEA ADD ADDRESS OF PROCESS TABLES JMP 0,I AND GO DO IT SPC 3 EROUT JSB CLSAM IRRECOVERABLE ERROR, CLEAR SAM JMP GET & GO BACK TO "GET" * SKP * OPENP EQU * PROCESS "POPEN" * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7). STA TEMP SAVE SESSION ID FOR CALL. * JSB #ATCH ATTACH TO THE SESSION CONTROL BLOCK. DEF *+2 DEF TEMP * CPA N1 JMP RS01 ERROR: SCB NOT FOUND. * CLA PERFORM SESSION-MONITOR PREPROCESSING JSB #SCSM WHETHER S.M. NODE OR NOT. JMP ER41 COULD NOT PERFORM REQUESTED CLONING. * JSB PGMAD CONVERT PGM NAME TO ID SEG ADDR DEF *+2 DEF RQB+#PCB SZA,RSS WAS ID SEGMENT FOUND? JMP ER41 NO STA IDSEG SAVE ID SEGMENT ADDRESS CCA SET FLAG TO SAY WE WILL ALLOW PROGRAM STA CLSAM TO BE DORMANT * JSB SERCH THIS PGM ALREADY OPEN? JMP SCD1 YES, BE SURE SLAVE PROGRAM IS ALIVE. * SEZ,RSS IS TABLE FULL? JMP ER42 YES, ERROR * LDB FSTAD 1ST AVAILABLE ENTRY ADDR STB SEGAD LDA IDSEG STA 1,I SET THIS ID SEG ADDR INTO SLAVE LIST ADB NTOTL STB CLSAD ADDR FOR CLASS # * CLA CLEAR CLASS WORD STA CLSAD,I TO SET UP CALL * JSB CLRQ CALL TO OBTAIN A NEW CLASS WORD DEF *+4 DEF FUNC1 GET CLASS W/ NW, NA DEF CLSAD,I RETURNED CLASS WORD DEF K0 ASSIGN NO CLASS OWNERSHIP JMP ERMS ERROR EXIT SZA HOW WAS THE ALLOCATION ? JMP ERMS BAD, ERROR EXIT STA CLSAM SET FLAG TO SAY PROGRAM MUST NOT BE DORMANT. LDA CLSAD,I IOR BIT13 SET SAVE CLASS NUMBER BIT  STA CLSAD,I * * SCHEDULE THE PROGRAM * SCD1 JSB EXEC DEF *+4 SCHEDULE REQUESTED PROGRAM DEF K10N WITHOUT WAIT & PASS IT DEF RQB+#PCB IT'S I/O CLASS AS PARAMETER DEF CLSAD,I P1 JMP BADPG ERROR RETURN-RTE TRIED TO ABORT US * SZA,RSS WAS PROGRAM DORMANT? JMP REQU# YES, IT'S OK. LDA CLSAM NO, IT WASN'T. WAS THIS A NEW ENTRY TO OUT SZA,RSS TABLES? JMP BADOP YES, SO WE EXPECT PROGRAM TO BE DORMANT. * * POPEN IS OK, RETHREAD CLASS BUFFER TO SLAVE PROGRAM * REQU# JSB #RQUE RETHREADING SUBROUTINE DEF *+9 DEF K20N DEF B10K ICNWD W/ Z BIT SET DEF K0 DEF K0 DEF K0 DEF K0 CLSAD NOP SLAVE PGM'S CLASS (TO) DEF CLASS PTOPM CLASS (FROM) RSS ERROR RETURN JMP GET NORMAL RETURN * CPA =ADS RSS JMP ER48 GIVE -48 ERROR FOR ALL OTHERS CPB =A08 JMP ER58 GIVE -58 FOR DS08 JMP ER48 GIVE -48 FOR OTHERS * BADPG JSB FINIS DEALLOCATE CLASS & CLEAR ENTRY JMP ER41 GIVE ERROR -41 * BADOP JSB FINIS DEALLOCATE CLASS & CLEAR ENTRY JMP ER44 GIVE ERROR -44 * RS01 JSB FINIS DEALLOCATE CLASS & CLEAR ENTRY. DLD "RS01 GIVE ERROR "RS01". DST RQB+#EC1 LDA #NODE IOR BIT15 JMP ERRLN SKP * * ENTER HERE ON PREAD, PWRIT, OR PCONT * READP JSB SERCH SEARCH FOR ENTRY RSS JMP ER44 NOT FOUND, ERROR * LDA CLSAD,I CLASS # FROM TABLE CPA RQB+#PCB+1 DOES IT MATCH CLASS IN PCB? RSS YES, CONTINUE JMP ER103 NO, ERROR SPC 2 * CHECK THAT SLAVE PROGRAM IS "ALIVE" LDB SEGAD,I GET PROGRAM'S ID SEGMENT ADDRESS CMB,INB MAKE IT NEGATIVE STB IDAD SAVE IT TO CALL PGMAD JSB PGMAD DEF *+3 DEF NAME DUMMY NAME ARRAY DEF IDAD - ID ADR SZB DORMANT? JMP REQU# NO, RE-THREAD ON CLASS NUMBER * SLAVE PROGRAM IS DORMANT. CLEAR OUT CLASS BUFFER JSB FINIS CLEAR OUT CLASS BUFFER LDB M45 ERROR -45: SLAVE PROGRAM IS DORMANT JMP ERR * SKP * * PROCESS "SL" REQUESTS FROM REMAT * SLIST JSB CLSAM CLEAR THE CLASS BUFFER CLA STA NAMBF INITIALIZE COUNT OF OPEN PGMS LDA NTOTL COUNTER STA SLTMP LDB NAMAD POINTER FOR STORING PGM NAMES * SL10 STB OUTAD SAVE B REG AS THE OUTPUT BUFFER ADDR LDA SLTMP GET NEXT SLAVE ID SEG ADDR ADA @P#EN LDA 0,I SZA,RSS IS THIS ENTRY FULL? JMP SL20 NO ISZ NAMBF BUMP COUNT OF SLAVE PGMS CMA,INA MAKE ID SEG ADDR NEGATIVE STA IDAD SAVE IT TO CALL PGMAD JSB PGMAD FIND PGM NAME W/ -IDAD DEF *+3 OUTAD NOP RETURN PGM NAME DEF IDAD LDB OUTAD ADB K3 SL20 ISZ SLTMP ALL ENTRIES EXAMINED? JMP SL10 NO * LDA NAMLN JMP REPLY+1 WRITE SLAVE LIST WITH REPLY * SLTMP NOP @P#EN DEF P#END SKP * * HANDLE SLAVE OFF REQUESTS HERE SOFF LDA RQB+#PCB NAME OF PROG TO CLEAR SZA CLEAR ALL REQUEST? JMP FINIT NO * JSB CLSAM CLEAR CLASS BUFFER LDA NTOTL STA CNTR INITIALIZE SLAVE LIST COUNT LDB A#IDS POINT TO ID SEG ADDR LIST CL10 LDA 1,I GET NEXT ENTRY SZA,RSS THIS SLOT FULL? JMP CL20 NO STB SEGAD SAVE ADDR OF ID SEG ADDR ADB NTOTL STB CLSAD SAVE ADDR OF CLASS # * JSB FINIS GO CLEAN OUT THIS ONE LDB SEGAD * CL20 INB BUMP LIST POINTER ISZ CNTR MORE? JMP CL10 YES JMP FINEX NO, DONE SPC 2 * FINIT JSB PGMAD CONVERT NAME TO ID SEG ADDR DEF dc*+2 DEF RQB+#PCB SZA,RSS IF NOT IN SYSTEM, JMP ER41 REPORT ERROR. STA IDSEG SAVE ID SEGMENT ADDRESS * * ENTER HERE ON "PCLOS" OR "FINIS" REQUESTS * CLOSP JSB CLSAM CLEAR CLASS BUFFER JSB SERCH IS PROGRAM IN CURRENT LIST? JSB FINIS YES, CLEAN OUT ENTRY IN CURRENT LIST LDA RQB+#FCD ALF,ALF TEST BIT 7 OF FUNCTION CODE SSA IS THIS A "FINIS" REQUEST? JMP GET YES, NO REPLY REQUIRED * FINEX CLB STB RQB+#EC2 NO ERROR CODE JMP REPLY SEND REPLY * SKP * CLEAR ENTRY OUT OF CURRENT LIST, AND ABORT PROGRAM IF IT'S HANGING * ON THE CLASS SO THE CLASS NUMBER CAN BE DEALLOCATED. * FINIS NOP * * GET NAME OF PROGRAM * LDA SEGAD,I CMA,INA MAKE ID SEG ADDR NEGATIVE STA IDAD SAVE IT TO CALL PGMAD JSB PGMAD CALL TO FIND PROGRAM NAME DEF *+3 NAMA DEF NAME DEF IDAD * * FOR "SLAVE OFF" AND "PCLOSE," ABORT THE SLAVE * LDA RQB+#FCD IF "FINIS" ALF,ALF REQUEST, SSA JMP SM KEEP SLAVE ALIVE. * JSB #OFF TURN OFF SLAVE. DEF *+2 ["EXEC(6,PROG)" FOR M/E/F, DEF NAME "OF,PROG,FL" FOR L.] * SM LDA NAMA PERFORM SESSION-MONITOR POSTPROCESSING JSB #SCSM WHETHER S.M. NODE OR NOT. * * FLUSH REQS & DEALOCATE CLASS # AS WELL * JSB CLRQ DEF *+3 DEF FUNC2 DEF CLSAD,I NOP IGNORE ERROR * CLB STB SEGAD,I CLEAR ENTRY IN PTOPM'S LIST JMP FINIS,I & EXIT * SKP * PROCESS ERRORS AND ABNORMAL CONDITIONS HERE * THE B REGISTER CONTAINS THE DETECTED ERROR CODE * RECOGNIZED ERROR CONDITIONS * -41 NON-EXISTENT SLAVE PROGRAM * -42 CURRENT LIST FULL-NO ROOM-RETRY * -44 PROGRAM NOT OPEN IN PTOPM'S TABLE * -45 PROGRAM IS DORMANT (PWRIT, PREAD, PCONT ONLY) * -48 A BORTIVE COMMUNICATIONS ERROR * -58 SLAVE PROGRAM IS NON-DORMANT, BUT MAXIMUM QUEUE DEPTH * EXCEEDED (SLAVE PROGRAM IS LAGGING BEHIND). * -103 BAD PCB OR BAD FUNCTION CODE * ER41 LDB M41 JMP ERR * ERMS CLA STA SEGAD,I CLEAR ENTRY IN CURRENT LIST * ER42 LDB M42 JMP ERR * ER44 LDB M44 JMP ERR * ER48 LDB M48 JMP ERR ER58 LDB M58 JMP ERR * ER103 LDB M103 ILLEGAL PCB ERR STB RQB+#EC2 STORE ERROR WORD LDA #NODE ERRLN STA RQB+#ENO PASS LOCAL NODE * JSB CLSAM CLEAR THE CLASS BUFFER * REPLY CLA STA CNTR SET LENGTH OF DATA * JSB #SLAV SEND THE REPLY DEF *+4 DEF RQLEN REQUEST LENGTH DEF NAMBF DEF CNTR ZERO UNLESS "SL" NOP JMP GET SKP * * THIS SUBROUTINE SEARCHES FOR AN ENTRY IN THE SLAVE PGM LIST * SERCH NOP LDB A#IDS POINTER TO ID SEG ADDRS LDA NTOTL STA CNTR COUNTER CLE E SET TO 1 WHEN FREE SLOT FOUND SNXT LDA 1,I GET NEXT ID SEG ADDR CPA IDSEG EQUAL TO ONE WE'RE LOOKING FOR? JMP GOTIT YES! SZA,RSS THIS SLOT FREE? SEZ,CCE YES, SKIP IF 1ST FREE SLOT RSS STB FSTAD SAVE ADDR OF 1ST FREE SLOT INB ISZ CNTR MORE? JMP SNXT YES ISZ SERCH REQUESTED ID SEG NOT FOUND JMP SERCH,I RETURN * GOTIT STB SEGAD SAVE ADDR OF ID SEG ENTRY ADB NTOTL STB CLSAD SAVE ADDR OF ITS CLASS # JMP SERCH,I RETURN SKP * * CLEAR PTOPM'S CLASS BUFFER OR RETHREAD TO PLOG * CLSAM NOP LDA #PLOG SZA,RSS LOGGING? JMP CLAR NO, GO TO CLEAR BUFFER LDB CLASS JSB #LOGR YES, GO TO LOG THE BUFFER JMP CLAR LOG ERR, CLEAR BUFFER JMP CLSEX NORMAL RETURN * CLAR EQU * JSB EXEC CLASS GET (ZERO LENGTH) DEF *+5 ( DEF K21 DEF CLAS2 DEF DUMMY DEF K0 * CLSEX LDA RQB+#STR IOR BIT14 SET REPLY FLAG IN REQUEST STA RQB+#STR JMP CLSAM,I RETURN * * DATA AREA * IDAD NOP CNTR NOP RQLEN NOP IDSEG NOP SEGAD NOP FSTAD NOP CLASS NOP CLAS2 NOP TEMP NOP "RS01 ASC 2,RS01 K0 DEC 0 K3 DEC 3 K7 DEC 7 K21 DEC 21 K10N DEF 10,I K20N DEF 20,I CODEA DEF CODES,I CODES DEF ER103 CODE 0: ERROR DEF OPENP CODE 1: POPEN DEF READP CODE 2: PWRIT DEF READP CODE 3: PREAD DEF READP CODE 4: PCONT DEF CLOSP CODE 5: PCLOS AND FINIS DEF SOFF CODE 6: SLAVE OFF DEF SLIST CODE 7: SLAVE LIST B377 OCT 377 BIT13 OCT 020000 BIT13 B10K OCT 010000 BIT14 OCT 040000 BIT15 OCT 100000 FUNC1 OCT 140001 NO WAIT, NO ABORT, GET CLASS # FUNC2 OCT 140002 NO WAIT, NO ABORT, DEALOCATE CLASS # N1 DEC -1 N25 DEC -25 M41 DEC -41 M42 DEC -42 M44 DEC -44 M45 DEC -45 M48 DEC -48 M58 DEC -58 M103 DEC -103 DUMMY NOP NAMAD DEF NAMBF+1 NAMLN ABS NENT+NENT+NENT+1 SIZE OF "SL" BUFR * * DEFINE P TO P REQUEST BUFFER * C#FCD ABS #FCD C#PLW ABS #PLW A EQU 0 B EQU 1 * NAME BSS 3 * * DEFINE SLAVE PGM LIST & VARIABLES * NENT EQU 20 SET # OF ENTRIES A#IDS DEF P#IDS POINT TO ID SEG ADDRS NTOTL ABS -NENT -# OF ENTRIES SPC 1 * * SLAVE LIST TABLE: 2 ARRAYS OF "NENT" WORDS. 1ST ARRAY CONTAINS * I/O CLASS NUMBERS, 2ND CONTAINS ID SEGMENT ADDRESSES. * P#CLS BSS NENT+NENT DEFINE THE SLAVE LIST TABLE P#IDS EQU P#CLS+NENT P#END EQU P#IDS+NENT SPC 1 SUP ORG P#CLS REP NENT+NENT INITIALIZE TABLE TO ZEROES NOP UNS * NAMBF BSS NENT+NENT+NENT+1 BUFFER FOR "SL" * BSS 0 SIZE OF PTOPM. * END PTOPM <:66< Yh 91750-18152 2013 S C0122 &QCLM              H0101 ubASMB,R,Q,C HED QCLM 91750-16216 REV 2013 * (C) HEWLETT-PACKARD CO. 1979 NAM QCLM,19,28 91750-16152 REV 2013 800126 ALL SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * * NAME: QCLM * SOURCE: 91750-18152 * RELOC: 91750-16152 * PGMR: CHUCK WHELAN * DATE WRITTEN DEC 1976 * * MODIFICATION FOR 91750: * ----------------------- * MODIFIED BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/JSB'S * MODIFIED BY DWT [790606] FOR PHASE FIVE (REMOVE O/S DEPENDENCE) * MODIFIED BY DWT [790813] TO SUPPORT MORE MESSAGES * MODIFIED BY TKM [791212] TO SUPPORT 'MA REMOVED' MSG * SPC 2 EXT EXEC,#QCLM,DTACH,TMVAL,.MVW SUP SPC 3 * QCLM EQU * JSB DTACH DEF *+1 LDA #QCLM GET QCLM CLASS NUMBER ALR,RAR AND REMOVE NO WAIT BIT STA QCLS QCLM2 JSB EXEC AWAIT WRITES TO QCLM CLASS DEF *+6 DEF K21 DEF QCLS CLASS WORD IN STORAGE DEF IBUF BUFFER ADDRESS DEF K12 DEF MTYPE MESSAGE TYPE * * * DETERMINE THE MESSAGE TYPE * LDA MTYPE GET MESSAGE TYPE CPA K1 JMP TYPE1 CPA K2 JMP TYPE2 CPA K3 JMP TYPE3 CPA K4 JMP TYPE4 CPA K5 JMP TYPE5 CPA K6 JMP TYPE6 CPA K7 JMP TYPE7 CPA K8 JMP TYPE8 CPA K9 JMP TYPE9 SPC 3 * * HERE FOR UNEXPECTED ERRORS (I.E., CATASTROPHIC) * LDA PGM MOVE PROGRAM STA ORIGN NAME TO DLD PGM+1 OUTPUT DS;T ORIGN+1 BUFFER * CONVERT REGISTER VALUES TO OCTAL LDA SEQ# JSB DEC6 DEF .SEQ. LDA STREM JSB OCTAL DEF .STR. LDA @CVFD GET THE ADDRESS OF THE 1ST WORD STA PNTR1 USE AS DESTINATION POINTER LDA @PREG GET ADDRESS WHERE P, A AND B REGISTER CONTENTS ARE STORED STA PNTR2 USE AS ORIGIN POINTER LDA N3 SET TO CONVERT 3 WORDS STA CNTR1 * OUTLP EQU * SET FOR OCTAL CONVERSION LDA PNTR2,I GET VALUE ISZ PNTR2 JSB OCTAL PNTR1 NOP STORE ASCII HERE. * LDA PNTR1 GET THE DESTINATION POINTER ADA K5 MOVE IT TO STA PNTR1 THE NEXT ENTRY. ISZ CNTR1 ALL DONE ? JMP OUTLP NO, CONTINUE * JSB EXEC OUTPUT THE CATASTROPHIC ERROR MESSAGE DEF *+5 DEF K2 WRITE DEF K1 CRT DEF MSG MESSAGE ADDRESS DEF MSGL MESSAGE LENGTH * JMP QCLM2 GO, GET NEXT COMPLAINT * * HERE FOR "REPLY FLUSHED" ERROR * * TYPE1 DLD AREG A&B HAVE ASCII ERROR CODE DST .DSXX DLD @MSG1 GET ADDR OF MESG AND LENGTH DST @OUT1 JMP TYPEX JUMP TO TYPEX PRINT * * HERE FOR "TCB NOT FOUND, POSSIBLE TIMEOUT" * TYPE2 DLD @MSG2 DST @OUT1 JMP TYPEX * * HERE FOR "COMMUNICATIONS READ" ERROR * TYPE3 EQU * LDA IBUF JSB DEC4 CONVERT LU TO DECIMAL DEF .LU3 LDA IBUF+1 CONVERT I/O STATUS TO OCTAL JSB OCTAL DEF .STAT DLD @MSG3 DST @OUT2 JMP OUTMS * * MA REMOVED FROM NODE * TYPE4 EQU * LDA IBUF JSB DEC6 CONVERT NODE NUMBER DEF .N4 DLD @MSG4 DST @OUT2 JMP OUTMS * * HERE FOR "UP/DOWN COUNTER EXCEEDED" ERROR * TYPE5 EQU * LDA IBUF JSB DEC4 CONVERT DISABLED LU TO DECIMAL DEF .LU5 ц DLD @MSG5 DST @OUT2 JMP OUTMS * * HERE FOR "LINK JUST CAME UP" MESSAGE * TYPE6 EQU * LDA IBUF JSB DEC4 DEF .LU6 DLD @MSG6 GET ADDR OF MESG & LENGTH DST @OUT2 JMP OUTMS * * HERE FOR "LINK JUST WENT DOWN" MESSAGE * TYPE7 EQU * LDA IBUF JSB DEC4 DEF .LU7 DLD @MSG7 DST @OUT2 JMP OUTMS * * HERE FOR "SELF-CHECK ERROR" * TYPE8 EQU * LDA PGM STA .PGM8 DLD PGM+1 DST .PGM8+1 LDA PREG JSB OCTAL DEF .P8 LDA AREG JSB OCTAL DEF .A8 LDA BREG JSB OCTAL DEF .B8 DLD @MSG8 DST @OUT2 JMP OUTMS * * INTERNAL MESSAGE ACCOUNTING ERROR * TYPE9 EQU * LDA IBUF JSB DEC6 GET NODE NUMBER DEF .N9 LDA IBUF+1 GET MA FLAGS JSB OCTAL DEF .F9 LDA IBUF+2 REGISTER JSB OCTAL DEF .A9 LDA IBUF+3 REGISTER JSB OCTAL DEF .B9 DLD @MSG9 DST @OUT2 JMP OUTMS * TYPEX JSB EXEC OUTPUT MESSAGE DEF *+5 DEF K2 DEF K1 @OUT1 NOP MESSAGE ADDRESS NOP MESSAGE LENGTH ADDR LDA STREM CONVERT STREAM WORD TO OCTAL JSB OCTAL DEF MSGX+4 LDA SRC# JSB DEC6 CONVERT ORIGINATION NODE # DEF .OX+6 LDA DESTN CHECK DESTINATION NODE LDB @DLUX FOR (-) INDICATING SSA LU # NOT NODE # JMP LUX LDA @DX --> NODE MSG JSB .MVW MOVE IN MSG DEF K9 NOP LDA DESTN CONVERT NODE # JSB DEC6 DEF .DLUX+6 JMP ENDX * LUX LDA @LUX --> LU MSG JSB .MVW MOVE IN MSG DEF K9 NOP LDA DESTN CONVERT LU # CMA,INA TO (POSITIVE) DECIMAL JSB DEC4 DEF .DLUX+2 ENDX DLND @MSGX DST @OUT2 * OUTMS JSB EXEC OUTPUT MESSAGE DEF *+5 DEF K2 DEF K1 @OUT2 NOP NOP * JSB CVTIM CONVERT TIME-OF-DAY TO ASCII JSB EXEC OUTPUT TIME DEF *+5 DEF K2 DEF K1 DEF TIME DEF TIMEL JMP QCLM2 GO BACK TO CLASS "GET" SKP * * SUBROUTINE TO OBTAIN TIME-OF-DAY AND CONVERT IT TO * ASCII. RESULTS RETURNED IN BUFFER ".TIME" * CVTIM NOP JSB TMVAL CONVERT TIME-OF-DAY TO HOURS,MINUTES, SECONDS DEF *+3 DEF TOD DEF TMAR LDA TMAR+3 JSB DEC2 CONVERT HOUR NUMBER TO ASCII DEF .HR LDA TMAR+2 JSB DEC2 CONVERT MINUTES TO ASCII DEF .MIN LDA TMAR+1 JSB DEC2 CONVERT SECONDS DEF .SEC JSB EXEC GET ACTUAL DAY NUMBER DEF *+3 DEF K11 DEF TMAR LDA TMAR+4 JSB DEC4 CONVERT DAY NUMBER DEF .DAY JMP CVTIM,I RETURN SKP * OCTAL- (OBVIOUSLY) BINARY TO OCTAL ASCII * = BINARY FOLLOWED BY DEF TO OUTPUT OCTAL NOP LDB OCTAL,I STB PTR ISZ OCTAL LDB DM3 STB CTRO LSL 16 :=, :=0 RRR 2 1ST TIME ONLY GET BIT15 OCT1 RRL 3 ALF,RAL RRL 3 NET SHIFT = 8 IOR "00" STA PTR,I CLA ISZ PTR ISZ CTRO JMP OCT1 JMP OCTAL,I * DM3 DEC -3 "00" ASC 1,00 CTRO BSS 1 PTR BSS 1 SKP * * DEC[N]- CONVERTS BINARY TO DECIMAL (LEFT JUSTIFIED) * = BINARY * JSB DEC[N] * DEF WHERE TO PUT [N] CHARACTERS * EXT .MBT,.SBT * DEC2 NOP LDB D2 JSB DECML DEC4 NOP LDB D4 JSB DECML DEC6 NOP LDB D6 JSB DECML DECML NOP STA NBR SAVE STB D NUMBER OF BYTES TO MOVE LDA DECML CORRECT RETURN ADDRESS ADA DM3 LDA 0,I STA DECML LDB DECML,I ISZ DECML CLE,ELB CONVERT TO BYTE ADDRESS STB ADR LDA @SPAC JSB .MBT MOVE IN SPACES DEF D NOP LDA NBR LDB ADR SSA,RSS NEGATIVE NUMBER? JMP DEC1. . NO CMA,INA STA NBR SSA SPECIAL LOW NUMBER (-32768)? JMP DEC4. . YES LDA DASH JSB .SBT DEC1. STB ADR SAVE OUTPUT POINTER LDA DTBL STA D D --> DIVISOR TABLE LDA DM4 STA CTR STA FLAG CLEAR OUTPUT FLAG (SET TO 1) * DEC2. LDB NBR LSR 16 DIV D,I ISZ D STB NBR REMAINDER SZA OUTPUT OTHER THAN ZERO? JMP *+4 . YES OUTPUT IT LDB FLAG SSB OK TO OUTPUT? JMP DEC3. . NO FINISH LOOP IOR "0" STA FLAG SET OUTPUT FLAG (BIT15=0) LDB ADR --> OUTPUT FIELD JSB .SBT STB ADR SAVE OUTPUT FIELD DEC3. ISZ CTR JMP DEC2. * LDA NBR := ONES DIGIT LDB ADR --> OUTPUT IOR "0" JSB .SBT JMP DECML,I AND RETURN * DEC4. LDA @32K MOVE IN -32768 JSB .MBT DEF D6 NOP JMP DECML,I RETURN SPC 2 @32K DBL *+1 ASC 3,-32768 @SPAC DBL *+1 ASC 3, DTBL DEF *+1 DEC 10000 DEC 1000 DEC 100 DEC 10 * D2 DEC 2 D4 DEC 4 DM4 DEC -4 D6 DEC 6 "0" OCT 60 DASH ASC 1,-- * CTR BSS 1 FLAG BSS 1 BIT15=1 NO OUTPUT; BIT15=0 OUTPUT D BSS 1 ADR BSS 1 NBR BSS 1 SKP * * DATA AREA * * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON SOME MESSAGES, * *--------------------------------------* WORD 1 AND WORD 2 MAY *  2 * SEQUENCE NUMBER * HAVE DIFFERENT MEANINGS. * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* * 6 * A-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* * 7 * B-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* * 8 * TIME OF DAY WHEN ERROR DETECTED * * 9 * (2 WORDS) * * *--------------------------------------* * 10 * PROGRAM NAME WHERE * * 11 * ERROR IS DETECTED * * 12 * (3 WORDS) * * **************************************** SPC 3 K1 DEC 1 K2 DEC 2 K3 DEC 3 K4 DEC 4 K5 DEC 5 K6 DEC 6 K7 DEC 7 K8 DEC 8 K9 DEC 9 K11 DEC 11 K12 DEC 12 K21 DEC 21 N3 DEC -3 * MTYPE NOP MESSAGE TYPE @PREG DEF PREG @CVFD DEF CVFLD CNTR1 NOP PNTR2 NOP QCLS NOP * IBUF BSS 12 STREM EQU IBUF SEQ# EQU IBUF+1 SRC# EQU IBUF+2 DESTN EQU IBUF+3 PREG EQU IBUF+4 AREG EQU IBUF+5 BREG EQU IBUF+6 TOD EQU IBUF+7 PGM EQU IBUF+9 * MSG ASC 8, DS ERROR: PROG= ORIGN ASC 3, ASC 5,, STREAM= .STR. ASC 3, ASC 4,, SEQ#= .SEQ. ASC 3, OCT 6412 CARRIAGE-RETURN/LINE-FEED ASC 2, P= CVFLD ASC 3, ASC 2,, A= ASC 3, ASC 2,, B= ASC 3, MSGL ABS *-MSG * MSG1 ASC 05, DS ERROR: .DSXX ASC 02, STORAGE FOR "DSXX" ERROR CODE ASC 16,, REPLY FLUSHED MSG1L ABS *-MSG1 @MSG1 DEF MSG1 DEF MSG1L * MSG2 ASC 21, DS ERROR: TCB NOT FOUND, POSSIBLE TIMEOUT MSG2L ABS *-MSG2 @MSG2 DEF MSG2 DEF MSG2L * MSG3 ASC 14, DS ERROR: COMM. READ, LU = .LU3 ASC 2, q*($ ASC 6,I/O STATUS= .STAT ASC 3, MSG3L ABS *-MSG3 @MSG3 DEF MSG3 DEF MSG3L * MSG4 ASC 23, DS MSG: MESSAGE ACCOUNTING REMOVED FROM NODE .N4 BSS 3 MSG4L ABS *-MSG4 @MSG4 DEF MSG4 DEF MSG4L * MSG5 ASC 18, DS ERROR: UP/DOWN COUNTER EXCEEDED OCT 6412 CR/LF ASC 05, LINK LU # .LU5 ASC 02, ASC 06,IS DISABLED MSG5L ABS *-MSG5 @MSG5 DEF MSG5 DEF MSG5L * MSG6 ASC 7, DS MSG: LU # .LU6 ASC 2, ASC 6,JUST CAME UP MSG6L ABS *-MSG6 @MSG6 DEF MSG6 DEF MSG6L * MSG7 ASC 7, DS MSG: LU # .LU7 ASC 2, ASC 7,JUST WENT DOWN MSG7L ABS *-MSG7 @MSG7 DEF MSG7 DEF MSG7L * MSG8 ASC 15, DS ERROR: SELF-CHECK ERROR IN .PGM8 ASC 3, OCT 6412 ASC 2, P= .P8 ASC 3, ASC 2, A= .A8 ASC 3, ASC 2, B= .B8 ASC 3, OCT 6412 ASC 19, REROUTING IS DISABLED FROM THIS NODE MSG8L ABS *-MSG8 @MSG8 DEF MSG8 DEF MSG8L * MSG9 ASC 25, DS ERROR: SELF-CHECK ERROR IN MESSAGE ACCOUNTING! OCT 6412 ASC 1, .N9 ASC 4, .F9 ASC 4, .A9 ASC 4, .B9 BSS 3 MSG9L ABS *-MSG9 @MSG9 DEF MSG9 DEF MSG9L * MSGX ASC 7, STREAM= XXXXXX .OX ASC 9, ORG NODE= XXXXXX .DLUX BSS 9 MSGXL ABS *-MSGX @MSGX DEF MSGX DEF MSGXL @DLUX DEF .DLUX @LUX DEF *+1 ASC 9,LU= XXXX @DX DEF *+1 ASC 9, DEST NODE= XXXXXX * TIME ASC 6, TIME: DAY .DAY ASC 2, DAY NUMBER, CONVERTED TO ASCII .HR NOP HOUR, CONVERTED TO ASCII ASC 1,: .MIN ASC 1, MINUTE, CONVERTED TO ASCII ASC 1,: .SEC ASC 1, SECOND, CONVERTED TO ASCII TIMEL ABS *-TIME TMAR BSS 5 * SIZE BSS 0 * END QCLM ;* Z f 91750-18153 2013 S C0122 &QUEUE              H0101 ASMB,R,L,C HED QUEUE 91750-16153 (C) HEWLETT-PACKARD CO. 1980 NAM QUEUE,17,2 91750-16153 REV.2013 800424 (ALL) SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT QUEUE EXT EXEC,RNRQ,XLUEX EXT #GRPM,#QCLM,#ST09,#ST08,RMPAR * * * NAME: QUEUE * SOURCE: 91750-18153 * RELOC: 91750-16153 * PGMR: JOHN LAMPING * * WRITTEN BY CHUCK WHELAN [DECEMBER 1976] * MODIFIED BY PETER BRICKEY * MODIFIED BY JOHN LAMPING [NOVEMBER 1979] * * * QUEUE IS THE DS/1000 PROGRAM SCHEDULED BY COMMUNICATIONS * DRIVERS WHEN A NEW REQUEST IS TO BE READ FROM A COMMUNICATIONS * LINE. THE REQUEST AND DATA BUFFER LENGTHS ARE PASSED TO QUEUE * IN THE CALLING PARAMETERS. IF THE PASSED LENGTHS * ARE NOT WITHIN THE ALLOWABLE RANGE (6 64? JMP SSTP1 YES, CAN'T ACCEPT IT ADA D57 IS REQUEST LNTH SSA LESS THAN 7? JMP SSTP1 YES, ERROR! SEND 'STOP' * LENOK EQU * LDA DLEN NOW CHECK DATA LENGHT SSA JMP SSTP1 LENGTH ERROR ADA N4097 SSA,RSS DATA LENGTH > 4096? JMP SSTP1 YES, CAN'T ACCEPT IT * LDB TYPE LENGTHS ARE OK, NOW LDA TYPE BUILD THE ALF,RAL CONTROL WORD RAL,RAL WITH THE CORRECT MESSAGE TYPE SZB,RSS DS TYPE 1 REQUEST? XOR ZBIT YES, MUST SAY DOUBLE BUFFERED STA CONWD IN EITHER CASE, CONWD IS BUILT LDA RLEN ALSO, IF THIS IS A DS TYPE ADA K2 MESSAGE THE REQUEST LENGTH STA RLEN MUST BE INCREMENTED BY 2 * LDA #GRPM ASSUME THIS REQUEST IS DS MODE SZB,RSS IS ASSUMPTION CORRECT? JMP GRPCL GOOD GUESS!,jb SCHEDULE GRPM STB RLEN PROGL REQUEST, PASS TYPE IN RLEN LDA #ST09+1 USE PROGL'S CLASS NUMBER LDB TYPE IS THIS A CPB K2 RFP TYPE MESSAGE? LDA #ST08+1 YES, USE VCPMN'S CLASS GRPCL CCE,SZA,RSS JMP SSTP2 SEND STOP IF NO CLASS ALLOCATED RAL,ERA SET NO-WAIT BIT IN CLASS WORD. STA CLASS SAVE LOCALLY * JSB XLUEX READ THE REQUEST TO GRPM'S CLASS DEF *+8 DEF K17N NO ABORT DEF LU2 DEF ZERO DEF DLEN RECEIVED DATA LENGTH DEF LU1 DEF RLEN RECEIVED REQUEST LENGTH/REQUEST TYPE DEF CLASS JMP WHY HERE IF CLASS READ FAILS * SZA SUCCESS? JMP SSTP0 NO, PROBABLY NO SAM, SEND STOP VIA DRIVER * EXIT JSB EXEC TERMINATE QUEUE DEF *+2 DEF K6 * WHY CPA AIO IS ERROR RSS AN IO ERROR? JSB ERR NO CPB A04 IO04? JMP SSTP0 YES SEND STOP JSB ERR NO, BAD ERROR SKP * * ERROR PROCESSING SECTION * ERR NOP PASS ERROR INFO TO QCLM & GIVE UP DST AREG PASS REGS TO QCLM LDA ERR PICK UP ORIGINATION ADDRESS STA PREG PASS TO QCLM LDA #QCLM QCLM CLASS SZA,RSS IS CLASS NUMBER DEFINED? JMP ERR2 NO--SEND A 'STOP' STA CLASS SAVE LOCALLY * JSB EXEC MAILBOX CLASS WRITE/READ TO QCLM DEF *+8 DEF K20N DEF ZERO DEF QBUF DEF K12 DEF ZERO DEF ZERO DEF CLASS ZERO NOP ERROR RETURN ERR2 EQU * LDA LU1 SZA,RSS WAS LU DETERMINED? JMP EXIT NO, CAN'T SEND STOP * SSTP2 LDA K2 GET SYSTEM ERROR CODE LDB TYPE GET MESSAGE TYPE SZB,RSS DS/1000 TYPE? JMP SSTP YES, TELL DRIVER TO WAIT SSTP1 CLA,INA,RSS GET ILLEGAL SIZE ERROR CODE SSTP0 CLA GET NO SAM E~RROR CODE * * CALL DRIVER TO SEND A STOP * SSTP STA TEMP SAVE ERROR CODE LDA B600 STOP REQUEST STA CONWD JSB XLUEX DEF *+6 DEF K1 DEF LU2 DEF ZERO DEF ZERO DATA LENGTH DEF TEMP ERROR CODE JMP EXIT * SKP * * CONSTANTS AND STORAGE * * * FORMAT OF BUFFER PASSED TO QCLM: * -------------------------------- * * **************************************** * 1 * STREAM WORD * NOTE: ON 'READ' ERRORS, WORD * *--------------------------------------* 1 IS LU NUMBER, WORD * 2 * SEQUENCE NUMBER * 2 CONTAINS I O STATUS. * *--------------------------------------* * 3 * SOURCE (ORIGINATING) NODE NUMBER * * *--------------------------------------* * 4 * DESTINATION NODE NUMBER * * *--------------------------------------* * 5 * P-REGISTER WHEN ERROR DETECTED * * *--------------------------------------* NOTE: CERTAIN COMBINATIONS * 6 * A-REGISTER WHEN ERROR DETECTED * OF A- AND B-REGISTER VALUES * *--------------------------------------* ARE USED TO FLAG SUCH CONDI- * 7 * B-REGISTER WHEN ERROR DETECTED * TIONS AS "COMMUNICATIONS * *--------------------------------------* READ ERROR", "TCB NOT FOUND, * 8 * TIME OF DAY WHEN ERROR DETECTED * ETC. * 9 * (2 WORDS) * * ---------------------------------------- * 10 * NAME OF CALLING PROGRAM * * 11 * (3 WORDS) * * 12 * * * **************************************** * SUP QBUF DEC 0,0,0,0,0,0,0,0,0 ERROR BUFFER TO QCLM ASC 3,QUEUE ALONG WITH CALLERS NAME * STREM EQU QBUF SEQ# EQU QBUF+1 SRC# EQU QBUF+2 DESTN EQU QBUF+3 PREG EQU QBUF+4 AREG EQU QBUF+5 BREG EQU QBUF+6 TOD EQU QBUF+7 * TEMP NOP CLASS NOP * THE NEXT TWO WORDS MUST BE IN SEQUENCE FOR XLUEX CALLS LU2 NOP CONWD NOP B600 OCT 600 K1 DEC 1 K2 DEC 2 K6 DEC 6 K12 DEC 12 N64 DEC -64 D57 DEC 57 F256 OCT 77400 N4097 DEC -4097 K17N OCT 100021 K20N OCT 100024 CODE OCT 70736 ZBIT OCT 10000 BIT15 OCT 100000 AIO ASC 2,IO A04 ASC 2,04 * PRAMS EQU * SCODE OCT 0 SECURITY CODE LU1 OCT 0 LOGICAL UNIT DLEN BSS 1 DATA LENGTH RLEN BSS 1 REQUEST LENGTH TYPE BSS 1 ACTION INDICATOR * SIZE BSS 0 * END QUEUE O_ [ e 91750-18154 2013 S C0122 &QUEX              H0101 [ASMB,Q,C HED QUEX: HP 3000 HSI COMM. MONITOR * (C) HEWLETT-PACKARD CO. NAM QUEX,19,4 91750-16154 REV.2013 800423 MEF: 3000 HSI LINK SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * Z OPTION INCLUDES DEBUG. * EXT EXEC,XLUEX,RNRQ,$OPSY,$TIME,$LIBR,$LIBX,.MVW EXT #LU3K,#LDEF,#QXCL,#RQCV,#RSAX,#CL3K,#CLRN EXT DTACH,D$XS5,D$EQT EXT D$MXR,D$BSZ,D$WAD,D$RAD,D$WLN SPC 1 UNL * NAME: QUEX *SOURCE: 91750-18154 * RELOC: 91750-16154 * PGMR: DMT LST ************************** QUEX FOR HSI ************************** * * * SOURCE: 91750-18154 * * * * BINARY: 91750-16154 * * * * JIM HARTSELL * * * * AUGUST 25, 1975 * * * ****************************************************************** * * * MODIFIED BY DAVE TRIBBY BEGINNING SEPT. 18, 1978 * * FOR DS ENHANCEMENTS AND SESSION COMPATIBILITY * * * ****************************************************************** SPC 1 * * QUEX PERFORMS COMMUNICATION WITH A REMOTE HP3000 COMPUTER. * ALL MASTER REQUESTORS AND SLAVE MONITORS WISHING TO TRANSMIT * TO AN HP3000 DO SO BY WRITING THEIR BUFFERS TO THE * QUEX I/O CLASS. QUEX HANGS ON A CLASS GET CALL * AND THEN BLOCKS AS MANY REQUESTS/REPLIES AS WILL FIT INTO THE * SEND BUFFER. A "WRITE CONVERSATIONAL" CALL TO THE SYNCHRONOUS * LINE CONTROL PACKAGE (SLC) TRANSMITS THE SEND BUFFER AND * RETURNS A RECEIVE BUFFER. QUEX THEN DE-BLOCKS THE RECEIVE * BUFFER AND DISPATCHES THE REQUESTS/REPLIES TO THE PROPER MONITORS * OR MASTER REQUESTORS VIA CLASS WRITES. THE RECEIVE BUFFER * MAY BE EMPTY. SKP SUP A EQU 0 B EQU 1 SPC 2 QUEX LDA $OPSY CHECK FOR OPERATING RAR,SLA SYSTEM TYPE. RSS RSS IF MAPPED SYSTEM, JMP INITL LDA RSS CONFIGURE CROSS-MAP STA MODI2 LOAD STA MODI1 AND STORE. * INITL JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * JSB DCNCT ESTABLISH "DISCONNECT" STATUS * LDA D$XS5 CHECK FOR AND D2 MODEM LINK. SZA 0 = HSI, 2 = MODEM. JMP WRDVR ERROR--MODEM. * * SET BUFFER SIZE WORD IN SSGA TO BE THE QUEX BUFFER SIZE. * LDA D$MXR GET BUFFER SIZE (WORDS) STA D$BSZ AND STORE IN SSGA. CLE,ELA CONVERT TO BYTES, CMA,INA MAKE NEGATIVE, STA BYTLN AND SAVE FOR READ CALL. SPC 1 * * FIRST ENTRY INTO QUEX (SCHEDULED BY UPLIN): * INITIALIZE THE HP3000 COMMUNICATION LINK. * LDA #QXCL SAVE QUEX CLASS NUMBER. ELA,CLE,ERA CLEAR "DISCONNECT" BIT STA QXCLS FOR LOCAL STORAGE. IOR B140K ADD NO-WAIT & BUFFER-SAVE BITS. STA QCLAS * LDA N16 INITIALIZE DELAY STA DCONT COUNT TO 16 (SPECIAL). * JSB CLNUP CLEAN OUT PREVIOUS ACTIVITY. * * SET UP START AND END OF DRIVER TRACE TABLE. * LDA D$EQT INA SET EOTBL TO ONE PAST THE STA EOTBL LAST ADDRESS IN EVENT TABLE. * LDA @TRFW GET FIRST WORD IN TRACE. RSS MAKE INDR LDA A,I SURE RAL,CLE,SLA,ERA IT'S JMP INDR DIRECT. STA @TRFW STA SOTBL FIRST ADDRESS IN EVENT TABLE. * LDA #LU3K STORE 3000 LU IN IOR BIT15 2-WORD XLUEX ARRAY. STA LU3K SPC 3 * * ENTER HERE AFTER LINE CLOSE. * INIT CLA,INA STA ENQFL SET "NEED ENQ" FLAG. * LDA #CL3K GET LOGGING LU. SZA IF NOT SPECIFIED, SSA OR BAD, JMP CLRQ GO CLEAR. LDA #CL3K+1 IF DRIVER AND BIT13 TRACE WAS SZA,RSS NOT SPECIFIED, JMP CLRQ GO CLEAR. * LDA N2 SET TRACE STA TRBUF TO -2. LDA @STAT STATISTICS' ADDRESS (SOURCE). LDB @TRBF SET TRACE POINTER STB TPNTR FOR OUTPUT. INB POINT TO SECOND WORD FOR MOVE. JSB .MVW MOVE 11 WORDS. DEF D11 NOP LDA D12 TRACE BUFFER STA TRLEN LENGTH IS 12. JSB TRCOT WRITE TRACE ENTRY. * CLRQ JSB XLUEX ISSUE CLEAR REQUEST. DEF *+6 DEF D2 DEF LU3K DEF D0 DEF D3 DEF CLRWD * JSB XLUEX INITIALIZE DVG67. DEF *+6 DEF D2 DEF LU3K DEF D$EQT DEF D3 DEF INLWD * LDA D$XS5+13 INITIALIZE STA OLENT TRACE POINTER. * JSB SLCER CHECK FOR ERRORS. DEC 0 * JSB EXEC SCHEDULE QUEZ WITH WAIT TO DEF *+4 PERFORM LINE OPEN REQUEST. DEF D9 (THIS KEEPS QUEX FROM LOCKING UP DEF QUEZ PARTITION WHILE IN I/O SUSPEND.) DEF D1 SCHEDULE PARAM FOR QUEZ. * JSB SLCER CHECK FOR ERRORS. D1 DEC 1 * JSB XLUEX CHANGE ERROR RECOVERY PARAMETERS. DEF *+6 DEF D2 DEF LU3K DEF D20 # RETRIES = 20. DEF D7 LONG TIMEOUT = 21 SEC. DEF ERCWD * JSB SLCER CHECK FOR ERRORS. D0 DEC 0 * * SEND INITIALIZATION REQUEST. * LDA D$MXR STORE MAX. SIZE, CLB DIV D16 (DIVIDED BY 16, ADA N1 MINUS 1) STA B ALF,ALF IOR B AND CURRENT SIZE. STA STRTM+4 * LDA STRTM ADDR OF INIT. REQUEST. TOBUF LDB D$WAD ADDR OF SEND BUFFER. STB BPNTR JSB .MVW MOVE INIT. REQUEST TO "SEND" DEF D8 NOP * LDA D8 SET BLOCK LENGTH STA LOG TO EIGHT. CLA GO TO VERIF IN CASE JSB VERIF TRACE WAS SPECIFIED. NOP IGNORE ERROR. **SHOULDN'T HAPPEN** * LDA D$WAD SET BUFFER POINTER ADA D8 TO END OF MESSAGE. STA BPNTR LDA N16 SET WRITE LENGTH TO 16 BYTES. STA D$WLN * JMP REMIO GO SEND INIT. REQUEST. SPC 1 @STAT DEF D$XS5+1 ADDRESS OF LONG TERM STATS. @TRFW DEF D$XS5+14 ADDRESS OF EVENT TRACE TABLE. SKP * * WAIT FOR THE 3000 TO SEND SOMETHING BY SCHEDULING "QUEZ". * WAIT FOR SOMETHING TO SEND TO THE HP 3000 BY HANGING ON * A CLASS I/O GET WITH WAIT TO QUEX'S I/O CLASS. * BLOCK AS MANY REQUESTS/REPLIES FROM QUEX'S I/O CLASS * BUFFER AS WILL FIT IN THE TRANSMIT BUFFER. * WATCH JSB OFFQZ MAKE SURE QUEZ IS DORMANT. JSB EXEC SCHEDULE QUEZ TO LOOK FOR DEF *+4 SLAVE REQUESTS FROM THE 3000. DEF D10 DEF QUEZ DEF D0 SET SCHEDULE OPTION CODE. * NEWGT CLA INITIALIZE LENGTH (BYTES) STA D$WLN OF TRANSMIT BUFFER. LDA D$WAD INITIALIZE BUFFER POINTER TO STA BPNTR START OF SEND AREA. * GET JSB EXEC CLASS I/O GET TO LOOK FOR DEF *+6 MASTER REQUESTS FROM RTE USERS. DEF CLS21 NO ABORT. DEF QXCLS QUEX I/O CpLASS. BPNTR NOP DEF D$MXR BUFFER LENGTH. DEF LOG RETURNED BLOCK LENGTH (WORDS). JSB CLER REPORT CLASS ERROR. * * THE CLASS GET HAS COMPLETED. IF RECEIVED DATA LENGTH IS ZERO, * THE 3000 WANTS TO SEND A SLAVE REQUEST OR A MASTER REPLY. * IF NON-ZERO, THE RTE IS SENDING A MASTER REQUEST OR SLAVE REPLY. * LDA LOG IS QUEZ TELLING US THE 3000 IS SENDING? SZA JMP BLKIN NO. ACCUMULATE OUTGOING REQUESTS. * LDA IGNOR YES. ARE WE TO IGNORE THIS ONE? SZA,RSS JMP RINTL NO. NEED TO SERVICE THE 3000. CLA YES. GO BACK TO THE GET. STA IGNOR JMP NULGT SPC 1 * A BLOCK HAS BEEN ADDED TO THE TRANSMIT BUFFER. * ADVANCE BUFFER POINTER AND COUNTER. * BLKIN LDA SGNOF INIT. REQ. EXCHANGED YET? SZA JMP NULGT NO. IGNORE. **SHOULDN'T HAPPEN** ADDBU CLA MESSAGE IS FROM 1000. JSB VERIF CHECK VALIDITY. JMP NULGT INVALID: IGNORE. * LDA BUFL ADD LEN OF BLOCK IN NEG BYTES CLE,ELA TO TOTAL XMIT BYTE LEN (NEG) CMA,INA THAT HAVE BEEN ACCUMULATED. ADA D$WLN STA D$WLN * LDA BPNTR ADVANCE BUFFER POINTER. ADA BUFL STA BPNTR * LDA BUFL SUBTRACT THE LENGTH CMA,INA OF PROCESSED BUFFERS ADA LOG FROM BLOCK LENGTH. STA LOG SAVE REMAINING LENGTH. SZA IF ANOTHER BUFFER, JMP ADDBU GO ADD IT. * * ISSUE A NULL GET CALL TO QUEX'S I/O CLASS TO SEE * IF THERE IS ANOTHER PENDING REQUEST AND TO SEE WHETHER * THERE IS ROOM IN THE TRANSMIT BUFFER. ISSUE THE GET * WITHOUT WAIT, SAVE CLASS BUFFER, AND BUF LEN = 0. * NULGT JSB EXEC CLASS GET (DUMMY). DEF *+6 DEF CLS21 NO ABORT. DEF QCLAS QUEX I/O CLASS. DEF D0 DUMMY BUFFER. DEF D0 ZERO LENGTH BUFFER. DEF LOG RETURNED BLOCK LENGTH (WORDSx). NOP IGNORE ERROR RETURN. * SSA WAS THERE ANYTHING THERE? JMP REMIO NO. GO SEND WHAT WE HAVE. * * A REQUEST IS IN THE CLASS BUFFER. SEE IF THERE * IS ROOM TO BLOCK IT INTO THE TRANSMIT BUFFER. * LDA BPNTR CMA,INA ADA D$RAD # WORDS LEFT IN XMIT BUFR. INA CMA,INA NEGATE. ADA LOG ADD LENGTH OF BLOCK (WORDS). SSA JMP GET FITS. GO READ IT IN. * * IF THERE WAS NO ROOM FOR THE LAST BLOCK, IT IS STILL IN * THE CLASS BUFFER AND WILL BE PICKED UP NEXT TIME AROUND. * * SEND THE BLOCKS TO THE HP3000 AND WAIT FOR INCOMING BLOCKS. * REMIO LDA ENQFL DO WE NEED TO DO A SZA,RSS "WRITE INQUIRY"? JMP WRCON NO. * JSB XLUEX ISSUE WRITE INQUIRY. DEF *+6 DEF D2 DEF LU3K DEF D1 DEF D0 DEF WNQWD * JSB SLCER CHECK FOR ERRORS. D2 DEC 2 * LDB @D2 CPA D5 EOT RECEIVED? JMP EOTER YES. **PROTOCOL FAILURE** * CLA STA ENQFL CLEAR ENQ FLAG. * CPA D13 BACK OFF TO READ INITIAL IF JMP RINTL ENQ RECEIVED (ONLY IF RTE SECONDARY). SPC 3 * * PERFORM WRITE CONVERSATIONAL TO HP 3000. * WRCON JSB XLUEX WRITE CONVERSATIONAL. DEF *+6 DEF D2 DEF LU3K DEF D$WLN LEN/SEND BUFFER/RECEIVE BUFFER. DEF BYTLN LEN OF RECEIVE BUFFER (-BYTES). DEF CONWD CONTROL WORD. * STB RDLEN SAVE READ LENGTH. JSB SLCER CHECK FOR SLC ERROR. D3 DEC 3 * LDB RDLEN CPB D2 TREAT 2 BYTES AS ZERO. CLB STB RDLEN SAVE POSITIVE # BYTES. * LDB D$WLN SAVE WRITE LENGTH CPB N2 FOR NULL MESSAGE CLB CHECK (EITHER 0 STB OWLEN OR 2 BYTES). CLB INDICATE DATA IN WRITE STB D$WLN BUFFER HAS BEEN SENT. * CPA D5* CHECK FOR JMP EOT EOT RECEIVED. SPC 3 * REQUESTS AND/OR REPLIES HAVE BEEN RECEIVED FROM THE HP 3000. * FOR REQUESTS, DO A CLASS WRITE TO THE REQUEST CONVERTER (RQCNV). * FOR REPLIES, SEARCH THE MASTER LIST (VIA SEQUENCE #) AND DO A CLASS * WRITE TO THE CORRESPONDING MASTER CLASS NUMBER. * STLEN LDA RDLEN SET # OF CLE,INA WORDS READ. ERA STA LOG SPC 2 * * GET TO THE NEXT BLOCK IN READ BUFFER. * DISP SZA,RSS IS THERE ANOTHER BLOCK? JMP DONE NO. SERVICING COMPLETE. * ADA N7 IGNORE IF LESS THAN 8 WORDS. SSA JMP DONE IGNORE REST OF BLOCK. **SHOULDN'T HAPPEN** * * DETERMINE WHETHER MESSAGE IS A REQUEST FROM THE 3000 * OR A REPLY TO AN RTE MASTER'S REQUEST. * CLA,INA CHECK VALIDITY AND SET UP , JSB VERIF , , AND . JMP DONE INVALID REQUEST. IGNORE REST OF BLOCK. * LDA STMWD ISOLATE REPLY AND AND B140K REJECT BITS. * CPA B140K IF BOTH SET, 3000 IS REJECTING JMP NEXT AN RTE REPLY. IGNORE. * SZA IF EITHER IS SET, JMP REPLY IT'S A REPLY TO AN RTE MASTER. SPC 3 * * A REQUEST HAS ARRIVED FROM THE 3000. * LDA CLASS IF MESSAGE CLASS SZA,RSS IS ZERO, JMP MZERO GO TO SPECIAL HANDLER. LDB SGNOF INIT. REQ. EXCHANGED YET? SZB JMP REJCT NO. REJECT. * CPA D5 CLASS 5? ($STDIN/$STDLIST) JMP $SCHK YES--MAY BE FOR MASTER. * RQCNV LDA #RQCV SET IOR BIT15 NO-WAIT STA CLASN BIT. * JSB EXEC WRITE REQUEST TO RQCNV'S CLASS. DEF *+8 DEF CLS20 DEF D0 DEF BPNTR,I DEF BUFL DEF D0 DEF D0 DEF CLASN CLASS NUMBER OF RQCNV. JMP REJCT ERROR RETURN. SZA IF NO SAM, JMP REJCT TRY TO REJECT.  * JMP NEXT GO DISPATCH NEXT BLOCK. SPC 1 BYTLN NOP SPC 3 * * THE MESSAGE IS A DS/3000 REPLY TO AN RTE MASTER REQUEST. * CHECK FOR SPECIAL CLASSES: 0, 5, AND 6. * REPLY LDA CLASS MESSAGE CLASS 0? SZA,RSS JMP REPL0 YES--GO TO SPECIAL HANDLER. * IFN ********************************************** CPA D5 MESSAGE CLASS 5? JMP LUMAP YES--PASS TO LU MAPPING MONITOR. XIF ********************************************* * CPA D6 MESSAGE CLASS 6? JMP LBYE? YES--CHECK FOR LAST BYE. * * SEARCH FOR MASTER TCB. * SRCHM LDB BPNTR GET ADB D5 SEQUENCE LDA B,I NUMBER. STA TEMP SZA,RSS IF IT'S ZERO, JMP REJCT REJECT! JSB #RSAX CALL DEF *+3 #RSAX DEF D4 FOR DEF TEMP SEARCH. SSB FOUND? JMP NEXT NO--IGNORE. SPC 2 IOR BIT15 SET NO-WAIT BIT STA CLASN SAVE I/O CLASS #. * JSB EXEC CLASS DEF *+8 WRITE DEF CLS20 TO DEF D0 CLASN. DEF BPNTR,I DEF BUFL DEF BUFL DEF D0 DEF CLASN JMP RPCLS REPORT ERROR AND GO TO "NEXT". SZA IF NO SAM, JMP NOSAM PRINT ERROR MESSAGE. SPC 2 * * END OF PROCESSING FOR THIS BLOCK. * NEXT LDA BPNTR BLOCK PROCESSED: ADA BUFL UPDATE POINTER INTO STA BPNTR RECEIVE BUFFER. * LDA BUFL CALCULATE NUMBER CMA,INA OF WORDS REMAINING ADA LOG IN READ BUFFER. STA LOG * JMP DISP GO CHECK FOR ANOTHER BLOCK. SPC 2 * * ALL RECEIVED BLOCKS HAVE BEEN DISPATCHED. * DONE LDA D$WLN RESET CMA,INA BUFFER CLE,ERA POINTER. ADA D$WAD STA BPNTR * LDA D$WLN :ANY DATA IN WRITE BUFFER? SZA (ACCUMULATION INTERRUPTED BY ENQ.) JMP NULGT YES--CONTINUE ACCUMULATION. * JSB EXEC "NULL" CLASS GET. (BUFFERS MAY HAVE BEEN DEF *+6 ADDED WHILE QUEX WAS I-O SUSPENDED). DEF CLS21 DEF QCLAS DEF D0 DEF D0 DEF LOG JSB CLER ERROR RETURN. * SSA ANYTHING THERE? JMP NOMOR NO. * LDA LOG YES. SZA ZERO LENGTH BUFFER? JMP NEWGT NO. * YES. QUEZ DID IT JUST BEFORE THE INA WRITE CONVERSATIONAL. REQUEST HAS STA IGNOR ALREADY BEEN READ, SO IGNORE IT. * NOMOR LDA DCNFL ARE WE TO ATTEMPT DISCONNECT? SZA,RSS JMP CKDAT NO. * CLA YES. SEND TERMINATION REQUEST. STA DCNFL LDA TRMRQ MOVE TERMINATION REQUEST TO JMP TOBUF CURRENT BUFFER LOCATION. * * WE HAVE NOTHING TO SEND TO HP 3000. IF EMPTY MESSAGES HAVE * BEEN EXCHANGED, GO TO WRITE RESET. OTHERWISE SEND EMPTY MESSAGE. * CKDAT LDA OWLEN IF OLD WRITE LENGTH SZA,RSS OR LDA RDLEN CURRENT READ LENGTH SZA,RSS IS ZERO, JMP RESET GO SEND EOT. * LDA N2 SET LENGTH TO 2 BYTES CCB AND DATA TO ALL 1S. DST D$WLN ISZ BPNTR BUMP RECEIVE BUFFER POINTER. JMP WRCON SEND NULL MESSAGE TO 3000. * RESET JSB XLUEX PERFORM "WRITE RESET" (SEND EOT). DEF *+6 DEF D2 DEF LU3K DEF D0 DEF D0 DEF RESWD * JSB SLCER CHECK FOR ERRORS. D5 DEC 5 * EOT CLA,INA STA ENQFL SET "SEND ENQ" FLAG. * JMP WATCH SPC 5 * * PRINT ERROR MESSAGE WHEN CLASS I/O FAILS BECAUSE OF NO SAM. * NOSAM JSB EXEC DEF *+5 DEF SD2 DEF D1 DEF SAMER DEF D13 NOP JMP NEXT * SAMER ASC 13,/QUEX: INSUFFICIENT S.A.M. SPC 3 * * PRINT OTHER CLASS I/O ERROR INFORMATION * CLER NOP ENTRY. DST CMSG1 STORE ASCII ERROR CODE. JSB EXEC PRINT ON DEF *+5 SYSTEM DEF SD2 CONSOLE. DEF D1 DEF CMSG DEF D12 NOP CLA CLEAR # OF WORDS. JMP CLER,I RETURN. * CMSG ASC 10,/QUEX: CLASS ERROR CMSG1 ASC 2, SPC 2 * ENTRY POINT TO PRINT ERROR, THEN GO TO NEXT. RPCLS JSB CLER JMP NEXT SKP * * THE SEND BUFFER CONTAINS MASTER REQUESTS AND/OR SLAVE REPLIES, * BUT BEFORE IT COULD BE SENT, THE 3000 HAS SENT A LINE BID. * THE WRITE LENGTH INDICATES THE SEND BUFFER CONTAINS GOOD DATA. * * READ INITIAL--GET 3000'S BID FOR LINE. * RINTL JSB XLUEX ISSUE "READ INITIAL" CALL. DEF *+6 DEF D1 DEF LU3K DEF BPNTR,I DEF BYTLN DEF RDIWD * STB RDLEN SAVE READ LENGTH. JSB SLCER CHECK FOR ERRORS. D4 DEC 4 * LDB RDLEN CPB D2 IF 2 BYTES WERE SENT, CLB IT'S AN EMPTY MESSAGE. STB RDLEN SAVE POSITIVE # BYTES. * LDB @D4 CPA D5 JMP EOTER RECEIVED EOT. **PROTOCOL FAILURE** * LDB RDLEN CHECK TRANSMISSION LOG. SZB,RSS JMP RESET SEND EOT IF ZERO. * CLA CLEAR "NEED STA ENQFL ENQ" FLAG. * JMP STLEN DISPATCH BLOCKS FROM READ BUFFER. * SPC 2 * EOTER STB SLCER EOT RECEIVED IN READ LDB @EM5 INITIAL OR WRITE INQUIRY. JMP ABT SPECIAL "SLCER" ENTRY. @D2 DEF D2 @D4 DEF D4 SKP * * CHECK WHETHER $STDLIST REQUEST SHOULD GO TO MASTER OR CNSLM. * $SCHK LDB BPNTR GET "FROM PROCESS NUMBER." ADB D4 LDA B,I ALF,ALF AND B377 SZA,RSS IF ZERO, JMP RQCNV PASS TO RQCNV. LDA B,I GET "TO PROCESS NUMBER" AND B377 SZA,RSWS IF ZERO, JMP RQCNV PASS TO RQCNV. JMP SRCHM BOTH NON-ZERO. PASS TO MASTER. SPC 3 * REQUEST RECEIVED ON CLASS 0. * CLASS 0, STREAM 20: INITIALIZATION * CLASS 0, STREAM 21: TERMINATION * MZERO LDA STREM STREAM = CPA B20 OCTAL 20? JMP REJCT YES. REJECT INITIALIZATION. CPA B21 STREAM = RSS OCTAL 21? JMP REJCT NO--UNKNOWN. REJECT. **SHOULDN'T HAPPEN** * * HP 3000 REQUESTS TERMINATION ONLY WHEN IT THINKS NEITHER * SIDE HAS ANYTHING GOING. MAKE SURE PNL IS EMPTY. * CCB GET ADDRESS OF ADB #LDEF PNL HEADER ADDR. LDB B,I GET ADDR OF LDB B,I FIRST PNL ENTRY. JSB CKLST IF ANYONE IS IN LIST, RSS JMP REJCT REJECT. **SHOULDN'T HAPPEN** LDB #LDEF GET ADDRESS INB OF FIRST LDB B,I MASTER LDB B,I REQUEST. JSB CKLST IF ANYONE IS IN LIST, RSS JMP REJCT REJECT. **SHOULDN'T HAPPEN** JSB DCNCT SET DISCONNECT STATUS JMP CLOSE AND GO CLOSE THE LINE. SPC 1 * * REPLY RECEIVED ON CLASS 0. * REPL0 LDB STMWD GET STREAM WORD RBL AND POSITION REJECT BIT. LDA STREM IF STREAM = CPA B20 OCTAL 20, JMP INIRP IT'S AN INITIALIZATION REPLY. CPA B21 IF STREAM NOT = RSS OCTAL 21, JMP REJCT UNKNOWN. REJECT. **SHOULDN'T HAPPEN** * * HP 3000 IS REPLYING TO OUR TERMINATION REQUEST. * SSB REJECT BIT SET? JMP NEXT YES--DON'T DISCONNECT. JMP CLOSE NO--GO AHEAD AND CLOSE LINE. * * HP 3000 IS REPLYING TO OUR INITIALIZATION REQUEST. * INIRP SSB REJECT BIT SET? JMP INIT YES--RETRY. JSB CNNCT NO--ESTABLISH CONNECT STATUS. LDA D$XS5 SET MODE IOR D1 TO "PRIMAFRY." STA D$XS5 * LDA BPNTR ISOLATE RIGHT ADA D3 HALF OF LDA A,I WORD 4 IN AND B377 BUFFER. INA INCREMENT AND MULTIPLY MPY D16 BY 16 TO GET BUFFER SIZE. STA D$BSZ STORE IN SSGA. * LDA DCONT IF DELAY COUNT CPA N50 IS 50, SKIP JMP NEXT THE "UP" MESSAGE. * DLD UP 3000 LINK IS "UP". DST STMSG+16 LDA UP+2 STA STMSG+18 * JSB EXEC DISPLAY STATUS DEF *+5 MESSAGE ON LU 1. DEF D2 DEF D1 DEF STMSG DEF D20 * LDA N50 SET DELAY COUNT STA DCONT TO 50 (LONG). * JMP NEXT PROCESS NEXT BLOCK. SPC 3 * THE 3000 HAS FOUND NOTHING TO DO (NO HELLO OUTSTANDING AND * NO SLAVE ACTIVITY) AND HAS DISCONNECTED THE LINE, OR AN * ABORTIVE COMMUNICATION ERROR HAS OCCURRED. CLOSE THE * LINE AND RE-INITIALIZE THE DRIVER AND QUEX. * CLOSE JSB XLUEX WRITE DISCONNECT. DEF *+6 DEF D2 DEF LU3K DEF D0 DEF D0 DEF WRDIS * LNCLO JSB XLUEX CLOSE THE LINE. DEF *+6 DEF D2 DEF LU3K DEF D0 DEF D3 DEF LCLWD * JSB DVRTC PERFORM DRIVER TRACE. * JSB OFFQZ MAKE SURE QUEZ IS DORMANT. * LDA D$XS5 RESET TO "SECONDARY" MODE. AND N2 STA D$XS5 * JMP INIT GO RE-INITIALIZE. SPC 5 * * SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. * REJCT LDA STMWD MAKE SURE AND BIT14 WE AREN'T SZA REJECTING JMP NEXT A REJECT! LDA BPNTR,I APPENDAGE AND B377 LENGTH IOR LB8 IS 8. STA BPNTR,I LDA STMWD SET REJECT BIT. IOR BIT14 AND NBT13 CLEAR CONTINUATION BIT. LDB BPNTR ADB D2 STA B,I ADB D2 REVERSE PROCESS NUMBERS. LDA B,I Y ALF,ALF STA B,I ADB D3 DATA LENGTH = 0. CLA STA B,I * LDA QXCLS IOR BIT15 SET NO-WAIT BIT. STA CLASN SAVE I/O CLASS #. * JSB EXEC CLASS DEF *+8 WRITE DEF CLS20 TO DEF D0 QUEX. DEF BPNTR,I DEF D8 DEF D8 DEF D0 DEF CLASN JMP RPCLS ERROR--REPORT. SZA IF NO SAM, JMP NOSAM PRINT ERROR MESSAGE. JMP NEXT * LB8 BYT 10,0 LEFT BYTE DECIMAL 8. SPC 3 * * ESTABLISH "DISCONNECT" STATUS (CHECKED BY UPLIN AND D3KMS). * DCNCT NOP CLA,INA SET SIGN OFF FLAG. STA SGNOF LDA #QXCL SET DISCONNECT FLAG IN #QXCL IOR BIT15 TO INDICATE DISCONNECT STATUS. STA #QXCL JMP DCNCT,I RETURN. * * ESTABLISH "CONNECT" STATUS. * CNNCT NOP CLA CLEAR SIGN OFF FLAG. STA SGNOF LDA #QXCL CLEAR DISCONNECT FLAG IN #QXCL ELA,CLE,ERA TO INDICATE CONNECT STATUS. STA #QXCL JMP CNNCT,I RETURN. SPC 3 * * CLASS 6 REPLY RECEIVED. IS IT LAST BYE? * LBYE? LDA STREM IF NOT CPA B21 STREAM 21, RSS IT'S NOT JMP SRCHM A BYE. * CCB GET ADDR OF PNL HEADER ADDR. ADB #LDEF LDB B,I GET ADDR OF PNL HEADER LDB B,I GET ADDR OF FIRST PNL ENTRY. JSB CKLST CHECK FOR ONE ENTRY. JMP STDIS NONE--DO DISCONNECT. JSB CKLST CHECK FOR SECOND ENTRY. JMP STDIS NO MORE--DO DISCONNECT. JMP SRCHM MORE THAN ONE HELLO OUTSTANDING. * STDIS CLA,INA SET DISCONNECT FLAG. STA DCNFL JMP SRCHM SEARCH FOR MASTER. SPC 3 * * SUBROUTINE TO TERMINATE QUEZ. * OFFQZ NOP ENTRY. JSB EXEC CALL EXEC FOR DEF *+4 SON'S TERMINATION. DEF SD6 DEF QUEZ DEF N1 f(QUEZ IS SERIAL REUSABLE) NOP IGNORE ERRORS. JMP OFFQZ,I RETURN. * SD6 DEF 6,I SPC 4 * * SUBROUTINE TO CHECK IF A TCB LIST HAS ANY HP3000 ENTRIES. * CALLING SEQUENCE: LDB * JSB CKLST * * * CKLST NOP CKLOP SZB,RSS END OF LIST? JMP CKLST,I YES--TAKE NO-ENTRY RETURN. JSB LODWD STA TEMP SAVE LINK. INB GET SECOND JSB LODWD TCB WORD. LDB TEMP SET UP POINTER FOR NEXT LOOP. AND BIT14 ISOLATE "3000" BIT. SZA,RSS IF NOT SET, JMP CKLOP STAY IN LOOP. * ISZ CKLST ENTRY FOUND! JMP CKLST,I TAKE 2ND RETURN. * SKP * * SUBROUTINE TO VERIFY AUTHENTICITY OF REQUESTS AND REPLIES * BEING SENT OR RECEIVED. ALSO SETS , , , * AND AND PERFORMS TRACE (IF REQUESTED). * * ON ENTRY, (A) = 0 IF OUTGOING REQ/REPLY, * = 1 IF INCOMING REQ/REPLY. * BPNTR = BUFFER ADDRESS OF REQ/REPLY. * VERIF NOP STA TEMP SAVE DIRECTION CODE. LDB BPNTR LOAD ADDRESS OF MESSAGE. * LDA B,I CHECK WORD 1: SZA,RSS JMP BADBF ERROR IF ZERO. AND B377 ISOLATE MESSAGE CLASS. STA CLASS SAVE IT. ADA N9 SSA,RSS JMP BADBF ERROR IF MESSAGE CLASS > 8. * ADB D2 CHECK WORD 3: LDA B,I STA STMWD SAVE IT. AND B377 ISOLATE STREAM TYPE. STA STREM SAVE IT. ADA NB20 SSA JMP BADBF ERROR IF < OCTAL 20. ADA NB10 SSA,RSS JMP BADBF ERROR IF > OCTAL 27. * ADB D5 CHECK WORD 8: LDA B,I SSA JMP BADBF ERROR IF NEGATIVE. * LDB BPNTR VERIFY THAT ADB D7 WDCNT <= N(WORDS) + 8. LDB B,I INB e( CLE,ERB ADB D8 STB BUFL SAVE WORD COUNT. INB CMB,INB LDA BPNTR,I ALF,ALF AND B377 ADA B SSA,RSS JMP BADBF ERROR. ISZ VERIF NO ERROR, TAKE NORMAL RETURN. * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. * LDA #CL3K+1 BUFFERS TO BE TRACED? SSA,RSS IF BIT 15 NOT SET, JMP VERIF,I RETURN. * LDA D8 INITIALIZE TRACE STA TRLEN LENGTH TO 8. * LDA #CL3K+1 APPENDAGE BIT SET? AND BIT14 SZA,RSS JMP WRTRC NO. GO WRITE. * LDA BPNTR,I GET LENGTH OF ALF,ALF APPENDAGE AND AND B377 HEADER FROM STA TRLEN WORD 1. * LDA #CL3K+1 GET MAX DATA LENGTH AND LENBT FROM BITS 0-12. ADA TRLEN ADD HEADER/APPEND LENGTH. STA B HOLD IN B-REG. CMA,INA IF GREATER THAN ACTUAL ADA BUFL BUFFER LENGTH, SSA LDB BUFL USE BUFFER LENGTH. STB TRLEN STORE TRACE LENGTH. * WRTRC CCA ADA BPNTR SET TRACE STA TPNTR POINTER. LDB TPNTR,I SET FIRST WORD STB HOLD TO INDICATE LDB TEMP DIRECTION. STB TPNTR,I ISZ TRLEN ADD 1 TO LENGTH. JSB TRCOT WRITE TRACE. LDA HOLD RESTORE FIRST STA TPNTR,I BUFFER WORD. JMP VERIF,I RETURN. * BADBF LDA DRECV INITIALIZE FOR "RECEIVED". LDB TEMP CHECK DIRECTION FLAG. SZB,RSS LDA DOUTG CHANGE TO "OUTGOING". LDB DINSR GET ADDR IN MAIN MESSAGE. JSB .MVW MOVE DIRECTION MESSAGE. DEF D5 NOP * LDA LOG SET BUFFER LENGTH STA BUFL TO REMAINING BLOCK STA TRLEN LENGTH & SET TRACE LEN. * JSB EXEC DISPLAY DEF *+5  ">> HP 3000: BAD BUFFER RECEIVED". DEF D2 OR DEF D1 ">> HP 3000: BAD BUFFER OUTGOING". DEF BDBUF DEF D16 * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. JMP WRTRC YES. SPC 1 * VALUES SET BY VERIF: CLASS NOP DS/3000 MESSAGE CLASS. STMWD NOP DS/3000 STREAM WORD. STREM NOP DS/3000 MESSAGE STREAM. BUFL NOP WORD COUNT OF BUFFER. HOLD NOP SPC 5 * * SUBROUTINE TO WRITE A RECORD TO TRACE LU. * CALLING SEQUENCE: * JSB TRCOT * TRCOT NOP ENTRY POINT. * LDA #CL3K CHECK STA TRCST BIT STA TRCIO 13 OF AND BIT13 LOG WORD. SZA JMP CLIO SET--DO CLASS I/O. * JSB XLUEX CHECK OUT DEF *+3 DYNAMIC DEF SD3 STATUS. DEF TRCST JMP WRERR ERROR RETURN. AND B277 IF ANY "BAD" BITS SZA ARE SET, JMP TRCDN SET TRACE DOWN. * JSB XLUEX WRITE ENTIRE DEF *+5 MESSAGE TO DEF SD2 TRACING LU. DEF TRCIO DEF TPNTR,I DEF TRLEN RSS ERROR RETURN. JMP TRCOT,I NO ERROR. RETURN. * WRERR DST ABREG PRINT JSB EXEC ERROR DEF *+5 MESSAGE. DEF SD2 DEF D1 DEF IOERR DEF D13 NOP * TRCDN LDA #CL3K SET "BAD" BIT IOR BIT15 IN TRACE LU. STA #CL3K JMP TRCOT,I RETURN. * CLIO LDA #CL3K SET NO-WAIT BIT IOR BIT15 IN CLASS NUMBER. STA CLASN JSB EXEC WRITE TO I/O CLASS. DEF *+8 DEF CLS20 DEF D0 DEF TPNTR,I DEF TRLEN DEF TRLEN DEF D0 DEF CLASN JMP WRERR (ERROR RETURN.) SZA,RSS CHECK FOR NO S.A.M. JMP TRCOT,I NO ERROR...RETURN. DLD "SAM" REPORT SAM ERROR. JMP WRERR * "SAM" ASC 2,SAM IOERR ASC 11,/QUEX: TRACING ERROR ABREG BSS 2 TRLEN NOP TRACE OUTPUT LENGTH. TPNTR NOP TRACE OUTPUT POINTER. TRCIO OCT 0,100 TRACE LU/BINARY BIT TRCST OCT 0,600 TRACE LU/STATUS BITS SD3 DEF 3,I B277 OCT 277 SKP * * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I GET WORD FROM TCB (RSS IF DMS SYSTEM). JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I RETURN. SPC 3 * * SUBROUTINE TO STORE WORD INTO ALTERNATE MAP (IF MAPPED SYSTEM) * STRWD NOP JSB $LIBR LOWER FENCE NOP MODI1 NOP RSS HERE IF DMS SYSTEM. JMP TSTC3 XSA B,I STORE INTO SYSTEM MAPPED LOCATION. RSS * FOLLOWING INSTRUCTION IS EXECUTED FOR NON-DMS SYSTEMS ONLY TSTC3 STA B,I STORE WORD. JSB $LIBX RAISE FENCE. DEF STRWD RETURN. SKP * * SUBROUTINE TO CHECK STATUS AFTER SLC CALLS. * SLCER NOP ENTRY. * JSB DVRTC PERFORM DRIVER TRACE. * JSB XLUEX ISSUE STATUS CALL. DEF *+5 DEF D13 DEF #LU3K CURRENT HP3000 LU. DEF STATS COMPLETION STATUS (EQT WORD 5). DEF TEMP2 EQT WORD 4. * LDA STATS WAS THERE AN ERROR? AND B37 STA STATS SZA,RSS JMP ERREX NO. RETURN. (A) = 0. * LDB ETABL ADDR OF ERROR MESSAGE TABLE. ADB A ADD STATUS CODE. LDB B,I GET ADDR OF ERROR MESSAGE. SZB JMP ABT NON-ZERO. SET UP ERROR MESSAGE. * ERREX ISZ SLCER JMP SLCER,I RETURN TO CALLER. (A)=NON-ABORT CODE. * ABT STB A ADDR OF ERROR MESSAGE. LDB MSGA1 STORAGE ADDR IN MAIN MESSAGE. JSB .MVW MOVE ERROR MSGF TO MAIN MESSAGE. DEF D8 NOP * LDA DCONT IF DELAY COUNT CPA N2 IS 2 (SHORT), JMP GDRMT SKIP PRINT AND CLEANUP. * LDA SLCER,I PLACE TYPE OF CALL IN MESSAGE. MPY D5 ADA DCTN LDB DEM11 JSB .MVW DEF D5 NOP * DLD DOWN INSERT "*DOWN*". DST STMSG+16 LDA DOWN+2 STA STMSG+18 * JSB EXEC DISPLAY ERROR MSG ON LU 1. DEF *+5 DEF D2 DEF D1 DEF STMSG DEF D39 * JSB CLNUP PERFORM GLOBAL CLEANUP. * GDRMT JSB EXEC GO DORMANT, SAVE RESOURCES. DEF *+4 (UPLIN WILL RESTART QUEX DEF D6 IN FIVE SECONDS.) DEF D0 DEF D1 * ISZ DCONT BUMP COUNTER. JMP GDRMT STAY IN LOOP UNTIL 0. * LDA N2 SET DELAY COUNT STA DCONT TO 2 (SHORT). * LDA STATS IF ERROR WAS DLE EOT, CPA D6 GO RIGHT TO LINE CLOSE. JMP LNCLO JMP CLOSE OTHERWISE SEND DLE EOT FIRST. * * DCTN DEF *+1 ASC 5, ASC 5, LINE OPEN ASC 5, SEND ENQ ASC 5, WRITE CON ASC 5, READ INIT ASC 5, SEND EOT * DCONT BSS 1 DELAY COUNT = -50 WHEN LINE * FIRST GOES DOWN, -2 AFTERWARD. SKP * * SUBROUTINE TO BUILD AND WRITE TRACE ENTRY FOR DRIVER CALLS. * CALLING SEQUENCE: JSB DVRTC * DVRTC NOP ENTRY. DST A&B SAVE REGISTERS. LDA #CL3K GET LOGGING LU. SZA IF NOT SPECIFIED, SSA OR BAD, JMP RTRN1 RETURN. * LDA #CL3K+1 IF DRIVER AND BIT13 TRACE WAS SZA,RSS NOT SPECIFIED, JMP RTRN1 RETURN. * CCA SET TRACE TYPE STA TRBUF TO -1. * DLD $TIME GET SYSTEM DST TRTIM TIME. * LDA D$WLN SAVE STA TWLEN WRITE LDA RDLEN AND READ STA TRDLN LENGTHS. * LDA @TDAT INITIALIZE TRACE STA TDPNT DESTINATION POINTER. * LDB OLENT INITIALIZE TRACE STB ENTRY SOURCE POINTER. * NWENT STB ELINK SAVE POINTER TO NEXT ENTRY JSB NXTEV PICK UP WORD TWO. SVENT JSB STBUF SAVE IN BUFFER. JSB NXTEV PICK UP EVENT/STATE WORD. LDB ELINK,I UP TO NEXT ENTRY? CPB ENTRY RSS JMP SVENT NO. GET NEXT EVENT/STATE. * CCA STORE -1 IN BUFFER JSB STBUF TO INDICATE END OF ENTRY. LDB ELINK,I CPB D$XS5+12 END OF TABLE? RSS JMP NWENT NO. DO NEXT ENTRY. * LDA @TRBF SAVE START OF TRACE STA TPNTR BUFFER FOR OUTPUT. CMA,INA CALCULATE LENGTH ADA TDPNT OF BUFFER. STA TRLEN JSB TRCOT WRITE ENTRY. * RTRN1 LDA D$XS5+12 SET UP OLD ENTRY STA OLENT POINTER FOR NEXT TIME. DLD A&B RESTORE REGISTERS. JMP DVRTC,I RETURN. * * BUFFER FOR DRIVER TRACE: TRBUF NOP TRACE TYPE TRTIM BSS 2 TIME TWLEN NOP WRITE LENGTH TRDLN NOP READ LENGTH TRDAT BSS 50 TRACE ENTRIES @EOTB DEF * * * STORAGE FOR DRIVER TRACE: @TRBF DEF TRBUF @TDAT DEF TRDAT A&B BSS 2 TDPNT NOP DESTINATION POINTER. OLENT NOP OLD TRACE ENTRY. ELINK NOP ENTRY LINK. SPC 3 * * SUBROUTINE TO STORE A-REG IN BUFFER AND BUMP POINTER. * CALLING SEQUENCE: * JSB STBUF * STBUF NOP ENTRY. LDB @EOTB IF POINTER IS AT END CPB TDPNT OF TRACE BUFFER, JMP STBUF,I SKIP THE STORE. STA TDPNT,I STORE WORD. ISZ TDPNT BUMP POINTER. JMP STBUF,I RETURN. * ENTRY NOP POINTER INTO TRACE TABLE. EOTBL NOP LAST ADDRESS IN TABLE. SOTBL NOP FIRST ADDRESS IN TABLEo. SPC 3 * * GET NEXT ENTRY IN EVENT TABLE * NXTEV NOP LDA ENTRY GET CURRENT ENTRY ADDRESS. INA ADD ONE. CPA EOTBL IF OUT OF TABLE, LDA SOTBL RESET TO BEGINNING. STA ENTRY STORE. LDA A,I A:=CONTENTS OF ENTRY. JMP NXTEV,I RETURN. * SKP * * SUBROUTINE TO CLEAN UP FOR FRESH START: * TELL UPLIN TO TIMEOUT ALL MASTER REQUESTS TO 3000 AND ZERO PNL LIST. * NEW REQUESTS ARE BLOCKED SINCE HP 3000 IS IN "DISCONNECT" STATUS. * CLNUP NOP JSB DCNCT ESTABLISH "DISCONNECT" STATUS. * * LOCK "QUEX ABORT" RN (GLOBALLY) SO UPLIN WILL CLEAN UP. * JSB RNRQ DEF *+4 DEF GLOCK DEF #CLRN DEF TEMP NOP ERROR RETURN. * JSB OFFQZ MAKE QUEZ DORMANT. * LDA QXCLS QUEX CLASS # /NO DE-ALLOC (BIT13). IOR BIT15 SET NO-WAIT BIT (#15). STA CLASN RELEASE BUFFER. * FLUSH JSB EXEC FLUSH QUEX'S I/O CLASS. DEF *+5 DEF CLS21 DEF CLASN DEF D0 DEF D0 RSS IGNORE ERRORS. * SSA,RSS ANYTHING THERE? JMP FLUSH YES. KEEP FLUSHING. * * HANG ON "QUEX ABORT" RN UNTIL UPLIN FINISHES CLEANUP. JSB RNRQ DEF *+4 DEF LKCLR DEF #CLRN DEF TEMP NOP ERROR RETURN. * JMP CLNUP,I RETURN TO CALLER. SPC 2 GLOCK OCT 40002 LKCLR OCT 40006 SD2 DEF 2,I SKP * * WRONG DRIVER FOR THIS QUEX. REPORT THE ERROR. * WRDVR JSB EXEC REPORT ERROR DEF *+5 ON SYS CONSOLE. DEF D2 DEF D1 DEF WRMSG DEF D12 * JSB EXEC SUSPEND. DEF *+2 DEF D7 * JMP WRDVR STAY IN LOOP IN CASE OF "GO". * WRMSG ASC 12,>> QUEX EXPECTS HSI LINK SKP ETABL DEF * TABLE OF ERROR MESSAGES FOR STATUS. DEF EM1 =1 DEF EM2 =2 DEF EM3 =3 \ DEF EM4 =4 NOP =5 NON-ABORTIVE (EOT RECEIVED). DEF EM6 =6 DEF EM7 =7 DEF EM8 =8 DEF EM9 =9 DEF EM10 =10 DEF EM11 =11 DEF EM12 =12 NOP =13 NON-ABORTIVE (SENT ENQ, GOT ENQ). DEF EM14 =14 DEF EM15 =15 DEF EM16 =16 DEF EM17 =17 @EM5 DEF EM5 * EM1 ASC 8,INVALID REQUEST EM2 ASC 8,WRONG LINE STATE EM3 ASC 8,BAD ID SEQUENCE EM4 ASC 8,HARDWARE FAILURE EM5 ASC 8,EOT RECEIVED EM6 ASC 8,DLE EOT RECEIVED EM7 ASC 8,TIMEOUT EM8 ASC 8,SENT EOT,GOT ENQ EM9 ASC 8,DATA OVERRUN EM10 ASC 8,MAX. NAKS RECV'D EM11 ASC 8,MAX # ENQ SENT EM12 ASC 8,RVI RECEIVED EM14 ASC 8,NAK RECEIVED EM15 ASC 8,MAX ENQ RECEIVED EM16 ASC 8,NO NAK TO TTD EM17 ASC 8,IMPOSSIBLE ERROR * STMSG BYT 15,12 , ASC 18,>> HP 3000 COMMUNICATION LINK *DOWN* BYT 15,12 , EMSG ASC 18,>> **************** @ ********* BYT 15,12 , DEM11 DEF EMSG+11 UP ASC 3,* UP * DOWN ASC 3,*DOWN* BDBUF ASC 16,>> HP 3000: BAD BUFFER RECEIVED DINSR DEF BDBUF+11 DRECV DEF *+1 ASC 5, RECEIVED DOUTG DEF *+1 ASC 5, OUTGOING B37 OCT 37 MSGA1 DEF EMSG+2 SKP * * CONSTANTS AND WORKING STORAGE. * * D6 DEC 6 D7 DEC 7 NB10 OCT -10 NB20 OCT -20 B377 OCT 377 B140K OCT 140000 BIT15 OCT 100000 BIT14 OCT 40000 BIT13 OCT 20000 NBT13 OCT 157777 LENBT OCT 17777 BITS 0-12 CLS20 DEF 20,I CLS21 DEF 21,I D8 DEC 8 D9 DEC 9 D10 DEC 10 D11 DEC 11 D12 DEC 12 D13 DEC 13 D20 DEC 20 D39 DEC 39 N1 DEC -1 N2 DEC -2 N7 DEC -7 N9 DEC -9 N16 EQU NB20 N50 DEC -50 LU3K OCT 0,0 3000 LU FOR XLUEX QXCLS NOP QUEX CLASS NUMBER. QCLAS NOP (WITH NO-WAIT & SAVE-BUFFER BITS SET.) LOG NOP WORDS TO PROCESS IN CURRENT BUFFER DCNFL OCT 0 SGNOF OCT 0 ENQFL OCT 0 IGNOR OCT 0 QUEZ ASC 3,QUEZ * * TABLE OF CONTROL WORDS. CLRWD OCT 064400 CLEAR INLWD OCT 040103 INITIALIZE WNQWD OCT 020100 WRITE INQUIRY ERCWD OCT 064200 ERROR PARAMETERS CONWD OCT 022300 WRITE CONVERSATIONAL RESWD OCT 020400 WRITE RESET (EOT) RDIWD OCT 020200 READ INITIAL LCLWD OCT 060300 LINE CLOSE WRDIS OCT 020500 WRITE DISCONNECT (DLE EOT) * OWLEN NOP STATS NOP CLASN NOP TEMP NOP TEMP2 NOP RDLEN NOP * STRTM DEF *+1 BYT 10,0 INITIALIZATION REQUEST. DEC 0 B20 OCT 20 OCT 0,0,0,0,0 D16 EQU B20 * TRMRQ DEF *+1 BYT 10,0 TERMINATION REQUEST. DEC 0 B21 OCT 21 OCT 0,0,0,0,0 * BSS 0 *** SIZE OF QUEX **** * SKP IFZ *** BEGIN DEBUG *** *** SPECIAL DEBUG SECTION *** * INSERT A "JSB TRACE" IN PROGRAM. QUEX WILL PRINT CALL LOCATION * AND CONTENTS OF A- & B-REGISTERS ON LU SPECIFIED IN #CL3K+6. * EXT CNUMO TRACE NOP ENTRY DST ABREG STORE REGISTERS LDA #CL3K+6 SZA,RSS IF TRACE LU ISN'T SPECIFIED, JMP TRTRN RETURN FROM TRACE. * STA TRLU SAVE TRACE LU NUMBER. * LDB 1727B GET POINTER TO STARTING ADDR FROM BASE PG. JSB LODWD GET STARTING ADDR FROM ID SEG. CMA,INA NEGATE. ADA TRACE ADD CALLING ADDRESS STA TOFST TO GET OFFSET. * JSB CNUMO CONVERT DEF *+3 ADDRESS OFFSET DEF TOFST TO DEF TADDR OCTAL. * JSB CNUMO CONVERT DEF *+3 A-REG DEF ABREG TO DEF TAREG OCTAL. * JSB CNUMO CONVERT DEF *+3 B-REG DEF ABREG+1 TO DEF TBREG OCTAL. * JSB XLUEX PRINT DEF *+5 INFORMATION. DEF SD2 DEF TRLU DEF TINFO DEF D20 NOP TRTRN DLD ABREG RESTORE REGISTERS. JMP TRACE,I RETURN. * TOFST NOP TINFO ASC 7,/QUEX TRACE @ TADDR ASC 3, ASC 2,: A= TAREG ASC 3, ASC 2,, B= TBREG ASC 3 TRLU OCT 0,0 XIF ***** END OF DEBUG ***** END QUEX -+ \x 91750-18155 2013 S C0122 &QUEX1              H0101 lASMB,Q,C HED QUEX: HP 3000 MODEM COMM. MONITOR * (C) HEWLETT-PACKARD CO. NAM QUEX,19,4 91750-16155 REV.2013 800423 MEF: 3000 MODEM LINK SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * Z OPTION INCLUDES DEBUG. * EXT RNRQ,EXEC,XLUEX,$OPSY,.MVW,DTACH,IFBRK EXT #LU3K,#LDEF,#QXCL,#CL3K,#CLRN EXT D$XS5,D$LID,D$RID EXT D$MXR,D$RQB,D$3BF,D$BSZ SPC 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: QUEX *SOURCE: 91750-18155 * RELOC: 91750-16155 * PGMR: DMT LST *********************** QUEX - MODEM VERSION ********************* * * * SOURCE: 91750-18155 * * * * BINARY: 91750-16155 * * * * DMT * * * * MAY 2, 1979 * * * ****************************************************************** SPC 1 * * QUEX PERFORMS MODEM COMMUNICATION WITH A REMOTE HP3000 COMPUTER. * ALL MASTER REQUESTORS AND SLAVE MONITORS WISHING TO TRANSMIT * TO AN HP3000 DO SO BY WRITING THEIR BUFFERS TO THE * QUEX I/O CLASS. QUEX HANGS ON A CLASS GET CALL * AND THEN BLOCKS AS MANY REQUESTS/REPLIES AS WILL FIT INTO THE * SEND BUFFER. A WRITE CALL TSO THE PSI BSC DRIVER AND CARD * TRANSMITS THE SEND BUFFER. REPLY BUFFERS ARE READ BY PROGRAM QUEZ. SPC 1 SUP A EQU 0 B EQU 1 SKP QUEX LDA $OPSY CHECK FOR OPERATING RAR,SLA SYSTEM TYPE. RSS RSS IF MAPPED SYSTEM, JMP INITL LDA RSS CONFIGURE CROSS-MAP STA MODI2 LOAD * JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * LDA D$XS5 CHECK FOR AND D2 HSI LINK. SZA,RSS 0 = HSI, 2 = MODEM JMP WRDVR ERROR--WRONG QUEX. SPC 1 * * FIRST ENTRY INTO QUEX (SCHEDULED BY UPLIN): * INITIALIZE THE HP3000 COMMUNICATION LINK. * INITL LDA #QXCL SAVE QUEX CLASS NUMBER. IOR BIT15 MAKE SURE "DOWN" BIT STA #QXCL IS SET IN SSGA. ELA,CLE,ERA CLEAR "DISCONNECT" BIT. STA QXCLS IOR B140K ADD NO-WAIT & BUFFER-SAVE BITS. STA QCLAS * * CONFIGURE THE CONTROL WORDS. LDA #LU3K GET 3000 WRITE LU NUMBER. STA DISWD STORE IN STA CNCWD XLUEX STA WRTWD WORDS. STA DEFWD STA PRMWD * IOR LB4 CONFIGURE "PRIMARY STA CNPWD CONNECT" WORD LDA #LU3K AND "SECONDARY IOR LB5 CONNECT" WORD. STA CNSWD SPC 3 * * READY TO RESTART FOR A FRESH START. DISCONNECT LINE, SET DEFAULTS * ON BOARD, THEN TRY TO CONNECT (FIRST AS PRIMARY, THEN AS SECONDARY). * INIT JSB CLNUP CLEAN OUT PREVIOUS ACTIVITY. LDA !DISC STA CLTYP JSB XLUEX PERFORM LINE DISCONNECT. DEF *+3 DEF D3 DEF DISWD JSB CKDVR CHECK FOR ERROR. * * SET UP "DEFAULT PARAMETER" BUFFER. * LDA MINLN STA DEFLN DEFAULT BUFFER. SPC 2 LDA D$MXR SET BLOCK STA BLKSZ SIZE. * LDA @ID INITIALIZE STA IDPNT ID POINTER. LDA D$LID GET LOCAL LDB A,I  ID SEQUENCE. SZB,RSS IF CHAR COUNT IS ZERO, JMP RMID GO DO REMOTE ID. * STB IDPNT,I SAVE LENGTH ISZ IDPNT IN BUFFER. ISZ DEFLN INB CHANGE BYTE COUNT CLE,ERB TO WORD COUNT. STB TEMP ADB DEFLN ADD TO BUFFER LENGTH. STB DEFLN INA SOURCE. LDB IDPNT DESTINATION. MVW TEMP MOVE LOCAL ID. STB IDPNT UPDATE POINTER. * RMID LDB D$RID GET REMOTE INB ID SEQUENCE. LDA B,I SZA,RSS IF CHAR COUNT IS ZERO, JMP S2BRD ALL DONE WITH IDS. * IOR B20 SET ID NUMBER/ STA IDPNT,I LENGTH WORD. ISZ IDPNT ISZ DEFLN XOR B20 INA CHANGE BYTE COUNT CLE,ERA TO WORD COUNT. STA TEMP ADA DEFLN ADD TO BUFFER LENGTH. STA DEFLN INB LDA B SOURCE. LDB IDPNT DESTINATION. MVW TEMP MOVE REMOTE ID. * * * SEND DEFAULT PARAMETERS TO BOARD. * S2BRD LDA !INTL STA CLTYP JSB XLUEX INITIALIZE BOARD. DEF *+6 DEF D2 DEF DEFWD DEF DEFBF DEF DEFLN DEF D1 JSB CKDVR CHECK FOR ERROR. * JSB EXEC WRITE MESSAGE: DEF *+5 >> HP 3000 LINK READY DEF D2 FOR DIALING DEF D1 DEF DLMSG DEF D17 * LDA !GTPR STA CLTYP JSB XLUEX GET PARAMETERS. DEF *+6 DEF D1 DEF PRMWD DEF PRAMS DEF D7 DEF D1 JSB CKDVR * LDA PRAMS+6 GET THE PARAMETER ALF,ALF WHICH INDICATES BUFFER CLE,ERA SIZE. CONVERT TO WORDS. STA D$BSZ STORE IN SSGA. * JSB STBFL STORE BUFFER SIZE. * LDA !PCNT STA CLTYP JSB XLUEX CONNECT AS PRIMARY. DEF *+4 DEF D3 DEF CNCWD DEF CNPWD JSB CKDVR CHECK FOR ERROR. * SPC 3 * * TRY TO CONNECT AS PRIMARY. WRITE DS/3000 INITIALIZATION REQUEST. * LDA STRTM ADDR OF INIT. REQUEST. JSB TOBUF SET UP BUFFER FOR TRANSMISSION. * SNDIN JSB XLUEX WRITE THE DEF *+5 INITIALIZATION DEF D2 REQUEST. DEF WRTWD DEF D$3BF DEF WRTLN RAR SLA,RSS IF NO ERROR, JMP QZON SCHEDULE QUEZ AND GET BLOCK. * AND B170 ISOLATE STATUS. CPA B100 IF BOARD INDICATED TIMEOUT, JMP PRTMO CONNECT AS SECONDARY. * * USER MAY WANT TO IMMEDIATELY WAIT FOR INCOMING CALL. * JSB IFBRK CHECK RTE DEF *+1 BREAK FLAG. SZA IF SET, JMP PRTMO GO TO SECONDARY. * CCA OTHERWISE, GO TO JSB SLEEP SLEEP FOR FIVE SECONDS. JMP SNDIN TRY TO CONNECT AGAIN. SPC 2 * SUBROUTINE TO PUT BUFFER SIZE IN INITIALIZATION STBFL NOP ENTRY. LDA D$BSZ CLB STORE BUFFER SIZE DIV D16 (DIVIDED BY 16, ADA N1 MINUS 1) STA B STA INTRP+4 ALF,ALF IOR B AND CURRENT SIZE. STA STRTM+4 JMP STBFL,I RETURN. SPC 2 * SUBROUTINE TO SET UP BUFFER FOR SEND. TOBUF NOP LDB D$RQB ADDR OF SEND BUFFER. STB BPNTR JSB .MVW MOVE REQUEST TO "SEND" DEF D8 NOP * LDA D8 SET BLOCK LENGTH STA LOG TO EIGHT. CLA GO TO VERIF IN CASE JSB VERIF TRACE WAS SPECIFIED. NOP IGNORE ERROR. **SHOULDN'T HAPPEN** * LDA D8 SET WRITE LENGTH TO 8 WORDS. STA WRTLN * JMP TOBUF,I RETURN. SPC 2 * * WE HAVE TIMED OUT AS PRIMARY STATION. TRY TO CONNECT AS SECONDARY. * PRTMO JSB EXEC PRINT TIMEOUT MESSAGE. DEF *+5 DEF D2 DEF D1 `DEF TOMSG DEF D26 * LDA !DISC STA CLTYP JSB XLUEX DISCONNECT LINE. DEF *+3 DEF D3 DEF DISWD JSB CKDVR CHECK FOR ERROR. * LDA !SCNT STA CLTYP JSB XLUEX CONNECT AS SECONDARY. DEF *+4 DEF D3 DEF CNCWD DEF CNSWD JSB CKDVR CHECK FOR ERROR. * QZON JSB EXEC MAKE SURE DEF *+3 QUEZ IS DEF D10 SCHEDULED. DEF QUEZ * * QUEZ WILL GET INITIALIZATION REQUEST AND PASS IT TO US. * SKP * * WAIT FOR SOMETHING TO SEND TO THE HP 3000 BY HANGING ON * A CLASS I/O GET WITH WAIT TO QUEX'S I/O CLASS. * BLOCK AS MANY REQUESTS/REPLIES FROM QUEX'S I/O CLASS * BUFFER AS WILL FIT IN THE TRANSMIT BUFFER. * NEWGT CLA INITIALIZE LENGTH (BYTES) STA WRTLN OF TRANSMIT BUFFER. LDA D$RQB INITIALIZE BUFFER POINTER TO STA BPNTR START OF SEND AREA. * GET JSB EXEC CLASS I/O GET TO LOOK FOR DEF *+6 MASTER REQUESTS FROM RTE USERS. DEF CLS21 NO ABORT. DEF QXCLS QUEX I/O CLASS. BPNTR NOP DEF D$MXR BUFFER LENGTH. DEF LOG RETURNED BLOCK LENGTH (WORDS). NOP IGNORE ERROR RETURN. * * THE CLASS GET HAS COMPLETED. RTE IS SENDING A MASTER REQUEST OR A * SLAVE REPLY, OR QUEZ MIGHT BE PASSING ALONG A SPECIAL REQUEST. * LDA TRMRQ LOAD TERMINATION ADDRESS. LDB LOG CHECK FOR QUEZ'S SZB,RSS "LAST BYE" SIGNAL. JMP DOBUF GOT IT. SEND TERMINATION REQUEST. * CPB D1 1-WORD MESSAGE INDICATES JMP RDERR QUEZ REPORTED READ ERROR. * LDA BPNTR,I GET FIRST WORD AND AND B377 ISOLATE DS/3000 CLASS. SZA,RSS IF ZERO, JMP MZERO GO TO SPECIAL HANDLER. * * ADD BLOCK TO TRANSMIT BUFFER, THEN ADVANCE POINTER. * LDA SGNOF INIT. REQ. EXCHANGED YET? SZA JMP NULGT NO. IG NORE. **SHOULDN'T HAPPEN** ADDBU CLA MESSAGE IS FROM 1000. JSB VERIF CHECK VALIDITY. JMP NULGT INVALID: IGNORE. * LDA BUFL ADD LEN OF BLOCK ADA WRTLN TO TOTAL TRANSMIT STA WRTLN LENGTH. * LDA BPNTR ADVANCE BUFFER POINTER. ADA BUFL STA BPNTR * LDA BUFL SUBTRACT THE LENGTH CMA,INA OF PROCESSED BUFFERS ADA LOG FROM BLOCK LENGTH. STA LOG SAVE REMAINING LENGTH. SZA IF ANOTHER BUFFER, JMP ADDBU GO ADD IT. * * ISSUE A NULL GET CALL TO QUEX'S I/O CLASS TO SEE * IF THERE IS ANOTHER PENDING REQUEST AND TO SEE WHETHER * THERE IS ROOM IN THE TRANSMIT BUFFER. ISSUE THE GET * WITHOUT WAIT, SAVE CLASS BUFFER, AND BUF LEN = 0. * NULGT JSB EXEC CLASS GET (DUMMY). DEF *+6 DEF CLS21 NO ABORT. DEF QCLAS QUEX I/O CLASS. DEF D0 DUMMY BUFFER. DEF D0 ZERO LENGTH BUFFER. DEF LOG RETURNED BLOCK LENGTH (WORDS). NOP IGNORE ERROR RETURN. * SSA WAS THERE ANYTHING THERE? JMP REMIO NO. GO SEND WHAT WE HAVE. * * A REQUEST IS IN THE CLASS BUFFER. SEE IF THERE * IS ROOM TO BLOCK IT INTO THE TRANSMIT BUFFER. * LDA D$BSZ CMA,INA CALCULATE NEG. NUMBER ADA WRTLN OF WORDS LEFT. ADA LOG ADD LENGTH OF BLOCK (WORDS). SSA JMP GET FITS. GO READ IT. * * IF THERE WAS NO ROOM FOR THE LAST BLOCK, IT IS STILL IN * THE CLASS BUFFER AND WILL BE PICKED UP NEXT TIME AROUND. * * SEND THE BLOCKS TO THE HP 3000. * REMIO LDA !WRIT STA CLTYP JSB XLUEX DEF *+5 DEF D2 DEF WRTWD DEF D$3BF DEF WRTLN JSB CKDVR CHECK FOR ERROR. * JMP QZON GET NEXT BLOCK. SKP * * CLASS 0 REQUEST OR REPLY RECEIVED FROM 3000. * MZERO CLA,INA MESSAGE FROM 3000. JSB VERIF VERIFY IT'S GOOD. JMP BADRT BAD--IGNORE. * LDA STMWD ISOLATE REPLY & AND B140K REJECT BITS. CPA B140K BOTH SET? JMP BADRT YES--IGNORE. SZA IF EITHER IS SET, JMP REPL0 IT'S A REPLY. SPC 1 * * REQUEST RECEIVED ON CLASS 0. * CLASS 0, STREAM 20: INITIALIZATION * CLASS 0, STREAM 21: TERMINATION * LDA STREM STREAM = CPA B20 OCTAL 20? JMP INOK YES. ACCEPT INITIALIZATION. CPA B21 STREAM = RSS OCTAL 21? JMP REJCT NO--UNKNOWN. REJECT. **SHOULDN'T HAPPEN** * * HP 3000 REQUESTS TERMINATION ONLY WHEN IT THINKS NEITHER * SIDE HAS ANYTHING GOING. MAKE SURE PNL IS EMPTY. * CCB GET ADDRESS OF ADB #LDEF PNL HEADER ADDR. LDB B,I GET ADDR OF LDB B,I PNL HEADER. JSB CKLST IF ANYONE IS IN LIST, RSS JMP REJCT REJECT. **SHOULDN'T HAPPEN** LDB #LDEF GET ADDRESS INB OF FIRST LDB B,I MASTER LDB B,I REQUEST. JSB CKLST IF ANYONE IS IN LIST, RSS JMP REJCT REJECT. **SHOULDN'T HAPPEN** JMP INIT GO CLEAR THE LINE. * * * ACCEPT 3000'S INITIALIZATION. * INOK JSB GTBSZ GET 3000 BUFFER SIZE. STA TEMP SAVE. CMA,INA SUBTRACT FROM ADA D$BSZ 1000 BUFFER SIZE. CMA,SSA,RSS IF 3000 SIZE IS SMALLER, JMP UPOK LDA TEMP SET 1000 SIZE TO STA D$BSZ 3000 SIZE. JSB STBFL STORE IN INITIALIZATION BUF. UPOK JSB UP LET WORLD KNOW WE ARE UP. LDA INTRP SEND INITIALIZATION DOBUF JSB TOBUF REPLY. JMP REMIO SPC 4 * * SUBROUTINE TO CHECK IF A TCB LIST HAS ANY HP3000 ENTRIES. * CALLING SEQUENCE: LDB * JSB CKLST * * S * CKLST NOP CKLOP SZB,RSS END OF LIST? JMP CKLST,I YES--TAKE NO-ENTRY RETURN. JSB LODWD STA TEMP SAVE LINK. INB GET SECOND JSB LODWD TCB WORD. LDB TEMP SET UP POINTER FOR NEXT LOOP. AND BIT14 ISOLATE "3000" BIT. SZA,RSS IF NOT SET, JMP CKLOP STAY IN LOOP. * ISZ CKLST ENTRY FOUND! JMP CKLST,I TAKE 2ND RETURN. * SPC 1 * * REPLY RECEIVED ON CLASS 0. * REPL0 LDB STMWD GET STREAM WORD RBL AND POSITION REJECT BIT. LDA STREM IF STREAM = CPA B20 OCTAL 20, JMP INIRP IT'S AN INITIALIZATION REPLY. CPA B21 IF STREAM NOT = RSS OCTAL 21, JMP REJCT UNKNOWN. REJECT. **SHOULDN'T HAPPEN** * * HP 3000 IS REPLYING TO OUR TERMINATION REQUEST. * SSB REJECT BIT SET? JMP NEWGT YES--DON'T DISCONNECT. JMP INIT NO--GO AHEAD AND CLEAR LINE. * * HP 3000 IS REPLYING TO OUR INITIALIZATION REQUEST. * INIRP SSB REJECT BIT SET? JMP INIT YES--RETRY. JSB GTBSZ SET 1000 BLOCK SIZE. STA D$BSZ JSB UP NO--LET WORLD KNOW WE ARE UP. * JMP NEWGT PROCESS NEXT BLOCK. * UPMSG ASC 11,>> HP 3000 LINK * UP * SPC 3 * * SUBROUTINE TO GET BLOCK SIZE FROM INITIALIZATION REQUEST/REPLY. * GTBSZ NOP ENTRY. LDA BPNTR ISOLATE RIGHT ADA D3 HALF OF LDA A,I WORD 4 IN AND B377 BUFFER. INA INCREMENT AND MULTIPLY MPY D16 BY 16 TO GET BUFFER SIZE. JMP GTBSZ,I RETURN. SPC 2 * * SUBROUTINE TO ESTABLISH CONNECT STATUS AND REPORT ON SYSTEM CONSOLE. * UP NOP ENTRY. CLA CLEAR SIGN-OFF FLAG. STA SGNOF LDA #QXCL CLEAR DISCONNECT FLAG ELA,CLE,ERA  IN #QXCL TO INTICATE STA #QXCL CONNECT STATUS. * JSB EXEC DISPLAY "UP" MESSAGE ON LU 1. DEF *+5 DEF D2 DEF D1 DEF UPMSG DEF D11 * JMP UP,I RETURN. SKP * * SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. * REJCT LDA STMWD MAKE SURE AND BIT14 WE AREN'T SZA REJECTING JMP NEWGT A REJECT! LDA BPNTR,I APPENDAGE AND B377 LENGTH IOR LB8 IS 8. STA BPNTR,I LDA STMWD SET REJECT BIT. IOR BIT14 AND NBT13 CLEAR CONTINUATION BIT. LDB BPNTR ADB D2 STA B,I ADB D2 REVERSE PROCESS NUMBERS. LDA B,I ALF,ALF STA B,I ADB D3 DATA LENGTH = 0. CLA STA B,I * LDA QXCLS IOR BIT15 SET NO-WAIT BIT. STA CLASN SAVE I/O CLASS #. * LDA !WRIT STA CLTYP JSB XLUEX WRITE DEF *+5 TO DEF D2 DRIVER. DEF WRTWD DEF BPNTR,I DEF D8 JSB CKDVR CHECK FOR ERROR. * BADRT LDA WRTLN IF SOMETHING SZA IS IN BUFFER, JMP NULGT GO TO NULL GET. JMP NEWGT OTHERWISE, DO NEW GET. * LB4 BYT 4,0 LEFT BYTE 4 LB5 BYT 5,0 LEFT BYTE 5 LB8 BYT 10,0 LEFT BYTE 8. SKP * * SUBROUTINE TO VERIFY AUTHENTICITY OF REQUESTS AND REPLIES * BEING SENT OR RECEIVED. ALSO SETS , , , * AND AND PERFORMS TRACE (IF REQUESTED). * * ON ENTRY, (A) = 0 IF OUTGOING REQ/REPLY, * = 1 IF INCOMING REQ/REPLY. * BPNTR = BUFFER ADDRESS OF REQ/REPLY. * VERIF NOP STA TEMP SAVE DIRECTION CODE. LDB BPNTR LOAD ADDRESS OF MESSAGE. * LDA B,I CHECK WORD 1: SZA,RSS JMP BADBF ERROR IF ZERO. AND B377 ISOLATE MESSAGE CLASS. STA CLASS uSAVE IT. ADA N9 SSA,RSS JMP BADBF ERROR IF MESSAGE CLASS > 8. * ADB D2 CHECK WORD 3: LDA B,I STA STMWD SAVE IT. AND B377 ISOLATE STREAM TYPE. STA STREM SAVE IT. ADA NB20 SSA JMP BADBF ERROR IF < OCTAL 20. ADA NB10 SSA,RSS JMP BADBF ERROR IF > OCTAL 27. * ADB D5 CHECK WORD 8: LDA B,I SSA JMP BADBF ERROR IF NEGATIVE. * LDB BPNTR VERIFY THAT ADB D7 WDCNT <= N(WORDS) + 8. LDB B,I INB CLE,ERB ADB D8 STB BUFL SAVE WORD COUNT. INB CMB,INB LDA BPNTR,I ALF,ALF AND B377 ADA B SSA,RSS JMP BADBF ERROR. ISZ VERIF NO ERROR, TAKE NORMAL RETURN. * LDA TEMP IF INCOMING REQ/REPLY, SZA QUEZ HAS ALREADY JMP VERIF,I TRACED IT. * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. * LDA #CL3K+1 BUFFERS TO BE TRACED? SSA,RSS IF BIT 15 NOT SET, JMP VERIF,I RETURN. * LDA D8 INITIALIZE TRACE STA TRLEN LENGTH TO 8. * LDA #CL3K+1 APPENDAGE BIT SET? AND BIT14 SZA,RSS JMP WRTRC NO. GO WRITE. * LDA BPNTR,I GET LENGTH OF ALF,ALF APPENDAGE AND AND B377 HEADER FROM STA TRLEN WORD 1. * LDA #CL3K+1 GET MAX DATA LENGTH AND LENBT FROM BITS 0-12. ADA TRLEN ADD HEADER/APPEND LENGTH. STA B HOLD IN B-REG. CMA,INA IF GREATER THAN ACTUAL ADA BUFL BUFFER LENGTH, SSA LDB BUFL USE BUFFER LENGTH. STB TRLEN STORE TRACE LENGTH. * WRTRC CCA ADA BPNTR SET TRACE STA TPNTR POINTER. :LDB TPNTR,I SET FIRST WORD STB HOLD TO INDICATE LDB TEMP DIRECTION. STB TPNTR,I ISZ TRLEN ADD 1 TO LENGTH. JSB TRCOT WRITE TRACE. LDA HOLD RESTORE FIRST STA TPNTR,I BUFFER WORD. JMP VERIF,I RETURN. * BADBF LDB TEMP CHECK DIRECTION FLAG. SZB,RSS JMP VERIF,I INCOMING--QUEZ ALREADY REPORTED IT. * LDA LOG SET BUFFER LENGTH STA BUFL TO REMAINING BLOCK STA TRLEN LENGTH & SET TRACE LEN. * JSB EXEC DISPLAY DEF *+5 ">> HP 3000: BAD BUFFER OUTGOING". DEF D2 DEF D1 DEF BDBUF DEF D16 * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. JMP WRTRC YES. SPC 1 * VALUES SET BY VERIF: CLASS NOP DS/3000 MESSAGE CLASS. STMWD NOP DS/3000 STREAM WORD. STREM NOP DS/3000 MESSAGE STREAM. BUFL NOP WORD COUNT OF BUFFER. HOLD NOP SPC 5 * * SUBROUTINE TO WRITE A RECORD TO TRACE LU. * CALLING SEQUENCE: * JSB TRCOT * TRCOT NOP ENTRY POINT. * LDA #CL3K CHECK STA TRCST BIT STA TRCIO 13 OF AND BIT13 LOG WORD. SZA JMP CLIO SET--DO CLASS I/O. * JSB XLUEX CHECK OUT DEF *+3 DYNAMIC DEF SD3 STATUS. DEF TRCST JMP WRERR ERROR RETURN. AND B277 IF ANY "BAD" BITS SZA ARE SET, JMP TRCDN SET TRACE DOWN. * JSB XLUEX WRITE ENTIRE DEF *+5 MESSAGE TO DEF SD2 TRACING LU. DEF TRCIO DEF TPNTR,I DEF TRLEN RSS ERROR RETURN. JMP TRCOT,I NO ERROR. RETURN. * WRERR DST ABREG PRINT JSB EXEC ERROR DEF *+5 ɐ MESSAGE. DEF SD2 DEF D1 DEF IOERR DEF D13 NOP * TRCDN LDA #CL3K SET "BAD" BIT IOR BIT15 IN TRACE LU. STA #CL3K JMP TRCOT,I RETURN. * CLIO LDA #CL3K SET NO-WAIT BIT IOR BIT15 IN CLASS NUMBER. STA CLASN JSB EXEC WRITE TO I/O CLASS. DEF *+8 DEF CLS20 DEF D0 DEF TPNTR,I DEF TRLEN DEF TRLEN DEF D0 DEF CLASN JMP WRERR (ERROR RETURN.) SZA,RSS CHECK FOR NO S.A.M. JMP TRCOT,I NO ERROR...RETURN. DLD "SAM" REPORT SAM ERROR. JMP WRERR * "SAM" ASC 2,SAM IOERR ASC 11,/QUEX: TRACING ERROR ABREG BSS 2 TRLEN NOP TRACE OUTPUT LENGTH. TPNTR NOP TRACE OUTPUT POINTER. TRCIO OCT 0,100 TRACE LU/BINARY BIT TRCST OCT 0,600 TRACE LU/STATUS FUNCTION SD3 DEF 3,I B277 OCT 277 SPC 4 * * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I GET WORD FROM TCB (RSS IF DMS SYSTEM). JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I RETURN. SKP * * SUBROUTINE TO CLEAN UP FOR FRESH START: * TELL UPLIN TO TIMEOUT ALL MASTER REQUESTS TO 3000 AND ZERO PNL LIST. * NEW REQUESTS ARE BLOCKED SINCE HP 3000 IS IN "DISCONNECT" STATUS. * CLNUP NOP CLA,INA SET SIGN OFF FLAG. STA SGNOF LDA #QXCL SET DISCONNECT FLAG IN #QXCL IOR BIT15 TO INDICATE DISCONNECT STATUS. STA #QXCL * JSB EXEC TERMINATE DEF *+4 QUEZ. DEF SD6 DEF QUEZ DEF D3 NOP (ERR RETRN IF QUEZ ALREADY DORMNT) * * LOCK "QUEX ABORT" RN (GLOBALLY) SO UPLIN WILL CLEAN UP. * JSB RNRQ DEF *+4 DEF GLOCK DEF #CLRN DEF TEMP NOP ERROR RETURN. * LDA QXCLS QUEX CLASS # /NO DE-ALLOC (BIT13). IOR BIT15 SET NO-WAIT BIT (#15). STA CLASN RELEASE BUFFER. * FLUSH JSB EXEC FLUSH QUEX'S I/O CLASS. DEF *+5 DEF CLS21 DEF CLASN DEF D0 DEF D0 RSS IGNORE ERRORS. * SSA,RSS ANYTHING THERE? JMP FLUSH YES. KEEP FLUSHING. * * HANG ON "QUEX ABORT" RN UNTIL UPLIN FINISHES CLEANUP. JSB RNRQ DEF *+4 DEF LKCLR DEF #CLRN DEF TEMP NOP ERROR RETURN. * JMP CLNUP,I RETURN TO CALLER. SPC 2 GLOCK OCT 40002 LKCLR OCT 40006 SD2 DEF 2,I SD6 DEF 6,I SPC 5 * * WRONG DRIVER FOR THIS QUEX. REPORT THE ERROR. * WRDVR JSB EXEC REPORT ERROR DEF *+5 ON SYS CONSOLE. DEF D2 DEF D1 DEF WRMSG DEF D13 * JSB EXEC SUSPEND. DEF *+2 DEF D7 * JMP WRDVR STAY IN LOOP IN CASE OF "GO". * WRMSG ASC 13,>> QUEX EXPECTS MODEM LINK SPC 3 * * READ ERROR REPORTED BY QUEZ. * RDERR LDA !READ SET I/O OPERATION STA CLTYP INDICATOR TO READ. LDA BPNTR,I LOAD STATUS. JSB CKDVR REPORT ERROR. JMP INIT (SHOULDN'T RETURN!) SPC 3 * * SUBROUTINE TO CHECK FOR DRIVER ERRORS. * CKDVR NOP ENTRY. RAR SLA,RSS IF NO ERROR, JMP CKDVR,I RETURN. AND B170 ISOLATE STATUS. LDB @DERR JSB SERCH GET ERROR DESCRIPTION. LDB @STAT MOVE TO JSB .MVW OUTPUT DEF D7 AREA. NOP LDB @DCLL LDA CLTYP GET CALL TYPE JSB SERCH DESCRIPTION. LDB @CALL MOVE TO JSB .MVW OUTPUT DEF D7 AREA. NOP JSB EXEC PRINT DEF *+5 "DOWN" DEF D2 MESSAGE. DEF D1 DEF STMSG DEF D30 * JSB CLNUP CLEAN UP. * LDA NB20 JSB SLEEP 7 WAIT 80 SECONDS. * JMP INIT CLOSE LINE. SPC 2 * SUBROUTINE USED BY CKDVR TO FIND ENTRY IN TABLE. SERCH NOP ENTRY STA TEMP SAVE VALUE. * SLOOP LDA B,I GET TABLE VALUE. SZA IF ZERO (EOT) CPA TEMP OR EQUAL TO VALUE, JMP FOUND WE'VE FOUND IT. ADB D8 OTHERWISE BUMP POINTER JMP SLOOP AND STAY IN LOOP. * FOUND LDA B POINT TO ADDRESS INA OF ASCII MESSAGE. JMP SERCH,I RETURN. SPC 2 * * SUBROUTINE TO GO DORMANT (UPLIN WILL RESTART). * SLEEP NOP ENTRY STA TEMP SAVE COUNTER. * CYCLE JSB EXEC TERMINATE, DEF *+4 SAVING DEF D6 RESOURCES. DEF D0 DEF D1 * ISZ TEMP IF MORE IN COUNTER, JMP CYCLE STAY IN LOOP. * JMP SLEEP,I RETURN. SPC 2 * STMSG BYT 15,12 , ASC 11,>> HP 3000 LINK *DOWN* BYT 15,12 , EMSG ASC 16,>> ************* @ ************* BYT 15,12 , @STAT DEF EMSG+1 @CALL DEF EMSG+9 BDBUF ASC 16,>> HP 3000: BAD BUFFER RECEIVED SKP * * CONSTANTS AND WORKING STORAGE. * * NB10 OCT -10 NB20 OCT -20 B170 OCT 170 B377 OCT 377 B140K OCT 140000 BIT15 OCT 100000 BIT14 OCT 40000 BIT13 OCT 20000 NBT13 OCT 157777 LENBT OCT 17777 BITS 0-12 CLS20 DEF 20,I CLS21 DEF 21,I D7 DEC 7 D8 DEC 8 D10 DEC 10 D11 DEC 11 D13 DEC 13 D26 DEC 26 D30 DEC 30 N1 DEC -1 N9 DEC -9 QXCLS NOP QUEX CLASS NUMBER. QCLAS NOP (WITH NO-WAIT & SAVE-BUFFER BITS SET.) LOG NOP WORDS TO PROCESS IN CURRENT BUFFER SGNOF OCT 0 QUEZ ASC 3,QUEZ * * TABLE OF CONTROL WORDS. DISWD OCT 0,3100 DISCONNECT CNCWD OCT 0,3000 CONNECT WRTWD OCT 0,1100 WRITE DS2 MESSAGE DEFWD OCT 0,3700 SET DEFAULTS PRMWD OCT 0,3600 GET PARAMETERS * CNPWD NOP CNSWD NOP * P CLASN NOP WRTLN NOP TEMP NOP PRAMS BSS 7 * STRTM DEF *+1 BYT 10,0 INITIALIZATION REQUEST. DEC 0 B20 OCT 20 OCT 0,0,0,0,0 D16 EQU B20 * INTRP DEF *+1 BYT 10,0 DEC 0 INITIALIZATION REPLY. OCT 100020 OCT 0,0,0,0,0 * TRMRQ DEF *+1 BYT 10,0 TERMINATION REQUEST. DEC 0 B21 OCT 21 OCT 0,0,0,0,0 D17 EQU B21 SPC 2 * BSC BOARD DEFAULT BUFFER DEFBF BYT 377,2 BLKSZ NOP DATA BLOCK SIZE D0 DEC 0 INTERMEDIATE BLOCK SIZE DEC 0 HEADER BLOCK SIZE BYT 10,377 MAX TRY COUNT/CONNECT TIMERS IDSEQ BSS 129 ROOM FOR ID SEQUENCES * DEFLN NOP LENGTH OF DEFAULT BUFFER MINLN ABS IDSEQ-DEFBF MINIMUL LENGTH OF BUFFER. @ID DEF IDSEQ IDPNT NOP POINTER INTO BUFFER. SPC 2 *** TABLES FOR ERROR MESSAGES *** * CLTYP NOP @DCLL DEF *+1 !DISC DEC 1 D1 EQU !DISC ASC 7, DISCONNECT !PCNT DEC 2 D2 EQU !PCNT ASC 7, PRIMARY CONCT !SCNT DEC 3 D3 EQU !SCNT ASC 7, SECNDRY CONCT !INTL DEC 4 ASC 7, INITIALIZE !READ DEC 5 D5 EQU !READ ASC 7, READ !GTPR DEC 6 D6 EQU !GTPR ASC 7, GET PARAMS !WRIT DEC 0 ASC 7, WRITE * @DERR DEF *+1 OCT 10 ASC 7, LINE FAILURE OCT 20 ASC 7, TIMEOUT OCT 40 ASC 7, OVERRUN OCT 50 ASC 7, REMOTE BUSY B100 OCT 100 ASC 7, UNINITIALIZED OCT 110 ASC 7, WRONG TYPE OCT 130 ASC 7, CARD FAILURE OCT 0 ASC 7, ILLEGAL REQST SPC 1 DLMSG ASC 17,>> HP 3000 LINK READY FOR DIALING TOMSG ASC 26,>> HP 3000 LINK DIALING TIMEOUT. NOW AWAITING CALL. * BSS 0 *** SIZE OF QUEX **** * SKP IFZ *** DEBUG OPTION *** ***** SPECIAL DEBUG SECTION: TRACE * INSERT A "JSB TRACE" IN PROGRAM. QUEX WILL PRINT CALL LOCATION * AND CONTENTS OF A- & B-REGISTER`^ZS ON LU SPECIFIED IN #CL3K+6. * EXT CNUMO TRACE NOP ENTRY DST ABREG STORE REGISTERS LDA #CL3K+6 SZA,RSS IF TRACE LU ISN'T SPECIFIED, JMP TRTRN RETURN FROM TRACE. * STA TRLU SAVE LU NUMBER. * LDB 1727B GET POINTER TO STARTING ADDR FROM BASE PG. JSB LODWD GET STARTING ADDR FROM ID SEG. CMA,INA NEGATE. ADA TRACE ADD CALLING ADDRESS STA TOFST TO GET OFFSET. * JSB CNUMO CONVERT DEF *+3 ADDRESS OFFSET DEF TOFST TO DEF TADDR OCTAL. * JSB CNUMO CONVERT DEF *+3 A-REG DEF ABREG TO DEF TAREG OCTAL. * JSB CNUMO CONVERT DEF *+3 B-REG DEF ABREG+1 TO DEF TBREG OCTAL. * JSB XLUEX PRINT DEF *+5 INFORMATION. DEF SD2 DEF TRLU DEF TINFO DEF D20 NOP TRTRN DLD ABREG RESTORE REGISTERS. JMP TRACE,I RETURN. * D20 DEC 20 TOFST NOP TINFO ASC 7,/QUEX TRACE @ TADDR ASC 3, ASC 2,: A= TAREG ASC 3, ASC 2,, B= TBREG ASC 3 TRLU OCT 0,0 TRACE LU. XIF ***** END OF DEBUG ***** END QUEX {` ]r 91750-18156 2013 S C0122 &QUEZ              H0101 [ASMB,Q,C HED 3000 SLAVE REQ. WATCHDOG * (C) HEWLETT-PACKARD CO. NAM QUEZ,17,2 91750-16156 REV.2013 800418 MEF: 3000 HSI LINK SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 EXT EXEC,XLUEX,RNRQ,#LU3K,#QXCL,#QZRN,D$XS5 SUP SPC 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: QUEZ *SOURCE: 91750-18156 * RELOC: 91750-16156 * PGMR: DMT LST *************** QUEZ FOR HSI LINK ************** * * * SOURCE: 91750-18156 * * * * BINARY: 91750-16156 * * * * PRGMR: JIM HARTSELL * * * * DATE: FEBRUARY 17, 1976 * * * *----------------------------------------------* * * * MODIFIED BY DMT IN JUNE 1979 FOR XLUEX CALL * * * ************************************************ SPC 2 * QUEZ IS A "POLLING PROGRAM" FOR UNSOLICITED LINE BIDS * FROM THE HP3000. WHEN QUEX HAS NOTHING TO DO, QUEZ IS * SCHEDULED TO WAIT FOR THE SLC DRIVER TO RECEIVE AN "ENQ" * FROM THE 3000. QUEZ THEN WRITES A ZERO LENGTH * REQUEST TO QUEX'S I/O CLASS, TO FORCE QUEX TO READ THE BUFFER. * * QUEZ ALSO PERFORMS "LINE OPEN" CALL FOR QUEX SO THAT QUEX * NEED NOT LOCK UP A PARTITION DURING I/O SUSPEND. * QUEZ LDA D$XS5 CHECK FOR AND D2 ( MODEM LINK. SZA 0 = HSI, 2 = MODEM. JMP WRDVR ERROR--MODEM. * LDA #LU3K CONFIGURE XLUEX ARRAY. IOR BIT15 STA LU3K * LDA B,I GET SCHEDULE PARAM. SZA,RSS NORMAL "POLLING" ENTRY? JMP POLL YES. * * LINE OPEN SECTION. QUEX HAS SCHEDULED QUEZ WITH WAIT. * JSB XLUEX ISSUE LINE OPEN REQUEST. DEF *+6 (SETS # RETRIES = 7, DEF D2 LONG TIMEOUT = 60 SEC., DEF LU3K # ID SEQUENCES = 0) DEF D2 GO TO "SEND" STATE. DEF D3 DEF LOPWD (QUEX WILL CHECK FOR ERRORS) * JMP EXIT TERMINATE WHEN CALL COMPLETES. SPC 4 * * WRONG DRIVER FOR THIS QUEZ. REPORT THE ERROR. * WRDVR JSB EXEC REPORT ERROR DEF *+5 ON SYS CONSOLE. DEF D2 DEF D1 DEF WRMSG DEF D12 * JSB EXEC SUSPEND. DEF *+2 DEF D7 * JMP WRDVR STAY IN LOOP IN CASE OF "GO". * WRMSG ASC 12,>> QUEZ EXPECTS HSI LINK SPC 3 B EQU 1 DM1 DEC -1 D1 DEC 1 D2 DEC 2 D3 DEC 3 D6 DEC 6 D7 DEC 7 D12 DEC 12 BIT15 OCT 100000 GLLCK OCT 40002 CLS20 DEF 20,I LOPWD OCT 060200 SPRWD OCT 024500 LU3K OCT 0,0 2-WORD ARRAY FOR XLUEX. TEMP NOP TEMP1 NOP SKP * * SLAVE "POLL" SECTION. * POLL LDA #QZRN STA TEMP1 * JSB XLUEX ISSUE SPECIAL "READ ENQ". DEF *+6 DEF D1 DEF LU3K DEF TEMP1 RESOURCE NUMBER. DEF D0 DEF SPRWD * JSB RNRQ HANG ON ATTEMPT TO LOCK RN. DEF *+4 COMMUNICATION DRIVER WILL UNLOCK DEF GLLCK WHEN AN "ENQ" IS RECEIVED AND QUEZ DEF #QZRN WILL RESUME EXECUTION WITH RN LOCKED. DEF TEMP D0 NOP IGNORE ERROR RETURN. * JSB EXEC CLASS WRITE TO QUEX. DEF *+8 (NO REPLY EXPECTED) DEF CLS20 DEF D0 DEF D0 DUMM Y BUFFER ADDRESS. DEF D0 ZERO-LENGTH RECORD. DEF D0 LENGTH PASSED TO QUEX. DEF D0 DEF #QXCL NOP IGNORE ERRORS. * EXIT JSB EXEC TERMINATE DEF *+4 SERIALLY DEF D6 REUSABLE. DEF D0 DEF DM1 * JMP QUEZ GO TO BEGINNING ON RESCHEDULE. SPC 1 * BSS 0 SIZE OF QUEZ * END QUEZ  ^f 91750-18157 2013 S C0122 &QUEZ1              H0101 lASMB,Q,C HED QUEZ: HP 3000 MODEM COMM. MONITOR * (C) HEWLETT-PACKARD CO. NAM QUEZ,19,4 91750-16157 REV.2013 800423 MEF: 3000 MODEM LINK SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 * Z OPTION INCLUDES DEBUG. * EXT EXEC,XLUEX,$OPSY EXT #LU3K,#QXCL,#CL3K,#RQCV,#RSAX,#LDEF EXT D$MXR,D$RQB,D$3BF,D$XS5 SPC 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: QUEZ *SOURCE: 91750-18157 * RELOC: 91750-16157 * PGMR: DMT LST *********************** QUEZ - MODEM VERSION ********************* * * * SOURCE: 91750-18157 * * * * BINARY: 91750-16157 * * * * DMT * * * * MAY 7, 1979 * * * ****************************************************************** SPC 1 * * QUEZ PERFORMS MODEM COMMUNICATION WITH A REMOTE HP3000 COMPUTER. * QUEZ READS ALL MESSAGES RETURNED FROM THE HP3000 TO THE HP1000, * THEN DISPATCHES THEM TO MASTERS WAITING FOR REPLIES, SLAVE * MONITORS (VIA RQCNV) WHO ARE WAITING FOR REQUESTS, OR QUEX (WHO * MAY BE WAITING FOR SPECIAL REQUESTS AND REPLIES). * ALL MASTER REQUESTORS AND SLAVE MONITORS WISHING TO TRANҾSMIT * TO AN HP3000 DO SO BY WRITING THEIR BUFFERS TO THE * QUEX I/O CLASS. SPC 1 SUP A EQU 0 B EQU 1 SKP QUEZ LDA $OPSY CHECK FOR OPERATING RAR,SLA SYSTEM TYPE. RSS RSS IF MAPPED SYSTEM, JMP INITL LDA RSS CONFIGURE CROSS-MAP STA MODI2 LOAD * LDA D$XS5 CHECK FOR AND D2 HSI LINK. SZA,RSS 0 = HSI, 2 = MODEM JMP WRDVR ERROR--HSI. SPC 2 * * CONFIGURE THE CONTROL WORD TO PERFORM DS2 READ. * INITL LDA #LU3K LOAD THE HP3000 WRITE LU. INA ADD ONE FOR READ LU. STA REDWD STORE IN XLUEX WORD. * LDA #QXCL GET QUEX CLASS NUMBER. ELA,CLE,ERA CLEAR "DISCONNECT" BIT. STA QXCLS SAVE LOCALLY. SPC 1 * * READ FROM HP 3000. * READ JSB XLUEX DEF *+5 DEF D1 DEF REDWD DEF D$3BF DEF D$MXR * STB LOG SAVE NUMBER OF WORDS READ. * * CHECK FOR ERROR IN READ. * STA TEMP SAVE STATUS. RAR SLA,RSS IF NO ERROR, JMP SETPT GO DISPATCH. * JSB EXEC WRITE STATUS WORD TO DEF *+8 QUEX SO IT WILL PRINT DEF CLS20 A MESSAGE ON THE SYSTEM DEF D0 CONSOLE. DEF TEMP DEF D1 DEF D1 DEF D0 DEF #QXCL D0 NOP * JSB EXEC ABORT! DEF *+2 DEF D6 SPC 3 * REQUESTS AND/OR REPLIES HAVE BEEN RECEIVED FROM THE HP 3000. * FOR REQUESTS, DO A CLASS WRITE TO THE REQUEST CONVERTER (RQCNV). * FOR REPLIES, SEARCH THE MASTER LIST (VIA SEQUENCE #) AND DO A CLASS * WRITE TO THE CORRESPONDING MASTER CLASS NUMBER. * SETPT LDA D$RQB SET BPNTR TO POINT TO STA BPNTR FIRST WORD IN BUFFER. LDA LOG GET READ LENGTH. SPC 1 * * PROCESS THE NEXT BLOCK IN READ BUFFER. * DISP SZA,RSS IS THERE ANOTHER BLOCK? `JMP READ NO. SERVICING COMPLETE. * ADA N7 IF LESS THAN 8 WORDS, SSA JMP READ IGNORE REST OF BLOCK. **SHOULDN'T HAPPEN** * * DETERMINE WHETHER MESSAGE IS A REQUEST FROM THE 3000 * OR A REPLY TO AN RTE MASTER'S REQUEST. * * CHECK VALIDITY AND SET UP , JSB VERIF , , AND . JMP READ INVALID REQUEST. IGNORE REST OF BLOCK. * LDA CLASS IF CLASS 0 REQUEST SZA,RSS OR REPLY, SEND JMP TOQX TO QUEX. * LDA STMWD ISOLATE REPLY AND AND B140K REJECT BITS. * CPA B140K IF BOTH SET, 3000 IS REJECTING JMP NEXT AN RTE REPLY. IGNORE. * SZA IF EITHER IS SET, JMP REPLY IT'S A REPLY TO AN RTE MASTER. SPC 3 * * A REQUEST HAS ARRIVED FROM THE 3000 (NOT ON CLASS 0). * LDB #QXCL INIT. REQ. EXCHANGED YET? SSB NO. IGNORE (MUST BE AN OLD JMP READ BUFFER LEFT ON THE CARD). * LDA CLASS CPA D5 CLASS 5? ($STDIN/$STDLIST) JMP $SCHK YES--MAY BE FOR MASTER. * RQCNV LDA #RQCV SET IOR BIT15 NO-WAIT STA CLASN BIT. * JSB EXEC WRITE REQUEST TO RQCNV'S CLASS. DEF *+8 DEF CLS20 DEF D0 DEF BPNTR,I DEF BUFL DEF D0 DEF D0 DEF CLASN CLASS NUMBER OF RQCNV. JMP REJCT ERROR RETURN. SZA IF NO SAM, JMP REJCT TRY TO REJECT. * JMP NEXT GO DISPATCH NEXT BLOCK. SPC 3 * * THE MESSAGE IS A DS/3000 REPLY TO AN RTE MASTER REQUEST. * REPLY LDA CLASS MESSAGE CLASS 6? CPA D6 JMP LBYE? YES--CHECK FOR LAST BYE. * * SEARCH FOR MASTER TCB. * SRCHM LDB BPNTR GET ADB D5 SEQUENCE LDA B,I NUMBER. STA TEMP SZA,RSS IF IT'S ZERO, JMP REJCT REJECT. JSB #RSAX CALL DEF *+3 #RSAX DEF D4 FOR DEF TEMP SEARCH. SSB FOUND? JMP NEXT NO--IGNORE. SPC 1 IOR BIT15 SET NO-WAIT BIT STA CLASN SAVE I/O CLASS #. * JSB EXEC CLASS DEF *+8 WRITE DEF CLS20 TO DEF D0 CLASN. DEF BPNTR,I DEF BUFL DEF BUFL DEF D0 DEF CLASN JMP RPCLS REPORT CLASS ERROR. SZA IF NO SAM, JMP NOSAM PRINT ERROR MESSAGE. SPC 1 * * END OF PROCESSING FOR THIS BLOCK. * NEXT LDA BPNTR BLOCK PROCESSED: ADA BUFL UPDATE POINTER INTO STA BPNTR RECEIVE BUFFER. * LDA BUFL CALCULATE NUMBER CMA,INA OF WORDS REMAINING ADA LOG IN READ BUFFER. STA LOG * JMP DISP GO CHECK FOR ANOTHER BLOCK. SPC 5 * * PRINT ERROR MESSAGE WHEN CLASS I/O FAILS BECAUSE OF NO SAM. * NOSAM JSB EXEC DEF *+5 DEF SD2 DEF D1 DEF SAMER DEF D13 NOP JMP NEXT * SAMER ASC 10,/QUEZ: INSUFFICIENT S.A.M. SPC 3 * * PRINT OTHER CLASS I/O ERROR MESSAGES * RPCLS DST CMSG1 STORE ASCII ERROR CODE. JSB EXEC WRITE MESSAGE DEF *+5 ON SYSTEM DEF SD2 CONSOLE. DEF D1 DEF CMSG DEF D12 NOP JMP NEXT GET NEXT BUFFER. * CMSG ASC 10,/QUEZ: CLASS ERROR CMSG1 ASC 2, SKP * * CHECK WHETHER $STDLIST REQUEST SHOULD GO TO MASTER OR CNSLM. * $SCHK LDB BPNTR GET "FROM PROCESS NUMBER." ADB D4 LDA B,I ALF,ALF AND B377 SZA,RSS IF ZERO, JMP RQCNV PASS TO RQCNV. LDA B,I GET "TO PROCESS NUMBER" AND B377 SZA,RSS IF ZERO, JMP RQCNV PASS TO RQCNV. JMP SRCHM BOTH NON-ZERO. PASS TO MASTER. SPC 3 SPC 5 * * SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. * REJCT LDA STMWD MAKE SURE AND BIT14 WE AREN'T SZA REJECTING JMP NEXT A REJECT! LDA BPNTR,I APPENDAGE AND B377 LENGTH IOR LB8 IS 8. STA BPNTR,I LDA STMWD SET REJECT BIT. IOR BIT14 AND NBT13 CLEAR CONTINUATION BIT. LDB BPNTR ADB D2 STA B,I ADB D2 REVERSE PROCESS NUMBERS. LDA B,I ALF,ALF STA B,I ADB D3 DATA LENGTH = 0. CLA STA B,I * TOQX LDA QXCLS IOR BIT15 SET NO-WAIT BIT. STA CLASN SAVE I/O CLASS #. * JSB EXEC CLASS DEF *+8 WRITE DEF CLS20 TO DEF D0 QUEX. DEF BPNTR,I DEF D8 DEF D8 DEF D0 DEF CLASN JMP RPCLS REPORT CLASS I/O ERROR. SZA IF NO SAM, JMP NOSAM PRINT ERROR MESSAGE. JMP NEXT * LB8 BYT 10,0 LEFT BYTE DECIMAL 8. SPC 3 * * CLASS 6 REPLY RECEIVED. IS IT LAST BYE? * LBYE? LDA STREM IF NOT CPA B21 STREAM 21, RSS IT'S NOT JMP SRCHM A BYE. * CCB GET ADDR OF PNL HEADER ADDR. ADB #LDEF LDB B,I GET ADDR OF PNL HEADER LDB B,I GET ADDR OF FIRST PNL ENTRY. JSB CKLST CHECK FOR ONE ENTRY. JMP STDIS NONE--DO DISCONNECT. JSB CKLST CHECK FOR SECOND ENTRY. JMP STDIS NO MORE--DO DISCONNECT. JMP SRCHM MORE THAN ONE HELLO OUTSTANDING. * STDIS JSB EXEC CLASS WRITE TO QUEX. DEF *+8 (NO REPLY EXPECTED) DEF CLS20 DEF D0 DEF D0 DUMMY BUFFER ADDRESS. DEF D0 ZERO-LENGTH RECORD. DEF D0 LENGTH PASSED TO QUEX. DEF D0 DEF #QXCL NOP IGNORE ERRORS. * JMP SRCHM SEARCH FOR MASTER. SPC 3 * * SUBROUTMINE TO CHECK IF A TCB LIST HAS ANY HP3000 ENTRIES. * CALLING SEQUENCE: LDB * JSB CKLST * * * CKLST NOP CKLOP SZB,RSS END OF LIST? JMP CKLST,I YES--TAKE NO-ENTRY RETURN. JSB LODWD STA TEMP SAVE LINK. INB GET SECOND JSB LODWD TCB WORD. LDB TEMP SET UP POINTER FOR NEXT LOOP. AND BIT14 ISOLATE "3000" BIT. SZA,RSS IF NOT SET, JMP CKLOP STAY IN LOOP. * ISZ CKLST ENTRY FOUND! JMP CKLST,I TAKE 2ND RETURN. SKP * * SUBROUTINE TO VERIFY AUTHENTICITY OF REQUESTS AND REPLIES * BEING SENT OR RECEIVED. ALSO SETS , , , * AND AND PERFORMS TRACE (IF REQUESTED). * * ON ENTRY, * BPNTR = BUFFER ADDRESS OF REQ/REPLY. * VERIF NOP LDB BPNTR LOAD ADDRESS OF MESSAGE. * LDA B,I CHECK WORD 1: SZA,RSS IF ZERO, IT MUST JMP VERIF,I LEFT-OVER CARD BUFFER. AND B377 ISOLATE MESSAGE CLASS. STA CLASS SAVE IT. ADA N9 SSA,RSS JMP BADBF ERROR IF MESSAGE CLASS > 8. * ADB D2 CHECK WORD 3: LDA B,I STA STMWD SAVE IT. AND B377 ISOLATE STREAM TYPE. STA STREM SAVE IT. ADA NB20 SSA JMP BADBF ERROR IF < OCTAL 20. ADA NB10 SSA,RSS JMP BADBF ERROR IF > OCTAL 27. * ADB D5 CHECK WORD 8: LDA B,I SSA JMP BADBF ERROR IF NEGATIVE. * LDB BPNTR VERIFY THAT ADB D7 WDCNT <= N(WORDS) + 8. LDB B,I INB CLE,ERB ADB D8 STB BUFL SAVE WORD COUNT. INB CMB,INB LDA BPNTR,I ALF,ALF AND B377 ADA B SSA,RSS JMP BADBF ERROR. ISZ VERIF NO ERRORo, TAKE NORMAL RETURN. * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. * LDA #CL3K+1 BUFFERS TO BE TRACED? SSA,RSS IF BIT 15 NOT SET, JMP VERIF,I RETURN. * LDA D8 INITIALIZE TRACE STA TRLEN LENGTH TO 8. * LDA #CL3K+1 APPENDAGE BIT SET? AND BIT14 SZA,RSS JMP WRTRC NO. GO WRITE. * LDA BPNTR,I GET LENGTH OF ALF,ALF APPENDAGE AND AND B377 HEADER FROM STA TRLEN WORD 1. * LDA #CL3K+1 GET MAX DATA LENGTH AND LENBT FROM BITS 0-12. ADA TRLEN ADD HEADER/APPEND LENGTH. STA B HOLD IN B-REG. CMA,INA IF GREATER THAN ACTUAL ADA BUFL BUFFER LENGTH, SSA LDB BUFL USE BUFFER LENGTH. STB TRLEN STORE TRACE LENGTH. * WRTRC CCA ADA BPNTR SET TRACE STA TPNTR POINTER. LDB TPNTR,I SET FIRST WORD STB HOLD TO INDICATE CLB,INB DIRECTION. STB TPNTR,I ISZ TRLEN ADD 1 TO LENGTH. JSB TRCOT WRITE TRACE. LDA HOLD RESTORE FIRST STA TPNTR,I BUFFER WORD. JMP VERIF,I RETURN. * BADBF LDA LOG SET BUFFER LENGTH STA BUFL TO REMAINING BLOCK STA TRLEN LENGTH & SET TRACE LEN. * JSB EXEC DISPLAY DEF *+5 ">> HP 3000: BAD BUFFER RECEIVED". DEF D2 DEF D1 DEF BDBUF DEF D16 * LDA #CL3K TRACE OPTION REQUESTED? SZA (LU NOT SET.) SSA (BAD LOG LU.) JMP VERIF,I NO. JMP WRTRC YES. SPC 1 * VALUES SET BY VERIF: CLASS NOP DS/3000 MESSAGE CLASS. STMWD NOP DS/3000 STREAM WORD. STREM NOP DS/3000 MESSAGE STREAM. BUFL NOP WORD COUNT OF BUFFER. HOLD NOP yL* BDBUF ASC 16,>> HP 3000: BAD BUFFER RECEIVED SPC 5 * * SUBROUTINE TO WRITE A RECORD TO TRACE LU. * CALLING SEQUENCE: * JSB TRCOT * TRCOT NOP ENTRY POINT. * LDA #CL3K CHECK STA TRCST BIT STA TRCIO 13 OF AND BIT13 LOG WORD. SZA JMP CLIO SET--DO CLASS I/O. * JSB XLUEX CHECK OUT DEF *+3 DYNAMIC DEF SD3 STATUS. DEF TRCST JMP WRERR ERROR RETURN. AND B277 IF ANY "BAD" BITS SZA ARE SET, JMP TRCDN SET TRACE DOWN. * JSB XLUEX WRITE ENTIRE DEF *+5 MESSAGE TO DEF SD2 TRACING LU. DEF TRCIO DEF TPNTR,I DEF TRLEN RSS ERROR RETURN. JMP TRCOT,I NO ERROR. RETURN. * WRERR DST ABREG PRINT JSB EXEC ERROR DEF *+5 MESSAGE. DEF SD2 DEF D1 DEF IOERR DEF D13 NOP * TRCDN LDA #CL3K SET "BAD" BIT IOR BIT15 IN TRACE LU. STA #CL3K JMP TRCOT,I RETURN. * CLIO LDA #CL3K SET NO-WAIT BIT IOR BIT15 IN CLASS NUMBER. STA CLASN JSB EXEC WRITE TO I/O CLASS. DEF *+8 DEF CLS20 DEF D0 DEF TPNTR,I DEF TRLEN DEF TRLEN DEF D0 DEF CLASN JMP WRERR (ERROR RETURN.) SZA,RSS CHECK FOR NO S.A.M. JMP TRCOT,I NO ERROR...RETURN. DLD "SAM" REPORT SAM ERROR. JMP WRERR * "SAM" ASC 2,SAM IOERR ASC 11,/QUEZ: TRACING ERROR ABREG BSS 2 TRLEN NOP TRACE OUTPUT LENGTH. TPNTR NOP TRACE OUTPUT POINTER. TRCIO OCT 0,100 TRACE LU/BINARY BIT TRCST OCT 0,600 TRACE LU/STATUS FUNCTION SD3 DEF 3,I B277 OCT 277 SPC 4 * * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I GET WORD FROM TCB (RSS IF DMS SYSTEM). JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I RETURN. SKP * * WRONG DRIVER FOR THIS QUEZ. REPORT THE ERROR. * WRDVR JSB EXEC REPORT ERROR DEF *+5 ON SYS CONSOLE. DEF D2 DEF D1 DEF WRMSG DEF D13 * JSB EXEC SUSPEND. DEF *+2 DEF D7 * JMP WRDVR STAY IN LOOP IN CASE OF "GO". * WRMSG ASC 13,>> QUEZ EXPECTS MODEM LINK SPC 5 * * CONSTANTS AND WORKING STORAGE. * * NB10 OCT -10 NB20 OCT -20 B20 OCT 20 B21 OCT 21 B377 OCT 377 B140K OCT 140000 BIT15 OCT 100000 BIT14 OCT 40000 BIT13 OCT 20000 NBT13 OCT 157777 LENBT OCT 17777 BITS 0-12 REDWD OCT 0,1000 RECEIVE DC2 CONTROL WORD CLS20 DEF 20,I SD2 DEF 2,I D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D12 DEC 12 D13 DEC 13 D16 EQU B20 D20 DEC 20 N7 DEC -7 N9 DEC -9 QXCLS NOP QUEX CLASS NUMBER. LOG NOP WORDS TO PROCESS IN CURRENT BUFFER TEMP NOP CLASN NOP BPNTR NOP SPC 2 * BSS 0 *** SIZE OF QUEZ **** SKP IFZ *** DEBUG OPTION *** ***** SPECIAL DEBUG SECTION: TRACE * INSERT A "JSB TRACE" IN PROGRAM. QUEZ WILL PRINT CALL LOCATION * AND CONTENTS OF A- & B-REGISTERS ON LU SPECIFIED IN #CL3K+6. * EXT CNUMO TRACE NOP ENTRY DST ABREG STORE REGISTERS LDA #CL3K+6 SZA,RSS IF TRACE LU ISN'T SPECIFIED, JMP TRTRN RETURN FROM TRACE. * STA TRLU SAVE TRACE LU NUMBER. * LDB 1727B GET POINTER TO STARTING ADDR FROM BASE PG. JSB LODWD GET STARTING ADDR FROM ID SEG. CMA,INA NEGATE. ADA TRACE ADD CALLING ADDRESS STA TOFST TO GET OFFSET. * JSB CNUMO CONVERT DEF *+3 ADDRESS On<:6FFSET DEF TOFST TO DEF TADDR OCTAL. * JSB CNUMO CONVERT DEF *+3 A-REG DEF ABREG TO DEF TAREG OCTAL. * JSB CNUMO CONVERT DEF *+3 B-REG DEF ABREG+1 TO DEF TBREG OCTAL. * JSB XLUEX PRINT DEF *+5 INFORMATION. DEF SD2 DEF TRLU DEF TINFO DEF D20 NOP TRTRN DLD ABREG RESTORE REGISTERS. JMP TRACE,I RETURN. * TOFST NOP TINFO ASC 7,/QUEZ TRACE @ TADDR ASC 3, ASC 2,: A= TAREG ASC 3, ASC 2,, B= TBREG ASC 3 TRLU OCT 0,0 XIF ***** END OF DEBUG ***** END QUEZ x< _n 91750-18159 2013 S C0122 &REMAT              H0101 rASMB,R,Q,C,N IFN * START RTE CODE HED REMAT 91750-16159 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM REMAT,19,80 91750-16159 REV.2013 800923 XIF * END RTE CODE * IFZ * START RTE-M CODE HED REMAT 91750-16160 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM REMAT,19,80 91750-16160 REV.2013 800923 XIF * END RTE-M CODE SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: REMAT * SOURCE: 91750-18159 UNL IFN * START RTE CODE LST * RELOC: 91750-16159 UNL XIF * END RTE CODE LST UNL IFZ * START RTE-M CODE LST * RELOC: 91750-16160 UNL XIF * END RTE-M CODE LST * PGMR: JIM HARTSELL, ET AL * ************************************************** * * OPERATOR INTERFACE PROGRAM FOR DS/1000. * * RTE PROGRAM TO PROVIDE VARIOUS OPERATOR ACCESS AND CONTROL * FUNCTIONS BOTH LOCALLY AND AT REMOTE NODES. * * CPU'S ARE ADDRESSED BY USING THE SW(ITCH) COMMAND TO SPECIFY * VALUES FOR NODE1 AND NODE2 TO BE USED IN SUBSEQUENT * OPERATOR COMMANDS. * **************************************************************** UNL IFN * START RTE CODE LST **************************************************************** * * REMAT IS TURNED ON WITH THE FOLLOWING OPERATOR COMMAND: * * *ON,REMAT [,NAMR [,LOGLU [,LISTLU [,SEVERITY CODE]]]] * * WHERE: * * NAMR = LU OF SYSTEM INPUT DEVICE (DEFAULT = 1), OR *  A FILE NAMR WHICH PROVIDES ALL INPUT COMMANDS. * * LOGLU = LU OF INTERACTIVE ERROR LOGGING DEVICE. (DEFAULT = * INPUTLU IF INPUTLU IS A CRT OR TTY, ELSE = 1) * * LISTLU = LU OF LIST DEVICE. (DEFAULT = LOGLU) * * SEVERITY CODE = ERROR REPORTING CODE. (DEFAULT = 0) * 0 = ECHO ALL COMMANDS * 1 = INHIBIT COMMAND ECHO * **************************************************************** UNL XIF * END RTE CODE UNL IFZ * START RTE-M CODE LST **************************************************************** * * REMAT IS TURNED ON WITH THE FOLLOWING OPERATOR COMMAND: * * *ON,REMAT [,INPUTLU [,LOGLU [,LISTLU [,SEVERITY CODE]]]] * OR * *ON,REMAT,FI,LE,NM [,LISTLU [,SEVERITY CODE]] * * WHERE: * * INPUTLU = LU OF SYSTEM INPUT DEVICE. (DEFAULT = 1) * * LOGLU = LU OF INTERACTIVE ERROR LOGGING DEVICE. (DEFAULT = * INPUTLU IF INPUTLU IS A CRT OR TTY, ELSE = 1) * * LISTLU = LU OF LIST DEVICE. (DEFAULT = LOGLU) * * SEVERITY CODE = ERROR REPORTING CODE. (DEFAULT = 0) * 0 = ECHO ALL COMMANDS * 1 = INHIBIT COMMAND ECHO * * FILENM = FILE WHICH MAY OPTIONALLY BE SPECIFIED TO PROVIDE * ALL INPUT COMMANDS * ***************************************************************** UNL XIF * END RTE-M CODE LST SPC 2 * SUP ENT REMAT * EXT #RQB,#RMSM,DSERR,RMPAR EXT EXEC,#NODE,$OPSY,D#OPS EXT #NCNT EXT DPOSN EXT DWRIT,DOPEN,DREAD,DLOCF EXT DCLOS,DCRET,DNAME,DPURG EXT DMESS,DMESG,IFBRK EXT #MAST,FCOPY EXT DEXEC,CNUMD,#SWRD EXT REIO,.DFER EXT .SFB,.SBT,.MBT,.MVW,.LBT * * RQB EQU #RQB SKP * GLBLK-START * ****************************************************************** * 8 * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKlP * RFBLK-START * ****************************************************************** * * * R F A B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY: * * * * RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO RFA REQUEST BUFFERS. * #FCN EQU #REQ RFA FUNCTION CODE. #DCB EQU #FCN+1 DCB/FILENAME AREA. #IRC EQU #DCB+3 DAPOS: IREC #IRB EQU #IRC+1 IRB #XIB EQU #IRC+2 IRB (DXAPO) #IOF EQU #IRB+1 IOFF #XIO EQU #XIB+2 IOFF (DXAPO) #ITR EQU #DCB+3 DCLOS: ITRUN #IC1 EQU #DCB+3 DCONT: ICON1 #IC2 EQU #IC1+1 ICON2 #ICR EQU #DCB+3 DCRET,DNAME,DOPEN,DPURG: ICR(1) #ID EQU #ICR+1 IDSEG #ISC EQU #ID+1 ISECU #SIZ EQU #ISC+1 DCRET: ISIZE(1) #SZ2 EQU #SIZ+1 ISIZE(2) #XRS EQU #SIZ+2 RECSZ (DXCRE) #TYP EQU #SZ2+1 ITYPE #XTY EQU #XRS+2 ITYPE (DXCRE) #NNM EQU #ISC+1 DNAME: NNAME #IOP EQU #ISC+1 DOPEN: IOPTN #NUR EQU #DCB+3 DPOSN: NUR #IR EQU #NUR+1 IR #XIR EQU #NUR+2 IR (DXPOS) #IL EQU #DCB+3 DREAD,DWRIT: IL #NUM EQU #IL+1 NUM #LEN EQU #FCN+1 DSTAT: ILEN #FOR EQU #LEN+1 IFORM #OPT EQU #FOR+1 IOP #NOD EQU #ICR+1 "FLUSH" REQUEST: NODE NUMBER * * OFFSETS INTO RFA REPLY BUFFERS. * #RFD EQU #REP DCRET,DOPEN: RFAMD ENTRY # #JSZ EQU #RFD+1 DCRET: JSIZE (DXCRE) #LOG EQU #REP DREAD: XLOG #REC EQU #REP DLOCF: IREC #RB EQU #REC+1 IRB #XRB EQvU #REC+2 IRB (DXLOC) #OFF EQU #RB+1 IOFF #XOF EQU #XRB+2 IOFF (DXLOC) #JSC EQU #OFF+1 JSECT #XJS EQU #XOF+1 JSECT (DXLOC) #JLU EQU #JSC+1 JLU #XJL EQU #XJS+2 JLU (DXLOC) #JTY EQU #JLU+1 JTY #XJT EQU #XJL+1 JTY (DXLOC) #JRC EQU #JTY+1 JREC #XJR EQU #XJT+1 JREC (DXLOC) #IAD EQU #REP DSTAT: IADD * * MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. * #RLW EQU #MHD+13 M A X I M U M S I Z E ! ! ! * * RFBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L]. #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SKP * A EQU 0 B EQU 1 * * INITIALIZE TRANSFER STACK. * REMAT EQU * UNL IFN * START RTE CODE LST LDA $OPSY GET 1ST SCHED PARAM RAR,SLA JMP REMC0 LDA B,I JMP *+3 REMC0 XLA B,I SZA,RSS LDA B1 STA TEMP SAVE IT * JSB EXEC GET SCHEDULE STRING. DEF *+5 DEF D14 DEF B1 DEF INBUF DEF D40 * STB INCNT SAVE # WORDS INPUT. UNL XIF * END RTE CODE LST * UNL IFZ * START RTE-M CODE LST JSB RMPAR GET SCHED PARAMS DEF *+2 DEF P1 UNL XIF * END RTE-M CODE LST * JSB EXEC SET SWAP ONLY WHAT IS NEEDED DEF *+3 DEF D22 DEF B2 LDA $OPSY CONFIGURE DMS INSTRUCTIONS RAR SLA,RSS DMS? JMP REMC2 NO. DLD XLA1 DST DMS1 STORE XLA XPNTR,I REMC2 EQU * LDA STKHD RESET STACK POINTER. STA P.STK CLA,INA SET FIRST STACK ENTRY STA P.STK,I FOR LOGICAL UNIT 1 (DEFAULT). * LDA #NODE GET LOCAL NODE # STA NODE2 DEFAULT NODE2 IS LOCAL STA NODE1 DEFAULT NODE1 IS LOCAL STA DESTX STA TRNOD INIT XFR FILE NODE CLA DEFAULT LU STA TRSEC INIT XFR FILE SECURITY CODE STA TRCRN AND CARTRIDGE REF #. * UNL IFN * START RTE CODE LS\yT * LDB INCNT IF A STRING WAS INPUT, SZB,RSS JMP RMC2A JSB $PARS PARSE SCHEDULE STRING. * LDB CP2 GET INPUT NAMR PARAM FLAG SZB NULL? JMP REMC3 NO RMC2A LDB TEMP YES, RETRIEVE 1ST SCHED PARAM STB P2 AND USE AS DEFAULT. LDB B1 SET PARAM 2 TYPE TO NUMERIC STB CP2 * REMC3 CCA ASSUME INPUT NAMR IS FILENAME CPB B1 IS IT NUMERIC INSTEAD? CLA YES, REVISE ASSUMPTION UNL XIF * END RTE CODE LST UNL IFZ * START RTE-M CODE LST LDA P1 CHECK IF P1 = ASCII PARAM. AND HB377 SZA,RSS JMP STR NO. MUST BE INPUT LU. * * FETCH SCHEDULE PARAMETERS (FL,NA,ME,LIST,SEVERITY). * DLD P1+1 PROTECTION FOR THE FILE SZA,RSS NAME IN THE SCHEDULE PARAMETERS LDA DBBLK SZB,RSS LDB DBBLK DST P1+1 * LDA A.$TR GENERATE "$TR,FLNAME" IN BUFFER. STA INBUF LDA A.TR1 STA INBUF+1 JSB .DFER DEF INBUF+2 DEF P1 * LDA B5 SET COUNT. STA INCNT * CLA SET UP DUMMY SCHEDULE PARAMS STA P1 FOR INPUTLU STA P1+1 AND LOGLU. LDA P1+3 ADJUST POSITION OF LISTLU STA P1+2 AND SEVERITY CODE IN LDA P1+4 SCHEDULE PARAM BUFR. STA P1+3 CCA PREPARE TO SET TRFLG UNL XIF * END RTE-M CODE LST * STR STA TRFLG SET/CLEAR FLAG FOR QUERY SECTION. UNL IFN * START RTE CODE LST SZA INPUT FROM FILE OR LU? JMP STAT FILE * * FETCH SCHEDULE PARAMETERS (LU,LOG,LIST,SEVERITY CODE). * LDA P2 GET LU OF INPUT DEVICE. UNL XIF * END RTE CODE LST UNL IFZ * START RTE-M CODE LSRT LDA P1 GET LU OF INPUT DEVICE UNL XIF * END RTE-M CODE LST SZA IF NONE OR 1, LEAVE DEFAULT (=1) CPA B1 IN STACK. JMP STAT * STA P.STK,I OVERRIDE DEFAULT INPUT LU * STAT LDA P.STK,I JSB EQTYP CHECK EQ. TYPE OF INPUT LU. STA LUTYP * UNL IFN * START RTE CODE LST LDA P3 GET LU OF LOG DEVICE. UNL XIF * END RTE CODE LST UNL IFZ * START RTE-M CODE LST LDA P1+1 GET LU OF LOG DEVICE UNL XIF * END RTE-M CODE LST LDB CP3 NUMERIC GIVEN? CPB B1 JMP SVLOG YES, USE IT * LDB LUTYP NO, USE INPUTLU CLA,INA IF INTERACTIVE, SZB,RSS ELSE USE 1. LDA P.STK,I GET INPUTLU SVLOG IOR VBIT IN CASE IT'S A PRINTER STA LOGLU SAVE LOGLU * UNL IFN * START RTE CODE LST LDA P4 GET LU OF LIST DEVICE UNL XIF * END RTE CODE LST UNL IFZ * START RTE-M CODE LST LDA P1+2 GET LU OF LIST DEVICE UNL XIF * END RTE-M CODE LST LDB CP4 IF NUMERIC NOT GIVEN, CPB B1 RSS LDA LOGLU USE DEFAULT = LOG LU. STA LSTLU * UNL IFN * START RTE CODE LST LDA P5 SAVE SEVERITY CODE UNL XIF * END RTE CODE LST UNL IFZ * START RTE-M CODE LST LDA P1+3 SAVE SEVERITY CODE UNL XIF * END RTE-M CODE LST STA SEVER * LDA TRFLG GET INPUT FILE FLAG UNL IFN * START RTE CODE LST SZA,RSS SCHEDULED WITH INPUT FILE? JMP QUERY NO UNL XIF * ENq"D RTE CODE LST UNL IFZ * START RTE-M CODE LST SZA SCHEDULED WITH INPUT FILE? JMP CHK$ YES, '$TR,FNAME' SIMULATED IN INBUF UNL XIF * END RTE-M CODE LST UNL IFN * START RTE CODE LST * * SCHEDULED TO RUN FROM INPUT FILE. MASSAGE THE PARSE BUFFER * TO STIMULATE A 'TR,FILENAME:SC:CRN' COMMAND WITH DEFAULT NODE #. * LDA CP2 MOVE PARAM2 ENTRY (FILENAME) TO STA CP1 PARAM1 ENTRY (OVERLAYING JSB .DFER "REMAT" FROM "RU,REMAT...." DEF P1 SCHEDULE STRING). DEF P2 * DLD SECU2 ALSO MOVE PARAM2 NAMRS TO DST SECU1 OVERLAY PARAM1 NAMRS. * CLA SIMULATE NULL NODE # STA CP2 PARAM FLAG. JMP M1205 GO TREAT AS A 'TR' COMMAND UNL XIF * END RTE CODE LST * * DISPLAY PROMPT CHARACTER (IF TTY DEVICE). * CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. * QUERY LDA P.STK,I CHECK WHETHER CURRENT INPUT STA LUTYP IS FROM A TTY TYPE DEVICE. AND HB377 NON ZERO IF FILE NAME, ELSE LU. SZA JMP REMRD REMOTE FILE. STA BRFLG CLEAR BREAK-FLAG * JSB LCALS SET FOR LOCAL ONLY LDA P.STK,I JSB EQTYP LOCAL LU: CHECK TYPE. JSB LCALC RESET NODE2 PARAMETER STA LUTYP SZA JMP LOCRD LOCAL INPUT LU NOT TTY DEVICE. * LDB "$" SET LOCAL PROMPT ($) LDA #NODE IF BOTH NODE1 AND NODE2 CPA NODE1 ARE LOCAL, ELSE SET RSS REMOTE PROMPT (#). LDB "#" CPA NODE2 RSS LDB "#" STB PRMPT * JSB REIO DISPLAY PROMPT ON TTY DEVICE. DEF *+5 DEF ICOD2 DEF P.STK,I DEF PRMPT PROMPT CHAR DEF B1 JMP RIOAB ERROR RETURN * LDA P.STK,I SET ECHO BIT. IOR B400  RSS * * INPUT OPERATOR REQUEST FROM CURRENT DEVICE OR FILE. * LOCRD LDA P.STK,I SET INPUT LU INTO STA TEMP REIO CALLING SEQ. * CLA CLEAR FIRST WORD OF BUFFER IN STA INBUF CASE THIS IS A "BIT BUCKET" LU. * JSB REIO LOCAL LU. DEF *+5 DEF ICOD1 DEF TEMP DEF INBUF DEF D40 JMP RIOAB ERROR RETURN * STA TEMPM SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. * LDA INBUF IF NOTHING PUT INTO BUFFER SZA,RSS (AS IN CASE OF "BIT BUCKET" LU), JMP OPER CALL IT AN INPUT ERROR. * JSB LCALS SET FOR LOCAL JSB EOFCK CHECK FOR END OF FILE. JMP TRANS GOT IT. JMP ECHO GO ECHO IF NECESSARY. * REMRD JSB IFBRK IF BRFLG IS SET AT DEF *+1 THIS OR ANY PREVIOUS SZA CALL TO IFBRK, THEN STA BRFLG CLEAR IT AND RESET STACK. LDA BRFLG CLB STB BRFLG SZA JMP RESET * JSB DREAD READ RECORD FROM FILE DEF *+6 (OPENED WHEN FIRST TRANSFER DEF TRDCB WAS PERFORMED) DEF IERRR DEF INBUF DEF D40 DEF INCNT ACTUAL WORD COUNT. * JSB ERCHK CHECK FOR ERRORS. * LDA INCNT IF EOF, GENERATE TR REQUEST. INA,SZA JMP BUMP TRANS LDA A.$TR STA INBUF LDA A.$TR+1 STA INBUF+1 LDA B2 STA INCNT JMP ECHO * BUMP LDA P.STK ADA B3 ISZ A,I BUMP RECORD COUNT. * * ECHO THE REQUEST IF NOT INPUT FROM TTY DEVICE. * ECHO LDA LUTYP SZA,RSS JMP CKCNT IT IS A TTY DEVICE. * LDA SEVER INHIBIT ECHO IF CPA B1 SEVERITY CODE = 1. JMP CHK$ * JSB REIO NOT TTY: ECHO. DEF *+5 DEF ICOD2 DEF LOGLU DEF INBUF DEF INCNT JMP RIOER ERROR RETURN * CHK$ LDA INlBUF FIRST CHARACTER MUST AND HB377 BE A "$". CPA AS.$ RSS JMP OPER * LDA INBUF BLANK OUT THE "$" SIGN. AND B377 IOR BLANK STA INBUF * CKCNT LDB INCNT IGNORE REQUEST IF NULL. RBL MAKE CHARACTER COUNT. SZB,RSS JMP QUERY * * PARSE THE OPERATOR REQUEST. * JSB $PARS * JMP M0000 CHECK IF PROCESSING NEEDED * * * SEND RTE COMMANDS. * OTHER LDA INCNT CONVERT LENGTH TO BYTES RAL STA INCNT * * HERE FOR SENDING SYSTEM COMMANDS TO THE * CPU AT NODE1. * JSB DMESS SEND COMMAND. DEF *+4 DEF NODE1 DEF INBUF ASCII COMMAND. DEF INCNT COUNT (+POSITIVE BYTES) * INB,SZB "DS" ERROR? JMP RSMSG NO. JSB ERMSG YES. DISPLAY IT AND GET OUT. RSS RSMSG SZA,RSS ANY RESPONSE MESSAGE? JMP QUERY NO. GO GET NEXT COMMAND INPUT. * STA TEMP YES. SAVE COUNT * JSB REIO DISPLAY REPLY MESSAGE. DEF *+5 DEF ICOD2 DEF LOGLU DEF INBUF DEF TEMP JMP RIOER ERROR RETURN * JMP QUERY * * CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL * REQUEST CODES AND JUMP 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. * M0000 LDB OP FETCH OPERATION CODE. M0001 STB OPP SET STOP FLAG. LDA LDOPC SET OPERATION TABLE POINTER. STA TEMP1 LDA LDJMP SET PROCESSOR JUMP ADDRESS. * M0030 CPB TEMP1,I COMPARE WITH TABLE VALUE. JMP A,I COMPARES. GO DO IT. * ISZ TEMP1 KEEP LOOKING. INA JMP M0030 * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS. * ASC 1,DL ASC 1,DU EX ASC 1,EX  ASC 1,ST ASC 1,SW ASC 1,TE ASC 1,TR ASC 1,LO ASC 1,IO ASC 1,PL ASC 1,LL ASC 1,SL ASC 1,SO ASC 1,RW ASC 1,LC ASC 1,FL ASC 1,PU ASC 1,RN ASC 1,CR ASC 1,LI ASC 1,BC "BROADCAST" ASC 1,CL CARTRIDGE LIST. ASC 1,AT ATTACH TO SESSION. ASC 1,DE DETACH FROM SESSION. ASC 1,XX BLOCK "REMOTE SESSION PSEUDO-OP". OPP NOP OP CODE FOR CURRENT REQ. * LDJMP DEF *+1,I JMP ADDRESS FOR EACH OP CODE. * DEF M0300 ADR FOR DL REQUEST DEF M0400 DU REQUEST. DEF M0500 EX REQUEST. DEF M0900 ST REQUEST. DEF M0990 SW REQUEST. DEF M1000 TE REQUEST. DEF M1200 TR REQUEST DEF M1400 LO REQUEST DEF M1450 IO REQUEST DEF M1500 PL REQUEST DEF M1600 LL REQUEST DEF M1700 SL...SLAVE LIST ROUTINE DEF M1800 SO...SLAVE OFF ROUTINE DEF M2001 RW REQUEST DEF M2100 LC REQUEST DEF M2401 FL REQUEST DEF M2501 PU REQUEST DEF M2550 RN REQUEST DEF M2701 CR REQUEST DEF M2801 LI REQUEST DEF BRCST BR REQUEST DEF M3000 CL REQUEST DEF M3100 AT REQUEST DEF M3200 DE REQUEST DEF OPER BLOCK "REMOTE SESSION PSEUDO-OP". DEF OTHER MUST BE A SYSTEM COMMAND SPC 1 * ERR55 LDA D55 MISSING PARAMETER JMP OPERS * ERR56 LDA D56 ILLEGAL PARAMETER TYPE JMP OPERS * OPER LDA D10 INPUT ERROR: 010 OPERS LDB BLANK MAKE POSITIVE, SET SIGN WORD. SSA,RSS JMP OPER1 LDB MINUS CMA,INA OPER1 STB EMSG+4 STA TEMP * JSB CNUMD CONVERT ERROR CODE TO ASCII. DEF *+3 DEF TEMP DEF INBUF * LDA INBUF+2 STUFF LAST 2 DIGITS INTO MSG. IOR HB20 LEADING BLANK TO ASCu!II 0. STA EMSG+5 LDA INBUF+1 SET UP SIGN AND AND B377 FIRST DIGIT. IOR EMSG+4 IOR B20 LEADING BLANK TO ASCII ZERO. STA EMSG+4 STORE IN MESSAGE BUFFER. * JSB REIO DISPLAY ERROR MESSAGE. DEF *+5 DEF ICOD2 DEF LOGLU DEF EMSG DEF B6 JMP RIOER ERROR RETURN. JMP RESET GO RESET STACK POINTER, ETC. * MINUS OCT 026400 HB20 OCT 10000 B20 OCT 20 EMSG ASC 6,/REMAT: NNNN * HED REMAT: TR REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * TR,NAMR [,NODE #] * * TRANSFER CONTROL TO LOCAL LU OR FILE AT NODE #. DEFAULT NODE# * IS LOCAL. NODE # AND NAMR SUBPARAMS CRN & SECURITY CODE MAY BE * SET ONLY ON THE FIRST $TR OF A NESTED GROUP OF $TR COMMANDS. * M1200 LDA CP1 IF TRANSFER IS TO CPA B1 A REMOTE LU, RSS JMP M1202 LDA CP2 SZA,RSS JMP M1202 LDA P2 CPA #NODE RSS JMP OPER IT IS AN INPUT ERROR. * M1202 LDA P.STK,I IF CURRENT INPUT IS FROM A AND HB377 FILE, CLOSE IT. SZA,RSS JMP M1210 * JSB DCLOS DEF *+3 DEF TRDCB DEF IERRR * M1205 CLA STA TOPNF CLEAR TRDCB OPEN FLAG. * M1210 LDA P.STK IF THIS IS THE FIRST $TR CPA STKHD OF A NESTED GROUP, SET FILE RSS NODE, SECURITY CODE AND CRN. JMP IGNOR IF NOT, LEAVE THEM AS THEY ARE. LDA SECU1 STA TRSEC LDA CRN1 STA TRCRN LDB CP2 GET 2ND PARAM FLAG SZB MISSING? JSB INTCK NO. MUST BE NUMERIC LDA #NODE GET DEFAULT NODE (LOCAL) SZB P2 MISSING? LDA P2 NO, USE IT. STA TRNOD SET NODE # * IGNOR EQU * LDA P1 GET PARAM 1. SZA,RSS IF NOT SPECIFIED, CCA SIMULATE "TR,-1". * SSA,RSS NEGATIVE INTEGER? JMP M1220 NO. * * BACK UP THROUGH TRANSFER STACK. * LDB STKHD STB TEMP TEMP = TOP-OF-STACK ADR LDB TRFLG RUNNING FROM SCHEDULE SZB,RSS PARAM FILE? JMP M1215 NO LDB STKHD YES, ADJUST TOS ADR ADB B4 STB TEMP M1215 LDB P.STK TOP OF STACK? BKUP CPB TEMP JMP M1217 YES. SIMULATE "EX" REQUEST. ADB MD4 NO. BACK UP 1 ENTRY. INA,SZA JMP BKUP LOOP TILL DONE. STB P.STK SET NEW STACK ADDRESS. JMP M1250 GO CHECK FOR FILE. * M1217 LDB EX GO SIMULATE "EX" REQUEST JMP M0001 * * ADD NEW CONTROL TO THE TRANSFER STACK. * M1220 LDA P.STK BUMP TO NEXT ENTRY. ADA B4 STA P.STK CPA STKEN RSS JMP M1230 * LDA D13 STACK OVERFLOW. ERROR 013. JMP OPERS * M1230 EQU * LDB P1 STORE LU OR FILE NAME. STB A,I INA LDB P1+1 STB A,I INA LDB P1+2 STB A,I INA CLB,INB SET RECORD NUMBER TO 1. STB A,I * * IF FILE, OPEN AND OPTIONALLY POSITION. * M1250 LDA P.STK,I AND HB377 SZA,RSS JMP QUERY LOCAL LU. GO GET NEXT REQUEST. * JSB DOPEN OPEN THE FILE. DEF *+7 DEF TRDCB DEF IERRR DEF P.STK,I DEF B0 IOPTN DEF TRSEC SECURITY CODE DEF TRCRN ICR ARRAY * LDA IERRR PROCESS ERRORS ONLY IF SSA IERRR IS NEGATIVE. JSB ERCHK ISZ TOPNF SET TRDCB OPEN FLAG. * LDA P.STK POSITIONING REQUIRED? ADA B3 LDB A,I CPB B1 (REC. CNT MORE THAN 1?) JMP QUERY NO. STB TEMP YES. * JSB DPOSN POSITION TO NEXT RECORD. DEF *+5 DEF TRDCB DEF IERRR DEF TEMP NUR GREATER THAN ZERO. DEF TEMP ABSOLUTE RECORD NUMBER. * JSB ERCHK CHECK F OR ERRORS. JMP QUERY * * TRANSFER STACK. * * FOR EACH ENTRY, WORD 1 = INTEGER LU OR * FIRST 2 FNAME CHAR. * WORD 2,3 = REST OF FNAME. * WORD 4 = NEXT RECORD NUMBER. * P.STK NOP STACK POINTER. STKHD DEF *+1 * BSS 32 8 ENTRIES. * STKEN DEF * STACK LWA+1 * TRSEC NOP XFR FILE SECURITY CODE TRCRN BSS 2 XFR FILE ICR ARRAY TRNOD EQU TRCRN+1 HED REMAT: DU REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * DU,NAMR1,LU [,FORMAT] * * DUMP FROM NAMR1 FILE OR LU AT NODE1 TO LU AT NODE2 * M0400 JSB CKFMT SET UP SUBF, ETC LDB CP1 CPB B1 1ST PARAM NUMERIC? JMP M0450 YES, MUST BE LU * JSB ASCHK NO,MUST BE FILE NAME. LDB CP2 JSB INTCK ERROR IF NO LU2 JSB PTCHK SEE IF LEADER GENERATION NECESSARY LDA NODE1 STA CRN1+1 BUILD ICR ARRAY FOR DOPEN * * OPEN THE FILE AT NODE1 * JSB DOPEN OPEN THE FILE. DEF *+7 DEF UDCB DEF IERRR DEF P1 FILE NAME. DEF B0 OPEN OPTIONS. DEF SECU1 SECURITY CODE. DEF CRN1 ICR ARRAY * LDA IERRR CHECK FOR ERRORS IF IERRR NEG. SSA JSB ERCHK ISZ UOPNF SET UDCB OPEN FLAG. * LDA CP3 GET FORMAT PARAM FLAG SZA GIVEN? JMP M0410 YES, OVERRIDES FILE TYPE * JSB DLOCF NO, GET FILE TYPE INFO DEF *+9 DEF UDCB DEF IERRR DEF TEMP DEF TEMP DEF TEMP DEF TEMP DEF TEMP DEF TYPE1 * LDA IERRR CHECK FOR ERRORS IF IERRR NEG. SSA JSB ERCHK * LDA B100 LDB TYPE1 CPB B5 TYPE 5? STA SUBF YES, SET BINARY BIT CPB B7 TYPE 7? STA SUBF YES, SET BINARY BIT * CLB IF FORMAT IS LDA P3 ASCII, RESET CPA "AS" ASCII/BINARY STB SUBF BIT IN SUBF. * * READ A RECORD FROM NODE1 FILE. * M0410 JSB DREAD READ. DEF *+6 DEF UDCB DEF IERRR DEF INBUF DEF D128 DEF INCNT XMSN LOG. * LDA TYPE1 IF ERROR -12 (EOF) CPA B1 RSS JMP M0411 LDA IERRR ON TYPE 1 FILE, CPA MD12 JMP M0415 GO PROCESS EOF. * M0411 JSB ERCHK CHECK FOR ERRORS. * LDA INCNT SZA,RSS SKIP CHECKSUM FOR JMP M0412 ZERO-LENGTH RECORDS. INA,SZA,RSS CHECK FOR EOF (INCNT=-1) JMP M0415 GOT IT. GO PROCESS. JSB CKSUM DO CHECKSUM IF NECESSARY JMP ERR07 CHECKSUM ERROR RETURN M0412 JSB LUOUT GO OUTPUT THE RECORD RSS BREAK REC'D. TREAT AS EOF JMP M0410 GO READ NEXT RECORD M0415 JSB EOFPR PROCESS EOF JMP M0950 GO CLOSE NODE1 FILE * * DUMP LU1 TO LU2 * M0450 LDB CP2 JSB INTCK ERROR IF NO LU2 JSB PTCHK SEE IF LEADER GENERATION NECESSARY JSB CKTTY SET ECHO BIT IF LU = TTY OR CRT M0460 JSB LUIN INPUT RECORD FROM LU1 JMP M0470 EOF FOUND JSB LUOUT OUTPUT RECORD TO LU2 RSS BREAK FLAG SET. TREAT AS EOF JMP M0460 GO READ NEXT RECORD M0470 JSB EOFPR PROCESS END-OF-FILE JMP QUERY * * SUBROUTINE TO GENERATE LEADER IF LU2 = PAPER TAPE PUNCH * PTCHK NOP LDA P2 GET LU2 JSB EQTYP CPA B2 PAPER TAPE PUNCH? RSS JMP PTCHK,I NO, RETURN LDA B1000 YES, GENERATE LEADER IOR P2 STA TEMP * JSB DEXEC CONTROL DEF *+4 DEF NODE2 DEF ICOD3 CONTROL, NO-ABORT DEF TEMP JMP ASCER ERROR RETURN * JMP PTCHK,I RETURN * * SUBROUTINE TO OUTPUT THE RECORD ON NODE2 LU * * LUOUT NOP LDA SUBF GET SUBFUNCTION AND B100 ISOLATE BINARY/ASCII BIT IOR P2 INCLUDE OUTPUT LU STA TEMP SET UP DEXEC CONWD * JSB DEXEC WRITE. DEF *+6 DEF NODE2 DEF ICOD2 WRITE, NO-ABORT DEF TEMP CONWD DEF INBUF DEF INCNT JMP ASCER ERROR RETURN * JSB IFBRK FIND IF DEF *+1 THE BREAK FLAG SZA,RSS IS SET ISZ LUOUT NO, BUMP RETURN ADR STA BRFLG SAVE BREAK INDICATION JMP LUOUT,I YES. RETURN * * PROCESS END OF FILE CONDITION. * EOFPR NOP LDA P2 GET NODE2 LOGICAL UNIT. JSB EQTYP STA B EQUIPMENT TYPE. * LDA B100 SET DEFAULT TO M.T. DEVICE. CPB B2 XOR B1100 PUNCHED TAPE - TRAILER. CPB D10 IOR B1100 LINE PRINTER - PAGE EJECT. IOR P2 INSERT LOGICAL UNIT. STA TEMP * JSB DEXEC PERFORM I/O CONTROL. DEF *+5 DEF NODE2 DEF ICOD3 CONTROL, NO-ABORT DEF TEMP FORMATTED CONTROL WORD. DEF MD1 USED ONLY FOR LP. JMP ASCER ERROR RETURN * JMP EOFPR,I RETURN HED REMAT: ST REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * ST,NAMR1,NAMR2 [,FORMAT [,MODE]] * * STORE FROM NAMR1 LU OR FILE AT NODE1 INTO * NAMR2 FILE AT NODE2. MODE = TRANSFER MODE PARAMETER * IN FCOPY CALL (IF NON-ZERO, FILES ARE OPENED AS  * TYPE 1). * M0900 LDA NPRMS # OF PARAMS (INCLUDING CPA B2 COMMAND) = 2? JMP OTHER YES, MUST BE STATUS COMMAND LDA CP1 IOR B1 CPA B3 1ST PARAM ASCII (FILE NAME)? JMP M0960 YES, STORE FILE TO FILE * LDB CP2 NO, STORE LU TO FILE JSB ASCHK ERROR IF NOT A FILE NAME * JSB CKFMT * LDA D10 DEFAULT # BLOCKS TO 10. LDB SIZE2 SZB,RSS STA SIZE2 * LDB CP1 ERROR IF NO LU. JSB INTCK * LDA CRN2  LDB NODE2 DST TEMP BUILD ICR ARRAY FOR DCRET * * * * CREATE THE DISC FILE AT NODE2. * JSB DCRET CREATE FILE. DEF *+8 DEF UDCB DEF IERRR DEF P2 FILE NAME. DEF SIZE2 FILE-SIZE/REC-SIZE (2 WORDS) DEF TYPE2 FILE TYPE DEF SECU2 SECURITY CODE DEF TEMP ICR ARRAY (2 WORDS) * LDA IERRR CHECK FOR ERRORS IF IERRR NEG. SSA JSB ERCHK ISZ UOPNF SET UDCB OPEN FLAG. * JSB CKTTY SET ECHO BIT IF LU = TTY OR CRT M0905 JSB LUIN INPUT RECORD FROM LU JMP M0950 EOF FOUND IN INPUT * * WRITE THE RECORD ON NODE2 DISC FILE. * JSB DWRIT DEF *+5 DEF UDCB DEF IERRR DEF INBUF DEF INCNT * LDA IERRR CHECK FOR ERRORS. SSA JMP ST1 JSB IFBRK NO ERROR, IS BREAK FLAG DEF *+1 SET ? SZA,RSS JMP M0905 NO, GO READ NEXT RECORD. STA BRFLG YES, SAVE BREAK INDICATION * ST1 JSB DPURG ERROR. PURGE FILE. DEF *+6 DEF UDCB DEF TEMP DEF P2 FILE NAME. DEF P3 SECURITY. DEF P4 LABEL. * CLA CLEAR UDCB OPEN FLAG STA UOPNF JSB ERCHK DOES NOT RETURN * * END OF FILE ON INPUT. * M0950 JSB DCLOS CLOSE THE FILE DEF *+3 DEF UDCB DEF IERRR * CLA CLEAR UDCB OPEN FLAG. STA UOPNF * JMP QUERY * * STORE FROM FNAM1 AT NODE1 TO FNAM2 AT NODE2 * M0960 LDA CRN1 BUILD ICR LDB NODE1 ARRAYS FOR DST TEMP1 FCOPY CALL. LDA CRN2 LDB NODE2 DST TEMP2 * JSB DOPEN PRE-OPEN THE SOURCE FILE. DEF *+7 DEF UDCB DEF IERRR DEF P1 FILE NAME. DEF B0 OPTIONS. DEF SECU1 SECURITY. DEF TEMP1 ICR ARRAY. * SSA JMP ERCHOK OPEN ERROR. * CLB,INB CPA B6 FILE TYPE 6? STB P4 YES. TELL FCOPY TO OPEN AS TYPE 1. * JSB DCLOS CLOSE THE FILE. DEF *+3 DEF UDCB DEF IERRR SPC 2 JSB FCOPY NOW DO THE COPY. DEF *+12 DEF P1 NODE1 FILE NAME DEF TEMP1 NODE1 CRN ARRAY DEF P2 NODE2 FILE NAME DEF TEMP2 NODE2 CRN ARRAY DEF IERRR DEF SECU1 DEF TYPE2 DEF SIZE2 DEF RSIZ2 DEF P4 XFER MODE DEF SECU2 SPC 3 * * ERROR PROCESSING * LDA IERRR GET ERROR CODE SZA,RSS ANY THING ? JMP QUERY NO, GO BACK * SSA ERROR OR WARNING ? JSB ERCHK SOLID ERROR. GO AWAY. * JSB REIO TELL THE OPERATOR DEF *+5 THAT IT IS ONLY DEF ICOD2 A WARNING DEF LOGLU DEF WRNG DEF D14 JMP RIOER ERROR RETURN * JMP QUERY GO BACK. * * SUBROUTINE TO SET LUTYP OF INPUT DEVICE * CKTTY NOP LDA NODE2 CHANGE NODE2 TO NODE1 STA TEMP TEMPORARILY FOR CALL LDA NODE1 TO EQTYP. STA NODE2 LDA P1 DETERMINE DEVICE TYPE JSB EQTYP OF NODE1 LU. LDB TEMP RESET NODE2 STB NODE2 STA LUTYP SAVE DEVICE TYPE OF NODE1 LU JMP CKTTY,I * * SUBROUTINE TO READ INPUT RECORD FROM NODE1 LU * LUIN NOP M0910 LDA LUTYP IF NODE1 DEVICE IS A TTY, SZA DISPLAY INPUT PROMPT CHAR. JMP M0920 * JSB DEXEC IT IS. DISPLAY PROMPT, BECAUSE DEF *+6 OF PERCEPTIBLE DELAY BETWEEN DEF NODE1 RECORDS DEF ICOD2 WRITE, NO-ABORT DEF P1 NODE1 INPUT DEVICE DEF IPRMP ASCII SLASH, SPACE. DEF MD3 JMP ASCER ERROR RETURN * M0920 LDA SUBF GET SUBFUNCTION IOR P1 INCLUDE INPUT LU STA f/TEMP SET UP CONWD FOR DEXEC * JSB DEXEC READ THE INPUT RECORD. DEF *+6 DEF NODE1 DEF ICOD1 READ, NO-ABORT DEF TEMP CONWD DEF INBUF DEF D128 JMP ASCER ERROR RETURN * STA TEMPM SAVE STATUS WORD. STB INCNT SAVE WORD COUNT. * * CHECK FOR INPUT END OF FILE AT NODE1 LU * JSB EOFCK EOF? JMP LUIN,I YES, RETURN *+1 LDA INCNT CHECK FOR NULL NON-CARD INPUT. SZA,RSS JMP M0910 NO INPUT (TLOG=0), SO IGNORE JSB CKSUM DO CHECKSUM IF REQ'D JMP ERR07 CHECKSUM ERROR ISZ LUIN JMP LUIN,I RETURN *+2 SPC 2 ERR07 LDA B7 REPORT CHECKSUM ERROR JMP OPERS SPC 2 WRNG ASC 14,WARNING : DEST. FILE RENAMED HED REMAT: LL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * LL [,LISTLU [,LOGLU]] * * CHANGE THE CURRENT LIST DEVICE AND/OR LOG DEVICE TO THE * PARAMETER VALUES GIVEN. IF NEITHER PARAMETER IS GIVEN, * THE CURRENT LIST AND LOG LU'S ARE DISPLAYED ON THE LOGLU. * M1600 LDA CP1 SZA,RSS PARAM 1 PRESENT? JMP M1650 NO LDA P1 YES, CHANGE LISTLU SZA,RSS CHECK FOR JMP OPER LIST LU IN AND LUMSK RANGE 1-77B. SZA JMP OPER LDA P1 STA LSTLU LDA CP2 SZA,RSS PARAM 2 PRESENT? JMP QUERY NO * M1625 LDA P2 YES, CHANGE CURRENT LOGLU SZA,RSS CHECK FOR JMP OPER LOGLU IN AND LUMSK 1-77B RANGE. SZA JMP OPER LDA P2 GET 2ND PARAM AGAIN IOR VBIT IN CASE IT'S A PRINTER STA LOGLU SAVE LOGLU JMP QUERY * M1650 LDA CP2 SZA PARAM 2 PRESENT? JMP M1625 YES * LDA LSTLU NO. ISOLATE LIST LU. AND B77 STA TEMP * JSB CNUMD CONVERT CURRENT DEF *+3 LISTLU TO ASCItI. DEF TEMP DEF LLMSG+4 * LDA LOGLU GET LOGLU AND B77 STRIP V-BIT STA TEMP SET UP CNUMD CALL * JSB CNUMD CONVERT CURRENT DEF *+3 LOGLU TO ASCII. DEF TEMP DEF LLMSG+16 * JSB REIO DISPLAY CURRENT VALUES DEF *+5 OF LISTLU AND LOGLU. DEF ICOD2 DEF LOGLU DEF LLMSG DEF D19 JMP RIOER ERROR RETURN * JMP QUERY SPC 2 LLMSG ASC 19,LISTLU =XXXXXX LOGLU = XXXXXX LUMSK OCT 177700 HED REMAT: RW REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * RW PROCESSOR * * RW,PNAME [,P1 [,P2 [,P3 [,P4 [,P5]]]]] * OR * RW,PNAME [, ] * * SCHEDULE PROGRAM (PNAME) TO RUN AT NODE1 WITH WAIT. * PASSES UP TO 5 OPTIONAL SCHEDULE PARAMETERS * OR A STRING OF UP TO 70 ASCII CHARACTERS * TO THE SCHEDULED PROGRAM. * * M2001 LDB CP1 FIRST PARAM MUST JSB ASCHK BE ASCII. * LDA "R" GET TERM/TEST WORD LDB BUFAD GET INBUF ADR CLE,ELB MAKE IT A BYTE ADR JSB .SFB LOOK FOR "R" IN "RW" INB,RSS FOUND IT. MOVE TO NEXT BYTE JMP OPER NOT FOUND LDA "U" REPLACE "RW" WITH "RU" JSB .SBT * CCB PRE-SET B TO KNOWN VALUE JSB DEXEC REMOTE SCHED-WITH-WAIT DEF *+11 DEF NODE1 DEF I9B11 REQUEST CLONING IF S.M. NODE. DEF P1 PROG NAME DEF P2 UP TO 5 OPTIONAL SCHED-PARAMS DEF P3 DEF P4 DEF P5 DEF P6 DEF INBUF STRING BUFFER ADR DEF INCNT BUFR COUNT * JMP ASCER ERROR RETURN SZA STATUS = 0? JMP ILSTA NO, ILLEGAL STATUS CPB MD1 ANY RETURN PARAMS? JMP QUERY NO, B HAS NOT CHANGED * JSB RMPAR USE RMPAR IN CASE WE'RE DEF *+2 A LARGE BACKGROUND PROGRAM. PRMAD DEF INBUF+23GU * LDA PRMAD SAVE ADDRESS OF 1ST RETURN PARAM STA TEMP FOR ASCII/BINARY PARAMS. * LDB BUFAD GET PRINTBUF POINTER LDA MD5 SET COUNTER TO STORE STA TEMP2 PARAMS IN OCTAL FORMAT JSB OCT6 CONVERT & STORE 1 PARAM ISZ TEMP2 BUMP COUNTER JMP *-2 LOOP UNTIL DONE * JSB STBLK STORE JSB STBLK THREE JSB STBLK DOUBLE BLANKS. * LDA MD10 MAKE SURE ORIGINAL PARAMETERS STA TEMP1 ARE ASCII BEFORE DISPLAYING LDB PRMAD THEM AT END OF DISPLAY LINE. RBL RWCHK JSB .LBT IN RANGE 40(8) - 172(8)? ADA MB40 SSA JMP RW02 NO. NOT ASCII. ADA MB133 SSA JMP RW03 ASCII. RW02 LDA LOBLK NOT ASCII. CHANGE TO BLANK. ADB MD1 JSB .SBT RW03 ISZ TEMP1 JMP RWCHK LOOP TILL DONE. * JSB REIO DISPLAY LINE ON LOGLU DEF *+5 DEF ICOD2 DEF LOGLU DEF INBUF DEF D28 JMP RIOER ERROR RETURN * JMP QUERY * ILSTA JSB REIO PRINT "ILLEGAL STATUS" MSG DEF *+5 DEF ICOD2 DEF LOGLU DEF ILMSG DEF B7 JMP RIOER ERROR RETURN * JMP RESET SPC 2 * * SUBROUTINE TO CONVERT TO ASCII & STORE ONE WORD * OCT6 NOP JSB STBLK STORE DOUBLE BLANK LDA TEMP,I GET PARAM ALF AND B17 ISOLATE HIGH 2 DIGITS JSB CVOCT CONVERT 1ST & 2ND DIGITS ALF,ALF RAL,RAL JSB CVOCT CONVERT 2ND & 3RD DIGITS JSB CVOCT CONVERT 4TH & 5TH DIGITS ISZ TEMP BUMP PARAM POINTER JMP OCT6,I SPC 2 CVOCT NOP STA TEMP1 AND B70 ISOLATE LEFT DIGIT ALF,RAL IOR HZERO FORM ASCII DIGIT STA TEMPM SAVE IT LDA TEMP1 GET 2 DIGITS BACK AND B7 ISOLATE RIGHT DIGIT IOR LZERO IOR TEpMPM STA B,I INB LDA TEMP,I JMP CVOCT,I SPC 2 STBLK NOP LDA DBBLK STA B,I INB JMP STBLK,I SPC 2 ILMSG ASC 7,ILLEGAL STATUS HED REMAT: LI REQUEST * (C) HEWLETT-PACKARD CO. 1979 SPC 3 * * LI PROCESSOR * * LI,NAMR,LU * * LIST CONTENTS OF NODE1 FILE 'NAMR' * TO A NODE2 LU (DEFAULT = LSTLU). * M2801 LDB CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDB CP2 GET 2ND PARAM FLAG SZB LU GIVEN? JSB INTCK YES, MUST BE NUMERIC LDA LSTLU GET DEFAULT LIST LU SZB,RSS LU GIVEN? STA P2 NO, USE DEFAULT * LDA NODE1 STA CRN1+1 FORMAT THE ICR ARRAY * CLA INITIALIZE OPEN OPTIONS. M2802 STA TEMP * JSB DOPEN OPEN THE FILE AT NODE1 DEF *+7 DEF UDCB DEF IERRR DEF P1 NAME DEF TEMP OPTION DEF SECU1 SECURITY DEF CRN1 ICR ARRAY * SSA JSB ERCHK OPEN ERROR * CPA B6 TYPE 6 FILE? RSS JMP M2803 NO. * JSB DCLOS YES. CLOSE FOR RE-OPEN. DEF *+3 DEF UDCB DEF IERRR * LDA B4 SET "OPEN OPTION" PARAM TO JMP M2802 FORCE FILE TO TYPE 1. * M2803 ISZ UOPNF SET UDCB OPEN FLAG LDA B1 STA REC# RESET THE RECORD NUMBER * JSB .DFER STORE THE FILE NAME IN THE TITLE DEF TITL+1 DEF P1 * JSB DLOCF GET THE FILE TYPE AND SIZE TO DEF *+9 INCLUDE IN THE TITLE DEF UDCB DEF IERRR DEF TEMP DEF TEMP DEF TEMP DEF SIZ DEF TEMP DEF TYP * LDA SIZ CONVERT THE NUMBER OF SECTORS INTO CLE,ERA THE NUMBER OF BLOCKS. SEZ INA STA SIZ * LDA AS.M1 GET ASCII "-1" LDB TYP GET FILE TYPE " INB,SZB,RSS TYPE = -1 (CTU FILE)? JMP M2805 YES, GO SET "-1" INTO TYP JSB CNUMD NO, CONVERT TYPE DEF *+3 AND NODE TO ASCII DEF TYP AND STUFF INTO TITLE. DEF P3 USE P3 AS TEMP BUFR LDA P3+2 M2805 STA TYP * JSB CNUMD CONVERT SIZE DEF *+3 DEF SIZ DEF P3 DLD P3+1 DST SIZ * JSB CNUMD DEF *+3 DEF NODE1 DEF NOD * JSB DEXEC NOW THE TITLE IS READY, PRINT IT DEF *+6 DEF NODE2 DEF ICOD2 WRITE, NO-ABORT DEF P2 LU DEF TITL DEF D36 LENGTH JMP ASCER ERROR RETURN * LDA P2 PREPARE CONTROL WORD FOR LINE SKIP ADA B1100 STA TEMP * JSB DEXEC DEF *+5 DEF NODE2 DEF ICOD3 CONTROL, NO-ABORT DEF TEMP CONWD DEF B1 SKIP ONE LINE JMP ASCER ERROR RETURN * LOOP JSB DREAD READ A RECORD DEF *+6 DEF UDCB DEF IERRR DEF RECRD BUFFER DEF D128 REQUESTED LENGTH DEF LEN ACTUAL READ LENGTH * LDB LEN CPB MD1 LENGTH = -1 (I.E. EOF) ? JMP DONE YES, OUT CPA MD12 EOF ? (IERR=-12) JMP DONE YES SSA JSB ERCHK READ ERROR * JSB CNUMD CONVERT RECORD NUMBER DEF *+3 TO ASCII AND STUFF DEF REC# INTO PRINT LINE. DEF P3 USE P3 AS TEMP BUFR DLD P3+1 DST HEDR2 * SPC 2 * * THIS ROUTINE WILL SHIFT TO THE RIGHT THE LINE NUMBER * AND REPLACE THE LEADING BLANKS BY ZEROS. * LDA HEDR2+1 GET LAST 2 DIGITS AND B377 ISOLATE LOW DIGIT STA TEMP SAVE FOR LATER LDA HEDR2+1 GET LAST 2 DIGITS AGAIN AND HB377 KEEP UPPER BYTE CPA BLANK IS IT A BLANK? LDA HZERO YES REPLACE BY A HIGH 0 IOR TEMP MERG?^E WITH LAST DIGIT STA HEDR2+1 SAVE IN HEADER LDA HEDR2 GET FIRST 2 DIGITS AND B377 KEEP LOWER BYTE CPA LOBLK IS IT A BLANK? LDA LZERO YES, REPLACE BY A LOW ZERO STA TEMP SAVE LDA HEDR2 GET FIRST DIGITS AGAIN AND HB377 KEEP UPPER BYTE CPA BLANK IS IT A BLANK? LDA HZERO YES, REPLACE BY A HIGH ZERO IOR TEMP MERGE WITH SECOND DIGIT STA HEDR2 SAVE * LDA LEN ADD 4 TO THE BUFFER ADA B4 LENGTH FOR THE HEADER WORDS STA LEN * JSB DEXEC DEF *+6 DEF NODE2 DEF ICOD2 WRITE, NO-ABORT DEF P2 LU DEF HEDR1 BUFFER DEF LEN LENGTH JMP ASCER ERROR RETURN * ISZ REC# UPDATE THE RECORD NUMBER * JSB IFBRK DO THEY WANT TO STOP ? DEF *+1 SZA,RSS JMP LOOP NO,CONTINUE STA BRFLG YES, SAVE BREAK INDICATOR * DONE JSB DCLOS CLOSE THE FILE DEF *+3 DEF UDCB DEF IERRR * SSA ERROR? JSB ERCHK YES, REPORT IT (WON'T RETURN) * CLA CLEAR UDCB OPEN FLAG STA UOPNF JSB EOFPR PAGE-EJECT IF LP JMP QUERY * * LOCAL STORAGE AND CONSTANTS * AS.M1 ASC 1,-1 LEN NOP HEDR1 OCT 20040 HEDR2 NOP NOP OCT 20040 DOUBLE BLANK * * RECRD BSS 128 * * REC# NOP TITL OCT 20040 REP 3 NOP ASC 5, TYPE: TYP NOP ASC 11, NUMBER OF BLOCKS: SIZ NOP NOP ASC 10, LOCATED AT NODE: NOD NOP NOP NOP * * HED REMAT: DL REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * DL [,NAMR [,MSECU [,LISTLU]]] * * LIST NODE1 FILE DIRECTORY AT LOCAL LISTLU. * NAMR = NAME, CRN & TYPE FILTER FOR REMOTE DISC * OR FLOPPY BASED SYSTEM, OR LU OF CTU FOR CTU BASED SYSTEM. * M0300 LDB CP1 CHECK P1 TYPE CPB B1+ NUMERIC? RSS YES, P1 = CRN OR -LU JMP M0302 NO, MAY BE NAME FILTER JSB .DFER MOVE DASHES TO REQST DEF RQB+#REQ+3 DEF DASHS LDA P1 MOVE CRN OR -LU JMP M0310 TO REQST. * M0302 SZB FILTER SPECIFIED? JMP M0305 YES LDA DBBLK NO. SET FIRST WORD TO BLANKS STA P1 M0305 JSB .DFER MOVE NAME TO REQST DEF RQB+#REQ+3 DEF P1 * LDA TYPE1 TYPE FILTER SPECIFIED? SZA IOR HIBIT YES,SET SIGN BIT STA RQB+#REQ+8 MOVE TYPE FILTER TO REQST * LDA CRN1 MOVE LABEL TO REQST M0310 STA RQB+#REQ+7 * LDA P2 MOVE MASTER SECURITY CODE TO REQST STA RQB+#REQ+6 * LDA LSTLU GET DEFAULT LISTLU LDB CP3 LISTLU PARAM PRESENT? SZB,RSS NO, USE DEFAULT STA P3 * CLA INDICATE NEW REQUEST IN REQST STA RQB+#REQ+2 * M0315 CLA,INA SET IN STREAM TYPE STA RQB+#STR * LDA D34 INDICATE 68 CHAR LINE IN REQST STA RQB+#REQ+1 LDA NODE1 SET NODE IN REQST (REQST IS BEING STA RQB+#DST SENT TO NODE1) * * SEND REQST & PRINT DIRECTORY ON LIST LU * JSB #MAST SEND REQUEST TO NODE1 DEF *+7 DEF CNWD1 NO ABORT. DATA ASSOC WITH REPLY DEF L#REQ REQST LENGTH DEF DLDAT DATA BUFR DEF B0 NO DATA ASSOCIATED WITH REQST DEF D34 INCOMING DATA BUFR LENGTH DEF L#REQ MAX REPLY LENGTH JMP ASCER ERROR RETURN * LDA RQB+#REP NORMAL RETURN. CHECK STATUS SZA,RSS DONE? JMP M0320 NO JSB LCALS FORCE LOCAL NODE FOR EQTYP CALL LDA P3 GET LOCAL LISTLU JSB EQTYP CHECK ITS EQUIPMENT TYPE JSB LCALC RESET NODE CPA D10 IS IT A LINE PRINTER? RSS JMP QUERY NO LDA P3 YES, SET UP EXEC CALL TO IOR B1100 t DO A PAGE EJECT. STA TEMP * JSB EXEC LP PAGE EJECT DEF *+4 DEF B3 DEF TEMP DEF MD1 * JMP QUERY * M0320 JSB REIO PRINT A LINE ON LISTLU DEF *+5 DEF ICOD2 WRITE DEF P3 LISTLU DEF DLDAT DEF RQB+#REQ+1 JMP RIOER ERROR RETURN * JSB IFBRK CHECK BREAK FLAG DEF *+1 SZA,RSS IS IT SET? JMP M0315 NO, GET ANOTHER LINE STA BRFLG YES, SAVE BREAK INDICATOR JMP QUERY AND GET NEXT COMMAND. * DLDAT BSS 34 DLIST DATA BUFR DASHS ASC 3,------ L#REQ ABS #REQ+16 SKP HED REMAT: CL REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * CL [,LISTLU] * * LIST NODE1 CARTRIDGE DIRECTORY AT LOCAL LIST LU * M3000 LDA CP1 CHECK P1 TYPE. SZA CPA B1 NUMERIC LU? RSS YES. JMP ERR56 NO. ERROR. * DLD CP1 MOVE LIST LU DST CP3 FOR 'DL' PROCESSOR. DLD CLFLG SET FILTER =-1; FILTER+1 =0 DST P1 TO INDICATE A CARTRIDGE LIST REQUEST. CLA SEND A CLEAN STA P2 REQUEST BUFFER. JMP M0305 USE THE 'DL' PROCESSOR. * CLFLG OCT -1,0 * HED REMAT: AT REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * AT,[USER1.GROUP/PASSWORD[,USER2.GROUP/PASSWORD]] * AT,[PASSWORD1[,PASSWORD2]] * * CREATE AND ATTACH TO NON-INTERACTIVE SESSION AT NODE1 AND/OR NODE2. * * M3100 LDB CP1 FIRST PARAM GIVEN? SZB JMP M3102 YES. GO CHECK IF ASCII. LDA CP2 NO. SECOND PARAM GIVEN? SZA (IF NOT, LET ASCHK DO THE WORK) JMP M3105 YES. GO CHECK IF ASCII. M3102 JSB ASCHK CHECK 1ST PARAM ((B)=CP1). M3105 LDB CP2 SECOND PARAM, IF GIVEN, SZB MUST BE ASCII. JSB ASCHK * JSB #RMSM GO TO PROCESSOR ROUTINE. DEF *+7 DEF B1 #RMSM REQUEST CODE. 1 DEF INBUF "AT" COMMAND STRING. DEF INCNT STRING LENGTH, +WORDS. DEF NODE1 DEF NODE2 DEF LOGLU REMAT LOGGING LU. * JMP QUERY HED REMAT: DE REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * DE[,N1][,N2] * * DETACH FROM AND RELEASE NON-INTERACTIVE SESSION AT NODE1 (N1) * AND/OR NODE2 (N2). * * M3200 LDA CP1 IF FIRST PARAM IS LDB P1 SPECIFIED, IT MUST BE SZA "N1" OR "N2". JSB N1N2 * LDA CP2 LIKEWISE FOR SECOND PARAM. LDB P2 SZA JSB N1N2 (NO RETURN IF ERROR) * JSB #RMSM GO TO PROCESSOR ROUTINE. DEF *+7 DEF B2 #RMSM REQUEST CODE. DEF CP1 PARAM 1 FLAG (PARSE BUFFER). DEF CP2 PARAM 2 FLAG (PARSE BUFFER). DEF NODE1 DEF NODE2 DEF LOGLU REMAT LOGGING LU. * JMP QUERY * * N1N2 NOP CHECK PARAM FOR "N1" OR "N2". CPB "N1" RSS = "N1". CPB "N2" RSS = "N2". JMP OPER NEITHER...ERROR. JMP N1N2,I OK RETURN. * "N1" ASC 1,N1 "N2" ASC 1,N2 HED REMAT: EX REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * EX PROCESSOR * * TERMINATE THE OPERATOR INTERFACE PROGRAM. * M0500 JSB #RMSM LOG OFF ANY REMOTE SESSIONS. DEF *+2 DEF B0 * JSB REIO DISPLAY TERMINATION MESSAGE DEF *+5 ON LOG DEVICE. DEF ICOD2 DEF LOGLU DEF TRMSG DEF B6 JMP RIOER ERROR RETURN * JSB CLSFL CLOSE OPEN FILES. * JSB EXEC EXIT. DEF *+2 DEF B6 * TRMSG ASC 6, $END REMAT * HED REMAT: SW REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * SW [,NODE1 [,NODE2 [,SECURITY CODE]]] * OR * SW,LOCAL * OR * SW [,NODE1 [:USER.GROUP/PASS] [,NODE2 [:USER.GROUP/PASS] [,SECUR]]] * * SELECT NODE1 AND9/OR NODE2 FOR SUBSEQUENT OPERATOR * REQUESTS. IF NO PARAMETERS ARE GIVEN, DISPLAYS THE * CURRENT VALUES OF NODE1 AND NODE2. 'SW,LOCAL' SETS BOTH * NODES TO THE LOCAL NODE #. THE SECURITY CODE * SET IN 'LSTEN' MUST BE ENTERED IN ORDER TO SWITCH * FROM A LOCAL NODE TO A REMOTE NODE. * M0990 LDA CP1 SEE IF VALUE SUPPLIED SZA IF NOT SUPPLIED, PRINT CURRENT VALUE JMP M0991 SUPPLIED LDA CP2 IS PARAM 2 HERE ? SZA JMP M0991 YES SW MOD * LDA NODE1 NO, CHECK FOR NEG. LU SSA CMA,INA MAKE POSITIVE FOR CNUMD CALL STA TEMP JSB CNUMD SW DISPLAY FUNCTION DEF *+3 DEF TEMP DEF ORNM LDB MSIGN IF NODE1 IS LDA NODE1 NEGATIVE, THEN SSA INSERT MINUS SIGN STB ORNM+1 INTO DISPLAY BUFR. * LDA NODE2 REPEAT FOR NODE2 SSA CMA,INA STA TEMP JSB CNUMD DEF *+3 DEF TEMP DEF DSTNM LDB MSIGN LDA NODE2 SSA STB DSTNM+1 * JSB REIO DISPLAY MESSAGE DEF *+5 DEF ICOD2 DEF LOGLU DEF SWBUF DEF D18 MESSAGE LENGTH JMP RIOER ERROR RETURN * JSB #RMSM DISPLAY ACCOUNT NAMES FOR REMOTE DEF *+7 SESSIONS (IF ANY) AT NODE1 & NODE2. DEF MD1 #RMSM REQUEST CODE. DEF TEMP DUMMY PARAM. DEF TEMP DUMMY PARAM. DEF NODE1 DEF NODE2 DEF LOGLU LOGGING LU. * JMP QUERY GET ANOTHER REQUEST * M0991 JSB #RMSM PERFORM PRE-PROCESSING OF COMMAND FOR DEF *+7 OPTIONAL ACCOUNT-NAME QUALIFIERS ON DEF B3 NODE NUMBERS FOR REMOTE SESSIONS. DEF INBUF COMMAND BUFFER. DEF INCNT COMMAND LEN, +WORDS, ADJUSTED ON RETURN. DEF NODE1 DEF NODE2 DEF LOGLU LOGGING LU. * SZA IF THERE WERE NODE QUALIFIERS, JSB $PARS RE-PARSE CONVERTED SW COMMAND. * LDB CP1 CPB B2 1ST PARAM ASCII? JMP SWALF YES, CHECK FOR "LOCAL" SZB,RSS NO, IS IT MISSING? JMP SW1 YES, GO CHECK 2ND PARAM LDA P1 NO, GET IT CPA #NODE DOES HE WANT NODE1 LOCAL? RSS YES, GO CHECK 2ND PARAM JMP SW2 NO, WANTS REMOTE. CHECK HIM OUT * SW1 LDB CP2 SZB,RSS 2ND PARAM MISSING? JMP M0992 YES, LET HIM DO IT LDA P2 NO, GET IT CPA #NODE DOES HE WANT NODE2 LOCAL? JMP M0992 YES, ALLOW SWITCH SW2 LDA PRMPT NO, CHECK HIM OUT CPA "#" IS HE ALREADY REMOTE? JMP M0992 YES, LET HIM DO WHAT HE WANTS LDB CP3 GET 3RD PARAM FLAG JSB ASCHK IF NOT ASCII, WON'T RETURN LDB P3 GET 3RD PARAM BLF,BLF CMB CPB #SWRD SAME AS SECURITY CODE? RSS YES, ALLOW SWITCH JMP OPER NO, SWITCH NOT ALLOWED M0992 LDA NODE1 DEFAULT LDB CP1 CPB B1 PARAM NUMERIC ? LDA P1 YES, GET IT STA NODE1 SAVE IT LDB NODE2 DEFAULT LDA CP2 GET 2ND PARAM FLG CPA B2 2ND PARAMETER ALPHAMERIC? JMP OPER YES, ERROR CPA B1 NUMERIC? LDB P2 OK GET 2ND PARAM STB NODE2 SAVE IT * JSB #RMSM LOG ON TO ACCOUNT NAMES (IF GIVEN DEF *+2 IN ORIGINAL SW COMMAND). DEF MD2 * JMP QUERY GO BACK FOR NEXT COMMAND * SWALF DLD P1 GET THE FIRST 2 WORDS OF THE ALFAMERIC PARAMETER CPA ALO FIND IF THIS IS A "LOCAL" SWITCH. RSS THAT'S CLOSE ENOUGH JMP OPER FORGET IT LDA #NODE GET THE LOCAL NODE NUMBER AGAIN STA NODE1 SAVE IT IN NODE1 STA NODE2 AND IN NODE2 JMP QUERY GO BACK FOR NEXT COMMAND. * SWBUF ASC 4,NODE>1 = ORNM BSS 3 ASC 8, NODE2 = DSTNM BSS 3 ALO ASC 1,LO MSIGN ASC 1, - HED REMAT: TE REQUEST. * (C) HEWLETT-PACKARD CO. 1979 * * TE,-ASCII MESSAGE- PROCESSOR. * * SEND A MESSAGE TO THE NODE1 STATION OPERATOR. * M1000 EQU * JSB TELL1 CALCULATE BUFFER LNTH & ADD LOCAL NODE # JSB DMES1 SEND TO LOCAL NODE DEF NODE1 JMP ASCER REPORT ERROR JMP QUERY RETURN TO CALLER SPC 1 XLA1 XLA XPNTR,I DMS INSTRUCTION FOR SCANNING NRV SPC 2 * "BROADCAST" REQUEST * BRCST NOP REPORT ERROR BUT CONTINUE JSB TELL1 CALCULATE BUFFER LNTH & MOVE LOCAL NODE # DLD #NCNT SET UP BROADCAST LOOP DST XCNTR BRLUP EQU * DMS1 LDA XPNTR,I GET NODE # (XLA XPNTR,I IF DMS) NOP (STORAGE RESERVED FOR XLA IF DMS) CPA #NODE SAME AS LOCAL? JMP BRLED YES, NO NEED TO BROADCAST TO OURSELVES STA XNODE SAVE NODE NUMBER JSB CNUMD CONVERT NODE # TO ASCII DEF *+3 DEF XNODE NODE # DEF BRCM1 MESSAGE JSB EXEC PRINT "BROADCASTING TO " DEF *+5 DEF B2 DEF LOGLU DEF BRCMS DEF BRCML JSB DMES1 SEND TELLOP DEF XNODE JSB ERMSG LOG ERRORS, IF ANY. BRLED EQU * SPC 1 LDA XPNTR ADVANCE ADA NRVSZ NRV STA XPNTR POINTER ISZ XCNTR END OF LOOP? JMP BRLUP NO, CONTINUE IN LOOP JMP QUERY YES, EXIT LOOP. SPC 2 BRCMS ASC 11,BROADCASTING TO NODE# BRCM1 BSS 3 STORAGE FOR NODE # BRCML ABS *-BRCMS SPC 1 XNODE NOP XCNTR NOP BROADCAST LOOP COUNTER XPNTR NOP BROADCAST LOOP POINTER TELL1 NOP LDB CP1 SZB,RSS JMP OPER ERROR 10 IF NO MESSAGE. * CLB FIND THE COMMA IN INBUF. LDA BUFAD STA TEMP * M1010 LDA TEMP,I GET NEXT WORD. uN AND HB377 ALF,ALF CPA COM JMP M1020 COMMA IN LEFT BYTE. * LDA TEMP,I AND B377 CPA COM JMP M1030 COMMA IN RIGHT BYTE. * ISZ TEMP BUMP TO NEXT WORD. INB COUNT WORDS SKIPPED. JMP M1010 LOOP. * M1020 LDA TEMP,I LEFT. CLEAR COMMA AND B377 STA TEMP,I CMB,INB ADJUST WORD COUNT ADB INCNT STB INCNT CPB D37 IF EXACTLY 72 CHAR MESG, RSS ALLIGN MESSAGE TO WORD JMP M1040 BOUNDARY AND DECREMENT INCNT. LDA TEMP ADA D36 LDA A,I AND B377 CPA LOBLK RSS JMP M1040 LDB TEMP FORM DEST BYTE ADR CLE,ELB LDA B FORM SOURCE BYTE ADR INA JSB .MBT ALLIGN TO WORD BOUNDARY DEF D72 NOP LDA INCNT DECREMENT INCNT ADA MD1 STA INCNT JMP M1040 * M1030 ISZ TEMP RIGHT. BUMP TO NEXT WORD. INB * CMB,INB ADJUST WORD COUNT. ADB INCNT STB INCNT * M1040 EQU * JMP TELL1,I RETURN TO CALLER SPC 2 * SUBROUTINE TO SEND DMESG * JSB DMES1 * DEF * * * DMES1 NOP SUBROUTINE TO SEND DMESG LDA DMES1,I GET DEF TO NODE # STA DMES2 ISZ DMES1 JSB DMESG SEND MESSAGE TO NODE1 DEF *+4 DMES2 NOP ADDRESS OF NODE # DEF TEMP,I BUFFER DEF INCNT LENGTH. SZA,RSS ERROR? TAKE ERROR EXIT ISZ DMES1 NO ERROR, TAKE "GOOD" EXIT JMP DMES1,I RETURN TO CALLER HED REMAT: LO REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * LO PROCESSOR * * LO [,NAMR [,PARTITION # [,# PAGES]]] M-SYSTEMS * LO,NAMR L-SYSTEMS * * LOAD AN ABSOLUTE PROGRAM FROM A NODE1 FILE OR * LOCAL 'LU' (NAMR) TO AN RTE-M OR -L SYSTEM AT NODE2. * DEFAULT FOR NAMR IS LU 4 IN M SYSTEMS. * * IN RTE-L SYSTEMS NAMR IS NOT OPTIONAL AND LOADING * FROM AN LU IS ILLEGAL. * M1400 LDB CP1 GET 1ST PARAM FLAG LDA B4 GET DEFAULT LOCAL LU (=4) SZB,RSS MISSING? STA P1 YES, USE DEFAULT LDA P1 NO, GET THE PARAM SZA,RSS IF ZERO, JMP OPER GIVE ERROR. * JSB .DFER SAVE FILE NAME DEF RQB+#PMS+2 OR LU IN DEF P1 REQUEST BUFFER. * * FORMAT 1ST APLDR SCHED-PARAM & SET INTO REQST BUFR * LDA LOGLU AND B77 SET FUNCTION CODE TO 1 IF BOTH ALF P2 & P3 ARE MISSING OR 0, ELSE TO IOR ICOD1 2. INCLUDE REMOTE BIT & LOGLU. SET LDB P2 INTO REQST BUFR. SZB,RSS LDB P3 SZB INA STA RQB+#PMS * * FORMAT 2ND APLDR SCHED-PARAM & SET INTO REQST BUFR * LDB CP2 GET 2ND PARAM FLAG SZB MISSING? JSB INTCK NO, MUST BE NUMERIC LDA P2 GET PARTITION # PARAM AND B77 ISOLATE LOWER 6 BITS STA TEMP SAVE LDB CP3 GET 3RD PARAM FLAG? SZB MISSING? JSB INTCK NO, MUST BE NUMERIC LDA P3 GET # PAGES PARAM AND B37 ISOLATE LOWER 5 BITS ALF,ALF POSITION TO BITS 10:14 ALS,ALS IOR TEMP INCLUDE PARTITION # STA RQB+#PMS+1 SET INTO REQST BUFR * DLD SECU1 SET SECU CODE & CRN DST RQB+#IBF INTO REQST BUFR. LDA NODE1 SET FILE NODE INTO STA RQB+#IBL+1 REQST BUFR. * LDA NODE2 SET REMOTE RTE-M STA RQB+#DST NODE # INTO REQST BUFR. * JMP M1505 GO FINISH UP & SEND REQST HED REMAT: FL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * FL(USH) PROCESSOR * * FL,NAMR,NODE # * * CLOSE FILE1 AT NODE1 (PREVIOUSLY SELECTED BY SW * COMMAND) TO ANY USER AT THE GIVEN NODE #. IF * NODE #̬ = -1, CLOSE FILE1 TO USERS AT ALL NODES. * NOTE THAT ALL MAIN PARAMETERS ARE REQUIRED, * PLUS THE NAMR SUBPARAMETER 'CRN'. * THIS COMMAND IS ONLY ALLOWED FROM A TTY-TYPE * INPUT DEVICE. * * M2401 LDA LUTYP INPUT LU MUST BE TTY SZA JMP ERR45 IT IS NOT * LDB CP1 GET 1ST PARAMETER FLAG JSB ASCHK MUST BE ASCII JSB .DFER SET FILE NAME DEF RQB+#DCB INTO REQST BUFR DEF P1 AND INTO MESG JSB .DFER DEF FMSG1+3 DEF P1 * LDA CRN1 GET CRN SUBPARAMETER SZA,RSS GIVEN AND NON-ZERO? JMP OPER NO, GIVE INPUT ERROR STA RQB+#ICR YES, SET INTO REQST BUFR * LDB CP2 GET 2ND PARAM FLAG JSB INTCK MUST BE NUMERIC LDA P2 GET 2ND PARAMETER SSA IS IT POSITIVE? CPA MD1 NO, THEN IT BETTER BE -1 RSS IT IS. OK JMP OPER IT ISN'T. ERROR * STA RQB+#NOD SET P2 INTO REQST BUFR SSA NODE # POSITIVE? JMP M2410 NO JSB CNUMD YES, CONVERT NODE # DEF *+3 DEF P2 NODE # DEF FMSGA+3 LDA .FMGA MOVE NODE # LDB .FMG2 JSB .MVW DEF D8 NOP LDA D27 SET MSG LENGTH STA TEMP FOR REIO CALL JMP M2415 * M2410 LDA .FMGB MOVE "ALL NODES" TO LDB .FMG2 OUTPUT MSG JSB .MVW DEF B7 NOP LDA D26 SET MSG LENGTH STA TEMP FOR REIO CALL * M2415 JSB CNUMD CONVERT NODE1 DEF *+3 DEF NODE1 DEF FMSG1+10 * JSB REIO OUTPUT MESSAGE TO LOGLU DEF *+5 DEF ICOD2 DEF LOGLU DEF FMSG1 DEF TEMP MSG LENGTH JMP RIOER ERROR RETURN * LDA P.STK,I GET INPUT LU IOR B400 INCLUDE ECHO BIT STA TEMP SET CONWD FOR REIO * JSB REIO DEF *+5 DEF ICOD1 DEF TEMP CONWD DEF TEMP+1 INPUT BUFR DEF B1 MAX INPUT LENGTH JMP RIOER ERROR RETURN * LDA TEMP+1 GET INPUT CPA "NO" WAS ANSWER "NO"? JMP QUERY YES, SO GET NEXT COMMAND CPA "YE" WAS ANSWER "YES"? RSS YES, CONTINUE JMP OPER MUST BE "YES" OR "NO". ERROR * LDA B6 SET STREAM, STA RQB+#STR DEST, AND LDA NODE1 FCODE INTO STA RQB+#DST REQST BUFR LDA D13 STA RQB+#FCN * JSB #MAST SEND REQST BUFR TO NODE1 DEF *+7 DEF CNWD1 NO ABORT DEF L#NOD REQST BUFR LENGTH DEF * DUMMY DATA BUFR DEF B0 NO DATA ASSOCIATED WITH REQST DEF B0 NO DATA ASSOCIATED WITH REPLY DEF L#NOD MAX REQST/REPLY LENGTH * JMP ASCER PROCESS ASCII ERROR CODE LDA RQB+#EC2 CHECK NUMERIC CODE STA IERRR IN THE REPLY SSA IF NEGATIVE. JSB ERCHK JSB CNUMD CONVERT # ENTRIES DEF *+3 DEF RQB+#EC2 FLUSHED TO ASCII AND DEF FMSG3+12 SET INTO MESSAGE. * JSB REIO OUTPUT MESSAGE TO LOGLU DEF *+5 DEF ICOD2 DEF LOGLU DEF FMSG3 DEF D15 JMP RIOER ERROR RETURN * JMP QUERY GET NEXT COMMAND * ERR45 LDA D45 REPORT ERROR JMP OPERS SPC 1 FMSG1 ASC 19,CLOSE AT NODE TO USERS AT FMSG2 BSS 8 .FMG2 DEF FMSG2 .FMGA DEF *+1 FMSGA ASC 8, NODE ? _ * .FMGB DEF *+1 ASC 7, ALL NODES? _ * FMSG3 ASC 15,# RFAM ENTRIES FLUSHED = XXXXX "YE" ASC 1,YE "NO" EQU SWBUF ASCII "NO" L#NOD ABS #NOD+1 HED REMAT: PU REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * PU PROCESSOR * * PU,NAMR * * PURGE A FILE 'NAMR' AT NODE1. * * M2501 LDA CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDA NODE1  STA CRN1+1 FORMAT THE CRN ARRAY * JSB DPURG PURGE THE FILE DEF *+6 DEF UDCB DEF IERRR DEF P1 FILE NAME DEF SECU1 SECURITY CODE DEF CRN1 CRN ARRAY * SSA JSB ERCHK ANY ERROR ?o JMP QUERY GET NEXT REQUEST HED REMAT: RN REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * RN PROCESSOR * * RN,NAMR,NEW NAME * * RENAME A FILE AT NODE1. * * M2550 LDB CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDB CP2 GET 2ND PARAM FLAG JSB ASCHK NEW NAME MUST BE ASCII * LDA NODE1 STA CRN1+1 FORMAT CRN ARRAY * JSB DNAME RENAME THE FILE DEF *+7 DEF UDCB DEF IERRR DEF P1 OLD NAME DEF P2 NEW NAME DEF SECU1 SECURITY CODE DEF CRN1 CRN ARRAY * SSA JSB ERCHK ANY ERROR ? JMP QUERY GET NEXT HED REMAT: CR REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * CR PROCESSOR * * CR,NAMR * * CREATE A FILE AT NODE1. * * M2701 LDB CP1 GET 1ST PARAM FLAG JSB ASCHK MUST BE ASCII * LDA SIZE1 GET # BLOCKS PARAM ADA MD1 ERROR IF <= 0 SSA JMP OPER * LDA CRN1 FORMAT THE LDB NODE1 CRN ARRAY DST TEMP * JSB DCRET CREATE THE FILE DEF *+8 DEF UDCB DEF IERRR DEF P1 NAME DEF SIZE1 # BLOCKS/REC-SIZE (2-WORD ARRAY) DEF TYPE1 TYPE DEF SECU1 ISECU DEF TEMP CRN ARRAY (2 WORDS) * SSA JSB ERCHK * JSB DCLOS CLOSE THIS NEW FILE DEF *+3 DEF UDCB DEF IERRR * SSA JSB ERCHK ERROR JMP QUERY GET NEXT HED REMAT: IO REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * IO REQUEST (L-SERIES ONLY) * * IO (ANY PARAMETERS IGNOR+nED) * * LIST THE SYSTEM I/O CONFIGURATION FROM NODE1 TO THE LIST LU * AT THE LOCAL NODE. * * M1450 LDA LSTLU OUTPUT TO LIST LU. AND B77 ALF POSITION FOR REQUEST. IOR HIBIT REMOTE BIT. IOR B5 I/O FCN CODE FOR APLDR-L. STA RQB+#PMS SET IN REQUEST BUFFER. JMP M1504 SET REMOTE NODE & SCHED APLDR. HED REMAT: PL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * PL REQUEST * * PL [,LIST LU [,OPT]] M-SYSTEMS (OPT IS INTEGER) * PL [,OPT] L-SYSTEMS (OPT IS ASCII) * * LIST PROGRAM INFO FROM NODE1 TO THE LISTLU (DEFAULT IS LOGLU) * AT THE LOCAL NODE. IN M-SYSTEMS, IF OPT=0, LIST * ALL PROGRAMS, PRIORITIES, & BOUNDS. IF OPT=1, LIST * PARTITIONS & THEIR PROGRAMS, PARTITION SIZE, AND * PAGE #. * * IN L-SYSTEMS, OPT CAN BE ONE OF THE PROGRAM STATUS CODES * DESCRIBED IN THE RTE-L DOCUMENTATION WHICH WILL CAUSE A * SELECTIVE LIST OF ONLY THOSE PROGRAMS WITH THAT STATUS. * THERE ARE 2 ADDITIONAL OPTIONS: 'IT' (LIST TIME-LISTED * PROGRAMS) AND 'MB' (LIST MEMORY BOUNDS OF EACH PROGRAM). * IF NO OPTION IS SPECIFIED, ALL PROGRAMS, THEIR STATUS, * PRIORITY, AND POINT OF SUSPENSION ARE LISTED. * M1500 CLA STA RQB+#PMS+2 LDB CP1 GET TYPE FLAG PRAM #1. CPB B1 NUMERIC? JMP M1502 YES. LDA P1 GET 1ST PARAM. CPB B2 ASCII? STA RQB+#PMS+2 YES. STORE IN REQUEST. JMP M1503 * M1502 LDA P1 GET 1ST PARAM SZA,RSS ZERO OR MISSING? M1503 LDA LSTLU YES, USE DEFAULT LIST LU. AND B77 ALF POSITION LIST LU IOR HIBIT INCLUDE REMOTE-BIT STA RQB+#PMS SET INTO REQST BUFR * LDB CP2 GET 2ND PARAM FLAG SZB MISSING? JSB INTCK NO, MUST BE NUMERIC LDA P2 GET 2ND PARAM STA RQB+#PMS+1 SET INTO REQST BUFR * M1504 LDA NODE1 SET REMOTE NODE # STA RQB+#DST INTO RE@QST BUFR. * M1505 LDA B3 SET STREAM TYPE STA RQB+#STR INTO REQST BUFR. * LDA D9 SET ICODE TO SCHED- STA RQB+#ICD WITH-WAIT. * JSB .DFER SET "APLDR"  DEF RQB+#PGN INTO REQST BUFR. DEF APNAM SPC 2 * * HERE WE SEND REQST TO SCHEDULE APLDR WITH WAIT * TO DO A DOWN LOAD, PROGRAM LIST, OR IO (L-SERIES). * CONTROL WILL BE RETURN WHEN APLDR IS COMPLETE * JSB #MAST SEND REQUEST TO SPECIFIED NODE DEF *+7 DEF CNWD2 NO ABORT, LONG TIMEOUT DEF L#FN1 REQST LENGTH DEF * DUMMY DATA BUFR DEF B0 NO DATA ASSOCIATED WITH REQST DEF B0 NO DATA ASSOCIATED WITH REPLY DEF L#FN1 MAX REQST/REPLY LENGTH JMP ASCER ERROR RETURN * LDB RQB+#EC2 GET B-REG VALUE FROM REPLY SZB,RSS ANY RETURN PARAMETERS? JMP QUERY NO * LDA RQB+#RPM YES, GET 1ST PARAM CPA HIBIT SPECIAL I/O ERROR INDICATOR? RSS YES, APLDR UNABLE TO PRINT MESSAGE JMP QUERY NO, APLDR PRINTED ALL MESSAGES DLD RQB+#RPM+1 GET 2ND TWO RETURN PARAMS (ASCII JMP ASCER ERROR CODE) AND DISPLAY. SPC 3 APNAM ASC 3,APLDR L#FN1 ABS #FNO+1 HED REMAT: SL REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * SLAVE PROGRAM LIST REQUEST * SLIST (,LIST LU) * * LIST ALL PTOP SLAVE PROGRAMS AT NODE1 * ON THE LOCAL LIST LU * * * M1700 LDA CP1 SEE IF LIST LU SUPPLIED LDB LSTLU GET DEFAULT CPA B1 IF TYPE=1 USE SUPPLIED RSS YES...DON'T USE DEFAULT STB P1 SAVE FOR PRINTING LDA DBBLK GET SPACE WORD STA CP3 SAVE FOR NAME MOVE * LDA B7 "SL" FUNCTION CODE JSB PTPSB GO FORMAT REQUEST AND CALL #MAST DEC 128 DATA BUFFER SIZE * JSB REIO PRINT HEADER MESSAGE DEF *+5 DEF ICOD2 DEF P1 ( DEF HDMSG DEF D10 JMP RIOER ERROR RETURN * LDA BUFAD GET READ BUFFER ADDRESS LDB 0,I 1ST WORD HAS # OF ENTRIES CMB,INB,SZB,RSS JMP LPFOR NO ENTRIES STB COUNT SET LOOP COUNTER INA POINT TO 1ST NAME * RDLOP STA RTEMP SET NAME BUFFER POINTER * JSB .DFER MOVE NAME TO PRINT AREA DEF P3 RTEMP NOP * JSB REIO WRITE OUT LINE DEF *+5 DEF ICOD2 DEF P1 WRITE LU DEF CP3 DEF MD7 7 CHARACTERS JMP RIOER ERROR RETURN * LDA RTEMP ADA B3 GET TO NEXT ENTRY ISZ COUNT BUMP COUNTER JMP RDLOP GET NEXT ENTRY * LPFOR JSB LCALS SEE IF IT IS THE LINE-PRINTER LDA P1 GET LU JSB EQTYP GET EQT TYPE JSB LCALC CPA D10 LP? RSS YES JMP QUERY NO LDA P1 IOR B1100 OR IN CONTROL WORD STA P1 * JSB EXEC DO A PAGE EJECT DEF *+4 DEF B3 DEF P1 DEF MD1 * JMP QUERY AND RETURN FOR NEXT ENTRY SPC 1 COUNT NOP HDMSG ASC 10, ACTIVE SLAVE PROGS HED REMAT: SO REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * SO REQUEST * SO [,PNAME] * * TERMINATES A PTOP SLAVE PROGRAM AT NODE1. IF NO * PROGRAM IS SPECIFIED, TERMINATES ALL CURRENT * PTOP SLAVES AT THE NODE1 CPU. * M1800 JSB .DFER MOVE NAME INTO REQUEST DEF RQB+#PCB DEF P1 * LDA B6 "SO" IS PTOP FUNCTION 6 JSB PTPSB FORMAT REQUEST AND CALL #MAST DEC 0 NO DATA BUFFER * JMP QUERY RETURN SPC 4 * * THIS SUBROUTINE IS USED IN COMMON FOR "SO" AND "SL". IT * FORMATS THE PTOP REQUEST AND CALLS #MAST TO SEND THE * REQUEST AND GET THE REPLY (AND DATA). * PTPSB NOP STA RQB+#FCD SAVE PTOP FUNCTION CODE LDA B4 STA RQB+#STR SET STREAM TYPE (4) LDA NODE1 STA RQB+#DST SET REQST DESTINATION NODE CLA STA RQB+#EC1 INITIALIZE ERROR FIELDS STA RQB+#ENO * JSB #MAST SEND REQ (& RCV DATA IF SL) DEF *+7 DEF CNWD1 NO ABORT DEF L#PCB 17 WORD REQUEST DEF INBUF DEF B0 NO DATA ASSOCIATED WITH REQST DEF PTPSB,I INCOMING DATA BUFR LENGTH DEF L#PCB JMP ASCER #MAST DETECTED ERROR * ISZ PTPSB JMP PTPSB,I RETURN * L#PCB ABS #PCB+3 * * HED REMAT: LC REQUEST * (C) HEWLETT-PACKARD CO. 1979 * * $LC * * DISPLAY LOCAL NODE # ON LOGLU. * * M2100 LDA #NODE GET LOCAL NODE # STA P3 SAVE IT TEMPORARILY JSB CNUMD CONVERT TO ASCII DEF *+3 DEF P3 DEF PRMG1 * JSB REIO SEND MESSAGE DEF *+5 DEF ICOD2 DEF LOGLU DEF PRBUF DEF D10 JMP RIOER ERROR RETURN * JMP QUERY GO BACK FOR MORE INPUT SPC 2 * * PRBUF ASC 7,LOCAL NODE = PRMG1 ASC 3, XXXXX HED REMAT: SUBROUTINES * (C) HEWLETT-PACKARD CO. 1979 * * SUBROUTINE TO CALCULATE ACTUAL CHECKSUM AND COMPARE * IT TO THE CHECKSUM IN THE INPUT RECORD. RETURNS *+1 * IF ERROR DETECTED, ELSE *+2. EXPECTS RECORD TO BE IN * 'INBUF', AND 'CSFLG' TO BE SET AS FOLLOWS: 0=NO CHECKSUM, * "BR"=BINARY RELOCATABLE RECORD, "AB"=ABSOLUTE RECORD. * CKSUM NOP LDA CSFLG SZA,RSS CHECKSUM REQUIRED? JMP CK4 NO * LDA INBUF CHECK RECORD LENGTH ALF,ALF IN WORD 1. STA RLEN CMA,INA ADA B377 SSA OK? JMP CKSUM,I NO, TAKE ERROR RETURN (*+1) * LDA INBUF+1 START CALCULATED CKSUM STA CSCAL WITH WORD 2. * LDA MD1 CALCULATE OFFSET OF -1 LDB CSFLG FOR BR, +1 FOR BA CPB "BR" BR? JMP CK1 NO LDA B1 YES, SET OFFSET TO +1  LDB CSCAL AND ADD WORD 3 TO CKSUM ADB INBUF+2 STB CSCAL * CK1 ADA RLEN COMPUTE LAST WORD ADR = ADA BUFAD RECORD LENGTH + BUFR ADR STA BPLST + OFFSET. * INA SAVE CHECKSUM FROM INPUT LDA A,I RECORD (LAST WORD IF BA, LDB CSFLG WORD 3 IF BR) IN CPB "BR" 'CSINP'. LDA INBUF+2 STA CSINP * * CALCULATED CHECKSUM 'CSCAL' SO FAR CONTAINS THE SUM * OF WORD 2 AND, IF BR FORMAT, WORD 3. NOW ADD WORDS * 4 THRU THE LAST DATA WORD (ADR=BPLST) AND COMPARE * WITH CHECKSUM FROM INPUT RECORD, 'CSINP'. * LDB BUFAD INITIALIZE B = WORD 4 ADR ADB B3 * CK2 LDA B DOES BUFR POINTER EXCEED CMA,INA ADR OF LAST WORD? ADA BPLST SSA JMP CK3 YES, CHECKSUM COMPLETE LDA CSCAL NO, ADD THE ADA B,I CURRENT WORD, STA CSCAL BUMP POINTER INB AND LOOP. JMP CK2 * CK3 LDA CSCAL IF CALCULATED CHECKSUM CPA CSINP = INPUT RECORD CHECKSUM, CK4 ISZ CKSUM RETURN *+2, JMP CKSUM,I ELSE *+1. * * RLEN NOP RECORD LENGTH CSCAL NOP CALCULATED CHECKSUM CSINP NOP INPUT CHECKSUM BPLST NOP PNTR TO LAST DATA WORD SPC 2 * * SUBROUTINE TO CHECK FORMAT PARAMETER OF $DU AND * $ST COMMANDS TO SEE IF CHECKSUM IS REQUIRED, AND * TO SET THE PROPER FILE TYPE PARAMS FOR THE FILE * TO BE CREATED IN $ST. * CKFMT NOP LDA B400 SET ECHO BIT STA SUBF CLA CLEAR THE STA CSFLG CHECKSUM FLAG. LDA CP3 GET FORMAT PARAM FLAG SZA,RSS PRESENT? JMP CKF01 NO * LDB P3 YES, GET FORMAT PARAM CPB "AS" ASCII? JMP CKF01 YES LDA B300 NO, SET CONTROL BITS STA SUBF V AND M. * CPB "BR" BR FORMAT? | RSS YES JMP TRYBN NO STB CSFLG SET CHECKSUM FLAG LDA TYPE2 GET PARAM 2 FILE TYPE SZA,RSS GIVEN? LDA B5 NO, DEFAULT TO TYPE 5 STA TYPE2 JMP CKF01 * TRYBN CPB "BN" BN FORMAT? JMP CKF01 YES, V & M BITS ALREADY SET * CPB "BA" BA FORMAT? RSS YES JMP OPER NO, ILLEGAL FORMAT PARAM STA CSFLG SET CHECKSUM FLAG LDA TYPE2 SZA,RSS TYPE GIVEN? LDA B7 NO, DEFAULT TO TYPE 7 STA TYPE2 LDA B2300 STA SUBF * CKF01 LDA TYPE2 IF TYPE NOT GIVEN, SZA,RSS DEFAULT TO TYPE 3. LDA B3 STA TYPE2 JMP CKFMT,I SPC 2 * * SUBROUTINE TO TEST FOR END OF FILE ON LOCAL DEVICES. * * TEMPM = EQT STATUS WORD. * INCNT = EQT WORD COUNT. * LUTYP = EQUIPMENT TYPE. * JSB EOFCK * EOF RETURN * NORMAL RETURN * EOFCK NOP CLE LDA LUTYP EOF DEPENDS ON DEVICE. SZA,RSS JMP EOF1 TTY. CPA B1 JMP EOF1 PHOTOREADER. CPA D9 JMP EOF4 CARD READER. CPA D13 JMP EOF4 MARK SENSE. CCE DEFAULT TO MAG TAPE. * EOF1 LDA TEMPM GET STATUS WORD. ALF,ALF SEZ,RSS IF E=1, CHECK BIT 7. JMP EOF2 SSA JMP EOF3 EOF2 RAL,RAL CHECK BIT 5. SSA,RSS JMP EOF5 NO EOF. * EOF3 LDA LUTYP END OF FILE. SZA IF TTY, OUTPUT CAR. RET. JMP EOFND * JSB DEXEC DEF *+6 DEF #NODE LOCAL NODE DEF ICOD2 WRITE, NO-ABORT DEF P.STK,I LU DEF CR DEF B1 JMP ASCER ERROR RETURN * JMP EOFND * EOF4 LDA INCNT CHECK FOR BLANK CARD. SZA EOF5 ISZ EOFCK EOFND JSB LCALC CLEAR IF LOCAL JMP EOFCK,I * * SUBROUTINE TO CHECK FOR ASCII OR NAMR PARAMETER. ENTER * WITH (B) = PARAM FLAG. IF PARAM OK, RETURNS WITH * REGISTERS UNCHANGED. WILL NOT RETURN IF ERROR FOUND. * ASCHK NOP (B) = PRAMS FLAG WORD SZB,RSS JMP ERR55 IF NOT THERE OR CPB B1 IF NUMERIC, JMP ERR56 GIVE ERROR. JMP ASCHK,I * * SUBROUTINE TO CHECK INTEGER PARAMS. ENTER WITH (B) = PARAM * FLAG. IF PARAM NUMERIC, RETURNS WITH REGISTERS UNCHANGED. * WILL NOT RETURN IF ERROR FOUND. * INTCK NOP SZB,RSS JMP ERR55 ERROR 55 IF MISSING. CPB B1 PARAM NUMERIC? JMP INTCK,I YES, RETURN JMP ERR56 ERROR 56 IF NOT NUMERIC. * * SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU AT NODE2 * EQTYP NOP (A) = LU. STA TEMP1 ADA MD1 IF LU=1 (SYSTEM CONSOLE), SZA,RSS THEN EQUIP-TYPE CODE MUST JMP EQTYP,I BE 0, SO RETURN WITH A=0. * JSB DEXEC REMOTE STATUS CALL DEF *+7 DEF NODE2 DEF ICD13 STATUS, NO-ABORT DEF TEMP1 ICNWD DEF TEMP2 EQT5 RETURNED HERE DEF TEMP2+1 EQT4 RETURNED HERE DEF SUBCH SUBCHANNEL INFO RETURNED HERE JMP EQTYE ERROR RETURN * LDA TEMP2 ALF,ALF AND B77 STA TEMP2 CPA B5 DVR05? JMP SUBC? YES CPA B7 DVR07? JMP SUBC? YES JMP EQTYP,I NO, RETURN. A = EQUIP-TYPE * SUBC? CLA IF REMOTE OP SYSTEM LDB D#OPS IS RTE-L, CPB $RTEL THERE IS NO SUB-CHANNEL. JMP EQTYP,I LDA SUBCH GET 3RD STATUS WORD AND B17 ISOLATE SUBCHAN # SZA IF SUBCHAN=0, RETURN LDA TEMP2 WITH A=0, ELSE A=DVR TYPE. JMP EQTYP,I * EQTYE JSB ERMSG CANNOT CONTINUE IF ERROR JMP ABORT ON DEXEC STATUS CALL. * $RTEL DEC -31 SUBCH NOP SUBCHANNEL # SPC 1 * * SUBROUTINE TO FORCE NODE2 LU TO LOCAL * CALLING SEQUENCE * JSB LCALS * NORMAL R.<ETURN * LCALS NOP LDA #NODE GET LOCAL NODE # LDB NODE2 STA NODE2 STORE LOCAL # STB DESTX SAVE THE REAL ONE JMP LCALS,I AND RETURN SPC 1 DESTX NOP SPC 1 * * SUBROUTINE TO RESET NODE2 LU * CALLING SEQUENCE * JSB LCALC * NORMAL RETURN * LCALC NOP LDB DESTX FETCH THE OLD ONE STB NODE2 RESTORE NODE2 JMP LCALC,I AND RETURN SPC 1 * * SUBROUTINE TO PROCESS ERRORS IN RFA CALLS. * ERCHK NOP LDA IERRR CAN BE POS. OR NEG. SZA,RSS JMP ERCHK,I NO ERROR. * ASCER JSB ERMSG DISPLAY ASCII ERROR MESSAGE. * RESET LDA STKHD RESET STACK POINTER STA P.STK CLA RESET XFR FILE STA TRCRN VARIABLES TO STA TRSEC DEFAULTS. LDA #NODE STA TRNOD * JSB CLSFL CLOSE FILES CURRENTLY OPEN. * LDA TRFLG IF RUNNING FROM SCHEDULE- SZA PARAM COMMAND FILE, JMP ABORT PRINT MESSAGE AND EXIT. * JSB LCALS SET FOR LOCAL EQT CHECK LDA P.STK,I GET INPUT LU JSB EQTYP GET IT'S EQUIP-TYPE CODE JSB LCALC RESET NODE2 SZA,RSS TTY DEVICE? JMP QUERY YES * ABORT JSB CLSFL CLOSE FILES CURRENTLY OPEN * JSB EXEC TERMINATE SELF DEF *+4 DEF B6 DEF B0 DEF B3 * * SUBROUTINE TO CLOSE THE COMMAND FILE OPEN TO TRDCB, * OR USER FILE OPEN TO UDCB IF EITHER OR BOTH ARE OPEN. * CLSFL NOP LDA TOPNF SZA,RSS TRANSFER FILE OPEN? JMP CLOS2 NO * JSB DCLOS YES, CLOSE IT DEF *+3 DEF TRDCB DEF IERRR * CLOS2 LDA UOPNF SZA,RSS USER FILE OPEN? JMP CLOS3 NO * JSB DCLOS YES, CLOSE IT DEF *+3 DEF UDCB DEF IERRR * CLOS3 CLA STA TOPNF CLEAR OPEN FLAGS. STA UOPNF JMP CLSFL,I RETURN. SPC 2 * * SUBROUTINE TO OUTPUT ASCII ERROR MESSAGE. * ERMSG NOP JSB DSERR CALL ROUTINE TO RETURN DS DEF *+2 ERROR PARAMETERS. DEF ASERM+4 * JSB REIO DISPLAY RETURNED DSERR BUFFER. DEF *+5 DEF ICOD2 WRITE DEF LOGLU DEF ASERM DEF D28 NOP ERROR RETURN * JMP ERMSG,I RETURN. * ASERM ASC 4,/REMAT: BSS 24 BUFFER FOR "DSERR". SPC 5 RIOER CLE RSS RIOAB CCE STA ASERM+4 STB ASERM+5 * JSB REIO DISPLAY "IOXX" ERROR. DEF *+5 DEF ICOD2 DEF LOGLU DEF ASERM DEF B6 NOP * SEZ JMP ABORT JMP QUERY SKP * * BELOW SUBROUTINE IS SPECIAL VERSION OF "$PARS". IS IS UNPRIVILEGED * AND WILL ALSO HANDLE UP TO 2 "NAMR" FILE FORMATS. * $PARS NOP LDB INCNT BLS CMB,SSB,RSS JMP $PARS,I GET OUT IF NEGATIVE COUNT STB ICNT SAVE NEG. CHARACTER COUNT LDA BUFAD RAL STA IBPNT SAVE BUFFER BYTE ADDRESS LDA SUBLA STA NAMRP INITIALIZE SUBPARAMETER ADDR LDB PBUFA GET PARSING BUFFER ADDRESS STB PARSA LDA MD39 STA $TEMP CLA STA 1,I INITIALIZE PARSING BUFFER TO ZEROES INB ISZ $TEMP JMP *-3 * * PROCESS A NEW FIELD NXFLD LDB NPOSA SAVE INITIAL BYTE ADDR OF FIELD CLA NXFL2 STA NMSET MODIFY INSTRUCTION STB $TEMP CLA STA OVAL INITIALIZE OCTAL ACCUMULATION STA FCNT INITIALIZE COUNT OF BYTES/FIELD STA VAL SET CURRENT RUNNING NUMERIC VALUE * JSB GETC GET 1ST CHARACTER IN FIELD JMP NULL NULL FIELD DETECTED STA FIRST SAVE IT CCB ADB IBPNT STB $TEMP,I CPA NEG "-"? JMP NXTPN * NXTN ADA N60 SUBTRACT "0" SSA JMP ASCII TOO LOW TO BE NUMERIC STA $TEMP ADA MD10 SSA,RSS JMP ASCII TOO HIGH TO BE NUMERIC LDA OVAL ALF,RAR OCTAL VALUE * 8 IOR $TEMP + NEW CHARACTER STA OVAL LDA VAL MPY D10 DECIMAL VALUE * 10 ADA $TEMP + NEW DIGIT STA VAL * NXTPN JSB GETC GET ANOTHER DIGIT JMP NMDON END OF FIELD CPA COLON COLON FOUND? RSS YES JMP NXTP1 NO LDB FIRST GET FIRST CHAR IN FIELD CPB NEG NEGATIVE SIGN? RSS YES JMP NXTP1 NO LDB VAL IS VALUE SZB,RSS ZERO? JMP NXTA1 YES, TREAT AS ASCII * NXTP1 CPA ASCB ="B"? RSSI RSS YES JMP NXTN PROCESS CHARACTER * JSB GETC GOT A "B", SEE IF END OF FIELD RSS IT IS, SKIP JMP ASCII TREAT AS ASCII LDB FIRST CPB NEG NEGATIVE SIGN? JMP *+3 YES, TREAT AS ASCII LDB OVAL USE OCTAL VALUE JMP NMSET * LDB NMSET SZB DOING A NAMR SUBPARAMETER? JMP SUBA2 YES JMP ENDA NO, WRAP-UP ASCII FIELD * NULL LDA DLIMF NAMR DELIMITER? SZA JMP ENDS1 YES, NULL NAMR FILED JMP ENDCK NO, NULL PARAMETER FIELD * NMDON LDA FIRST GET FIRST CHAR IN FIELD LDB VAL GET VALUE OF FIELD CPA NEG FIRST CHAR = NEGATIVE SIGN? RSS YES JMP NMSET NO SZB,RSS IS THE VALUE ZERO? JMP ENDA YES, TREAT AS ASCII CMB,INB NO, NEGATE VALUE * NMSET NOP THIS HAS RSS IF A NAMR PARAMETER JMP NONSB STORE PARAMETER * DONE PROCESSING THIS NAMR SUBPARAMETER STB SUBAD,I SAVE SUBPARAMETER IN NAMR BUFFER * ENDS1 ISZ SUBAD UPDATE NAMR PARAMETER POINTER LDA B3 STA PARSA,I SET TYPE TO 3 ENDS2 LDB XCNT GET SIZE OF FILE NAME LDA DLIMF NAMR DELIMITER FOUND? SZA,RSS JMP ENDAS NO, WRAP UP PARAMETER LDA SUBAD CPA NAMRP ROOM FOR MORE? RSS NO JMP DOSUB YES, SET-UP FOR NAMR PROCESSING JSB GETC GET ANOTHER CHARACTER JMP ENDS2 CHECK DELIMITER JMP *-2 KEEP LOOKING FOR A DELIMITER * NONSB CLA,INA SET TYPE TO NUMERIC PARSA EQU *+1 DST * SET TYPE AND VALUE * ENDCK ISZ CNTAD,I BUMP PARAMETER COUNT LDB CNTAD,I CPB B7 COMMAND + 6 PARAMETERS PARSED? JMP $PARS,I YES, EXIT LDA SUBPA CPB B1 HAS COMMAND BEEN PARSED? STA NAMRP YES, SET ADR OF 1ST NAMR BUFR ADA B5 CPB B2 HAS 1ST PARAM BEEN PARSED? STA NAMRP YES, SET ADR OF 2ND NAMR BUFR LDA PARSA ADA B4 POINT TO NEXT PARSING FIELD STA PARSA JMP NXFLD PARSE NEXT FIELD * ASCII LDA NMSET SZA DOING NAMR PARAMETERS? JMP SUBAS YES * NXTAS JSB GETC KEEP LOOKING FOR END OF FIELD JMP ENDA JUMP WHEN FOUND NXTA1 LDB NAMRP CPA COLON COLON FOUND? CPB SUBLA YES, MORE NAMR'S ALLOWED? JMP NXTAS NO, DON'T PROCESS NAMR'S * STB SUBAD SET RUNNING POINTER CCB ADB FCNT COMPUTE SIZE OF FILE NAME STB XCNT AND SAVE FOR LATER * DOSUB EQU * GET CURRENT BYTE POSITION LDB MPOSA AND SAVE IT LDA RSSI MODIFY INSTRUCTION TO "RSS" JMP NXFL2 PROCESS SUBPARAMETER FIELD * ENDA LDA B2 STA PARSA,I SET TYPE TO ASCII LDB FCNT FIELD CHAR COUNT * ENDAS ADB MD6 STB FCNT SAVE COUNT FOR POSSIBLE FILLER BLANKS CCE,SSB,RSS SKIP IF ASCII FIELD < 6 CHARS CLB,CLE SET FOR MOVE 6 CHARACTERS ADB B6 STB $TEMP LDA NPOS "FROM" BYTE POINTER LDB PARSA INB RBL `"TO" BYTE POINTER JSB .MBT MOVE UP TO 6 CHARACTERS TO PARSE BUFFER DEF $TEMP NOP SEZ,RSS AT LEAST 6? JMP ENDCK YES LDA LOBLK NO, FILL WITH BLANKS JSB .SBT ISZ FCNT JMP *-2 DO ANOTHER JMP ENDCK ALL PADDED * * PROCESS AN ASCII NAMR PARAMETER SUBAS JSB GETC RSS SKIP IF DELIMITER FOUND JMP *-2 IGNORE THE REST SUBA2 LDB MPOS ADDR OF 1ST CHAR JSB .LBT GET IT ALF,ALF PUT IN LHW STA SUBAD,I JSB .LBT GET 2ND CHARACTER ADB MD1 POINT TO CHAR JUST FETCHED. CPB IBPNT IS IT PAST END OF STRING? LDA LOBLK YES, RHW = BLANK IOR SUBAD,I STA SUBAD,I SAVE ASCII NAMR PARAMETER JMP ENDS1 NOW SEE IF MORE NAMR PARAMETERS * * SUBROUTINE TO GET NEXT CHARACTER FROM BUFFER TO BE PARSED * GETC NOP LDA ICNT CLE,SSA,RSS ENTIRE INPUT BUFFER PARSED? JMP $PARS,I YES, RETURN TO CALLER LDB IBPNT GET BYTE ADDR OF INPUT BUFFER RSS ISZ FCNT BUMP BYTE/FIELD COUNT GETC2 ISZ ICNT BUMP TOTAL COUNT RSS JMP GETEX RETURN IF END OF BUFFER JSB .LBT GET NEXT BYTE CPA LOBLK BLANK? JMP GETC2 YES, IGNORE STB IBPNT LDB NMSET CPA COLON NAMR DELIMITER? SZB,RSS YES, SKIP IF DOING NAMR PARAMETERS CLE,RSS NO CCE,RSS E REG = 1 WHEN ":" FOUND (AFTER 1ST ONE) CPA COM COMMA FOUND? JMP GETEX YES, END OF FIELD ISZ FCNT BUMP BYTE/FIELD COUNT ISZ GETC GETEX CLB PUT E-REG INTO A FLAG WORD. ELB STB DLIMF JMP GETC,I RETURN WITH CHARACTER IN A REG * DLIMF NOP HED REMAT: DATA AREA * (C) HEWLETT-PACKARD CO. 1979 * * PARAMETER STORAGE AREA. DO NOT CHANGE ORDER OF * LABELS FROM 'PRAMS' THRU 'NAMR2'. * PRAMS NOP FL_AG WORD. OP BSS 3 OPERATION CODE. CP1 NOP PARAM FLAG (0=NO, 1=#, 2=ASC, 3=NAMR) P1 REP 3 PARAM 1 (UP TO 6 CHARACTERS). NOP CP2 NOP P2 REP 3 NOP CP3 NOP P3 REP 3 NOP CP4 NOP P4 REP 3 NOP CP5 NOP P5 REP 3 NOP CP6 NOP P6 REP 3 NOP NPRMS BSS 1 # OF PRAMS NAMR1 BSS 5 PARAM1 SUBPARAMS NAMR2 BSS 5 PARAM2 SUBPARAMS * SECU1 EQU NAMR1+0 CRN1 EQU NAMR1+1 TYPE1 EQU NAMR1+2 SIZE1 EQU NAMR1+3 SECU2 EQU NAMR2+0 CRN2 EQU NAMR2+1 TYPE2 EQU NAMR2+2 SIZE2 EQU NAMR2+3 RSIZ2 EQU NAMR2+4 * N60 OCT -60 B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 B7 OCT 7 B17 OCT 17 B37 OCT 37 B70 OCT 70 B77 OCT 77 B100 OCT 100 B300 OCT 300 B377 OCT 377 B400 OCT 400 B1000 OCT 1000 B1100 OCT 1100 B2300 OCT 2300 LZERO OCT 60 LOW ZERO HZERO OCT 30000 HIGH ZERO HB377 OCT 177400 HIBIT OCT 100000 MB40 OCT -40 MB133 OCT -133 MD1 DEC -1 MD2 DEC -2 MD3 DEC -3 MD4 DEC -4 MD5 DEC -5 MD6 DEC -6 MD7 DEC -7 MD10 DEC -10 MD12 DEC -12 MD39 DEC -39 D8 DEC 8 D9 DEC 9 D10 DEC 10 D13 DEC 13 D14 DEC 14 D15 DEC 15 D18 DEC 18 D19 DEC 19 D22 DEC 22 D26 DEC 26 D27 DEC 27 D28 DEC 28 D34 DEC 34 D36 DEC 36 D37 DEC 37 D40 DEC 40 D45 DEC 45 D55 DEC 55 D56 DEC 56 D72 DEC 72 D128 DEC 128 VBIT EQU D128 V-BIT (BIT 7) FOR CONWD NPOSA DEF NPOS MPOSA DEF MPOS SUBF NOP IBPNT NOP FCNT NOP ICNT NOP XCNT NOP MPOS NOP NPOS NOP SUBAD NOP NAMRP NOP FIRST NOP VAL NOP OVAL NOP LOBLK OCT 40 CNTAD DEF NPRMS SUBPA DEF NAMR1 SUBLA DEF NAMR2+5 NEG OCT 55 COLON OCT 72 ASCB OCT 102 TOPNF NOP TRDCB OPEN FLAG UOPNF NOP UDCB OPEN FLAG $TEMP NOP TEMPORARY FOR $PARS TEMPM NOP TEMP BSS 2 TEMP1 BSS 2 TEMP2 BSS 2 INCNT NOP 20, # WORDS IN INPUT REQUEST. LUTYP NOP EQ. TYPE OF INPUT DEVICE. LOGLU NOP LU OF LOG DEVICE. LSTLU NOP LU OF LIST DEVICE. SEVER NOP SEVERITY CODE. NODE2 NOP NODE1 NOP PRMPT NOP LOCAL/REMOTE PROMPT CHAR CSFLG NOP CHECKSUM FLAG BRFLG NOP BREAK FLAG A.$TR ASC 2,$TR A.TR1 ASC 2,R,1 AS.$ OCT 022000 IERRR BSS 2 "$" ASC 1,$_ LOCAL PROMPT CHARACTER "#" ASC 1,#_ REMOTE PROMPT CHARACTER "AS" ASC 1,AS "R" OCT 122 "U" OCT 125 "BR" ASC 1,BR "BN" ASC 1,BN "BA" ASC 1,BA IPRMP ASC 2,/ _ PROMPT FOR $ST AND $DU BLANK OCT 020000 DBBLK OCT 20040 CR OCT 6400 COM OCT 54 ASCII COMMA ICOD1 OCT 100001 ICOD2 OCT 100002 ICOD3 OCT 100003 I9B11 OCT 104011 ICD13 OCT 100015 CNWD1 EQU HIBIT #MAST CONWD. NO ABORT CNWD2 OCT 140000 #MAST CONWD (NO ABORT, LONG TIMEOUT) TRFLG NOP PBUFA DEF PRAMS BUFAD DEF INBUF INBUF EQU RECRD INPUT BUFFER (128 WORDS) UDCB BSS 4 USER DATA CONTROL BLOCK TRDCB BSS 4 TR FILE DATA CONTROL BLOCK * * DEFINE NRV * * NRVSZ EQU B3 BSS 0 * END REMAT 2 `7 91750-18161 2013 S C0122 &RESL +              H0101 uvASMB,R,Q,C HED RTE-L VERSION NAM RESL,6 91750-1X161 REV 2013 801014 L SPC 1 * ENT #MCTR,#MTBL,#MARN,#MAHC,#MARL,#MAZE ENT #RSM,#POOL,#DFUN,#PASS ENT #BUSY,#FWAM,#GRPM,#BREJ,#LDEF,#MNUM,#MRTH ENT #PNLH,#TRCL,#TRCN,#CL3K,#NRV,#NCNT ENT #RDLY,#PRLU,#LEVL,#ACRN,#LUMP,#LMPE ENT #MSTO,#NODE,#NULL,#QRN,#RSAX,#RTRY ENT #ST00,#ST01,#ST02,#ST03,#ST04,#ST05,#ST06,#ST07 ENT #ST08,#ST09,#ST10,#SVTO,#TBRN,#WAIT,#CNOD,#LNOD ENT #ST11 ENT #QCLM,#NCLR,#SCLR,#SWRD,#PLOG,#RFSZ,#SAVM ENT #RPCV,#RQCV,#LU3K,#QZRN,#CLRN,#QXCL,#TST ENT #INCV,#OTCV,#MHCT,#MDCT,#NMSC ENT #LV,#LCNT,#CM,#CMCT,#EXHC,#EXTC,#TCB ENT D$LID,D$RID EXT $XQT,#PRGL SPC 1 EXT $ALC,$CGRN,$LIBR,$LIBX,$RTN,.ENTP * * NAME: RESM (21MX-M/E/F COMPUTERS) * RESL (21MX-L COMPUTERS) * SOURCE: 91750-18231 * RELOC: 91750-16231 (RTE-IV/M VERSION) * 91750-162?? (RTE-L VERSION) * PGMR: LYLE WEIMAN [ 03/30/79 ] * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 * RES IS A MEMORY-RESIDENT SYSTEM LIBRARY MODULE USED BY THE * DS/1000 (DISTRIBUTED SYSTEMS) SOFTWARE PACKAGE TO PROVIDE * CONTROLLED-ACCESS COMMON STORAGE. ITEMS STORED IN ARE NETWORK * GLOBAL CONSTANTS & VARIOUS LISTS WHICH CONTAIN THE TRANSACTION-BLOCK * RECORDS OF CURRENT TRANSACTIONS-IN-PROCESS ON THE NETWORK. * SPC 5 * #RSAX IS A PRIVILEGED LIBRARY ROUTINE EMBEDDED IN RES * WHICH CONTROLS ACCESS TO, AND ALLOWS MAINTENANCE OF, THE * NETWORK'S TRANSACTION-CONTROL-BLOCKS (TCB'S) FOR CURRENT REQUESTS. * SKP * #RSAX OPERATION: SPC 1 * 1. SAVE PARAMETERS IN PREPARATION FOR MAP-SWITCH. SPC 1 * 2. SAVE MAP STATUS AND SWITCH TO SYSTEM MAP. SPC 1 * 3. CHECK MODE OF OPERATION: * A. IF =0, GO TO 7. TO ALLOCATE SYSTEM MEMORY. * B. IF =1, GO TO 7. TO DE-ALLOCATE SYSTEM MEMORY. * C. IF =2, GO TO 4. TO ADD NEW ENTRY TO MASTER-REQUEST LIST. * D. IF =3, GO TO 5. TO ADD NEW ENTRY TO A SLAVE-STREAM LIST. * E. IF =4, GO TO 6. TO SEARCH FOR A MASTER TCB ENTRY. * F. IF =5, GO TO 6. TO SEARCH FOR A SLAVE TCB ENTRY. * G. IF =6, GO TO 6. TO REMOVE A MASTER ENTRY & RETURN IT TO THE POOL. * H. IF =7, GO TO 6. TO REMOVE A SLAVE ENTRY & RETURN IT TO THE POOL. * I. IF =8, GO TO 4. TO ADD AN HP3000 PROCESS. * J. IF=10, GO TO 6. TO REMOVE AN HP3000 PROCESS. * K. IF=11, SET SEARCH KEY OFFSET TO 5 (6TH TCB WORD IS SEARCH KEY) AND * GOTO 6. * L. IF=12, GO TO 6. TO SET THE M.A. REQUEST ACKNOWLEDGEMENT FLAG * M. IF=13, GO TO 6. TO TEST " " " " " * * NOTE: THE M.A. ACKNOWLEDGEMENT FLAG IS DOCUMENTED IN THE MESSAGE * ACCOUNTING SOFTWARE. * * N. IF=14, THEN SAME AS 2, BUT SKIP SEARCH FOR "OBSOLETE" ENTRIES. * M. IF NONE OF THE ABOVE - ERROR #2 --- REJECT! SPC 1 * 4. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE MASTER LIST. * A. IF NONE AVAILABLE, CALLER HAS NOT CHECKED AVAILABILITY OF * TABLE-ACCESS RN (#TBRN) BEFORE ENTRY - ERROR #3 --- REJECT! * B. IF ENTRY AVAILABLE, SEARCH BY ID SEG. ADDR. FOR OBSOLETE * ENTRIES IN THE MASTER REQUEST LIST (EXCEPT IF MODE =12). * C. FLAG ALL OBSOLETE MASTER-REQUEST ENTRIES AS BAD, IF THEY * ORIGINATED WITH SAME REQUESTOR (BIT#15 =1 OF WORD#5). * D. LINK THE NEW ENTRY INTO THE MASTER REQUEST LIST. * E. USE TIMEOUT SPECIFIED IN CALL, OR USE #MSTO IF VALUE IS ZERO. * F. TRANSFER THE CALLER'S DATA INTO THE NEW ENTRY. * G. IF ENTRY POOL NOT DEPLETED, CLEAR TABLE^-ACCESS RN & RETURN. SPC 1 * 5. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE SLAVE-STREAM LIST. * A. IF NONE, #TBRN NOT CHECKED BEFORE ENTRY - ERROR #3 --- REJECT! * B. CHECK STREAM PARAMETER FOR ACCEPTABLE TYPE--ERROR #1, IF INVALID. * C. LINK THE NEW ENTRY INTO THE SPECIFIED SLAVE-STREAM LIST. * D. TRANSFER CALLER'S DATA INTO THE NEW ENTRY. * E. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 6. INITIALIZE LIST POINTERS, BEFORE SEARCHING FOR/CLEARING AN ENTRY. * A. IF IMPROPER LIST SPECIFIED - ERROR #1 --- REJECT! * B. SEARCH FOR ENTRY. IF ENTRY NOT LOCATED, REJECT---ERROR #4! * C. IF MODE=4/5, GET CONTENTS OF ENTRY WORD#4 & RETURN TO CALLER. * D. IF MODE=6/7, GET CONTENTS OF WD#4 & RE-LINK ENTRY IN NULL LIST. * E. CHECK MODE AGAIN: IF 12, THEN SET M.A. REQUEST ACKNOWLEDGEMENT * FLAG & RETURN CLASS # # TCB ADDR. * IF 13, THEN RETURN WITH ONLY M.A. R.A. FLAG * IN (A): IF 0 THEN FLAG CLEAR, * ELSE #0 IF FLAG SET. DON'T DEPEND * ON A PARTICULAR VALUE, IN CASE * THIS CHANGES. * F. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 7. VERIFY CALLER KNOWS CORRECT SECURITY CODE BEFORE ALLOCATING OR * DE-ALLOCATING SAM. * A. IF MODE & #FWAM =0, GO TO ALLOCATE SYSTEM AVAILABLE MEMORY. * B. IF REQUEST GRANTED, STORE BLOCK ADDRESS IN #FWAM, SIZE IN #SAVM. * D. IF REQUEST DENIED, RETURN REASON IN , FOR FURTHER ANALYSIS. * E. IF MODE=1 & PRAM1=#FWAM, RETURN MEMORY TO THE SYSTEM. * F. CLEAR #FWAM & #SAVM, BEFORE RETURNING TO . SKP * #RSAX CALLING SEQUENCE: * * JSB #RSAX * DEF RTN * DEF MODE MODE OF OPERATION (0 THRU 7) * DEF PRAM1 REQUIRED PARAMETER (SEE TABLE, BELOW) * DEF PRAM2 EREQUIRED FOR MODES: 2,3,5,7 [OPTIONAL MODES: 0,1,4,6] * DEF PRAM3 REQUIRED FOR MODES 2 & 3 ONLY (NODAL ADDRESS) * DEF PRAM4 OPTIONAL FOR MODES 2,8 & 12 ONLY (MASTER TIME-OUT) *RTN : NORMAL-(SEE TABLE); ERROR-(SEE LATER DESCRIPTION) * * +----+------------+--------------+------------+---------+-------+-------+ * !MODE! ACTION ! PRAM1 ! PRAM2 ! PRAM3 ! RTN! RTN! * !====+============+==============+============+=========+=======+=======+ * ! 0 ! GET MEMORY !#WORDS TO GET ! SECURITY ! NOT USED!FWA SAM! #WORDS! * ! ! ! ! CODE ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 1 ! RTN MEMORY !FWA SAM BLOCK ! SECURITY ! NOT USED! 0 ! 0 ! * ! ! ! ! CODE ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 2 ! ADD MASTER !MASTER CLASS# !MA 'SEND'CNT! NOT USED!LOC SEQ!TCB ADR! * ! ! ! NOTE: PRAM4 = MASTER TIME-OUT VALUE ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 3 ! ADD SLAVE !ORIG. SEQ. NO.!SLAVE STREAM!ORIG.NODE!LOC SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 4 ! FIND MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# !TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 5 ! FIND SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 6 !CLEAR MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 7 !CLEAR SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 8 ! ADD PNL ! LOGGING LU # !REMOTE SES ! REMuOTE !LOC.SEQ!TCB ADR! * ! ! ! ! ID/SMP # ! NOTE # ! ! ! * ! ! ! NOTE: PRAM4 = MPE/RTE FLAG WORD ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 10 ! CLEAR PNL !REMOTE SESSION! REMOTE NODE! NOT USED! LOG LU! 0 ! * ! ! ! ID/SMP # ! NUMBER ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 11 ! FIND MA SEQ! M.A. SEQ. # ! NOT USED ! NOT USED! CLASS#! TCB ! * ! ! NUMBER ! ! ! ! ! ADDR ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 12 !SET REQUEST ! M.A. SEQ. # ! NOT USED ! NOT USED! CLASS#! TCB ! * ! !ACKNOWLEDGED! ! ! ! ! ADDR ! * ! !FLAG, SEE 16! ! ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 14 ! ADD MASTER ! SAME AS # 2, BUT NO SEARCH FOR OBSOLETE ENTRIES ! * +----+------------------------------------------------------------------+ * ! 16 !TEST REQUEST!LOCAL SEQ. NO.! NOT USED ! NOT USED!0 IF ! TCB ! * ! !ACKNOWLEDGED! ! ! !FLAG 0 ! ADDR ! * ! !FLAG, SEE 12! ! ! !ELSE<>0! ! * +----+------------+--------------+------------+---------+-------+-------+ * * IN PNL ENTRIES, CONTAINS -1 FOR MPE SESSIONS. * * #RSAX ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER WITH THE * REQUESTED ACTION NOT PERFORMED. * * = -1: AN INVALID LIST HAS BEEN SPECIFIED; FIRST CALLER * IS NOT ; MEMORY ALLOCATION/DE-ALLOCATION IMPROPER. * * = -2: THE SPECIFIED MODE OF OPERATION IS UN-DEFINED. * * = -3: NO SPACE FOR A NEW ENTRY. THE CALLER DID NOT WAIT FOR *  THE TABLE-ACCESS RESOURCE NUMBER (#TBRN) TO BE CLEARED, * PRIOR TO CALLING #RSAX. (THIS SHOULD NOT OCCUR IF ALL * CALLERS ADHERE TO THE RN CONVENTION, PRIOR TO CALLING.) * * = -4: ENTRY CANNOT BE LOCATED; ACCESSING AN EMPTY LIST. * * MODE 0 ( ALLOCATION ): ==-1 IF BAD SECURITY CODE SPECIFIED. * ELSE: * =-1,=MAXIMUM POSSIBLE NO. OF WORDS. * = 0,=MAXIMUM WORDS AVAILABLE NOW. * 1 (DE-ALLOCATION): = = -1 IF ADDRESS OF BLOCK BEING * RETURNED IS NOT EQUAL TO #FWAM, OR IF * SECURITY CODE IS INCORRECT. SKP * LIST FORMATS: * * 'RES' SYSTEM AVAILABLE MEMORY * ------------------------------- ------------------------- * * #PNLH < ADDR 1ST PROCESS# LIST ENTRY>... * <0!D! 0 > * < REMOTE NODE NUMBER > * < 0 ! LOCAL TERM- > * INAL LU * * * * BIT 14 OF WORD 3 (D) IS SET FOR MPE SESSIONS, * CLEAR FOR RTE SESSIONS. * * #MRTH < ADDR.=1RST MASTER-LIST ENTRY>... * < UDF-----*TIMEOUT CNTR. > * < LOCAL SEQUENCE NUMBER > * * * * * #ST00 ... * . <- * MONITOR'S CLASS NUMBER > < UD------*TIMEOUT CNTR. > * . < LOCAL SEQUENCE NUMBER > * . < MONITOR NAME (CHARS 3 & 4 > < ORIGIN SEQUENCE NUMBER > * . < MONITOR NAME (CHAR 5) > < ORIGIN NODAL ADDRESS > * . < *** RESERVED ******** > * . * . * #STXX < ******* FORMAT SAME ******* >...< **** FORMAT SAME ***** > * < ********* FOR ALL ********* > < ******** FOR ********* > * < ****** SLAVE STREAMS ****** > < ******** ALL ********* > * < *************************** > < ******* SLAVE ******** > * < *************************** > < ****** STREAMS ******* > * < ********************** > * * WHERE: - = RESERVED FOR FUTURE USE. A(#15) = ABORT OK. * B(#15) = DUPLICATE ENTRY, OR ONE WHICH MAY BE DELETED. * SET TO "FLAG" 'UPLIN' THAT THIS TCB MAY BE RELEASED. * C(#15) = LONG MASTER TIMEOUT (APPROXIMATELY 20 MIN.) * U(#15) = UPLIN TEMPORARY BIT. D(#14) = HP3000 REQUEST. * F(#13) = M.A. "REQUEST ACKNOWLEDGED" FLAG. 1 = SET, 0=CLEAR * * *NOTE: 0 IN LIST HEAD OR FIRST WORD OF ENTRY SIGNALS END OF LIST. * *NOTE: 0 IN LIST HEAD OR FIRST WORD OF ENTRY SIGNALS END OF LIST. * * * NETWORK ROUTE VECTOR TABLE: * * #NCNT < NEGATIVE NUMBER OF NRV PAIRS> * NRV TABLE FORMAT: * * +--------------------------+ * #NRV----> ! CPU NUMBER (16-BITS) ! * +--------------------------+ * ! TIME-OUT ! FORMAT # ! * ! (8 BITS) ! (8 BITS) ! * +----------+---------------+ * !RESERVED!N! COMM-LINK LU ! * !(7 BITS)! ! (8 BITS) x ! * +----------+---------------+ * * N = 1 IF CPU IS NEIGHBOR TO LOCAL NODE, ELSE 0 * #NRV < ADDRESS OF NRV TABLE >...< SEE FORMAT IN "NRVSC" > * . * : * SKP MODE NOP MODE OF OPERATION. PRAM1 NOP USER PRAM2 NOP SPECIFIED PRAM3 NOP PARAMETERS. PRAM4 NOP SUP [SUPPRESS EXTENDED LISTING] #RSAX NOP ENTRY/EXIT: TCB MANAGEMENT. JSB $LIBR DECLARE THIS TO BE NOP A PRIVILEGED ROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES DEF MODE FOR PARAMETERS & RETURN POINT. * * CLA [PROTECT AGAINST MISSING PARAMETER] STA GOOD CLEAR SEARCH FLAG LDA PRAM1,I OBTAIN STA PRAM1 PARAMETERS STA KEYWD (ASSUME THIS WILL BE OUR SEARCH KEY) CLA FOR LDA PRAM2,I LOCAL USE, STA PRAM2 IN PREPARATION CLA FOR A LDA PRAM3,I POSSIBLE STA PRAM3 DMS MAP-SWITCH. CLA LDA PRAM4,I STA PRAM4 CLA LDB MODE,I GET THE MODE OF OPERATION, SSB NEGATIVE MODE? JMP ERR02 YES, ILLEGAL MODE! STB MODE AND SAVE IT LOCALLY, ALSO. * LDA B PICK UP MODE ADA NMODX SUBTRACT MAX. ALLOWABLE 'MODE' CODE SSA,RSS TOO BIG? JMP ERR02 YES, ERROR! LDA B RECOVER MODE AGAIN ADA @JTBL ADD JUMP TABLE ADDRESS JMP A,I & BRANCH TO PROPER PROCESSOR SPC 2 * 'JUMP' TABLE. DO NOT DISTURB ORDER! * @JTBL DEF *+1,I MODE ACTION DEF SAM 0 ALLOCATE MEMORY. DEF SAM 1 RETURN MEMORY TO RTE DEF ADENT 2 CREATE A MASTER TCB ENTRY DEF ADENT 3 CREATE A SLAVE TCB ENTRY u DEF FIND 4 SEARCH FOR A MASTER TCB ENTRY DEF FIND 5 SEARCH FOR A SLAVE TCB ENTRY DEF FIND 6 SEARCH FOR/CLEAR A MASTER TCB ENTRY DEF FIND 7 SEARCH FOR/CLEAR A SLAVE TCB ENTRY DEF ADENT 8 CREATE A PROCESS # ENTRY DEF ERR02 9 *** ERROR, ILLEGAL MODE *** DEF FNPNL 10 SEARCH FOR/CLEAR A PROCESS # ENTRY DEF FNDMA 11 FIND MASTER TCB GIVEN M.A. SEQ. NUMBER DEF FNDMA 12 SET M.A. REQUEST ACKNOWLEDGEMENT FLAG DEF ERR02 13 *** ERROR, ILLEGAL MODE *** DEF ADENT 14 CREATE A MASTER ENTRY (W/O DUPL. ENTRY SEARCH) DEF ERR02 15 *** ERROR, ILLEGAL MODE *** DEF FIND 16 TEST REQUEST ACKNOWLEDGEMENT FLAG * NMODX ABS @JTBL-* NEG. SIZE OF TABLE SPC 10 * ADD A NEW ENTRY TO THE MASTER OR SLAVE-STREAM LIST. SPC 1 ADENT LDA #NULL GET THE NULL LIST LINK-WORD. SZA,RSS IS AN ENTRY AVAILABLE FROM THE POOL? JMP ERR03 * NO. ERROR #3: NO ENTRY AVAILABLE! STA ENTAD YES. SAVE ADDRESS OF NEW ENTRY. * INA POINT TO THE SECOND WORD OF THE ENTRY. STA ENPNT SAVE THE POINTER FOR ENTRY BUILDING. CPB P14 BUILT NEW MASTER W/O "OBS.ENTRY" SEARCH? JMP MST0 YES CPB P8 IS THIS A PNL ENTRY? JMP MSTAD . YES, SKP "OBS ENTRY" SEARCH CLE,SLB IF THIS IS TO BE A SLAVE ENTRY, JMP SLVAD THEN SKIP THE SEARCH FOR MASTER ENTRIES. * LDA MDEF INITIALIZE THE LIST PTR TO REF THE STA LSTAD MASTER LIST. * LDA XEQT SEARCH KEY IS: ID SEGMENT ADDRESS STA KEYWD LDA P4 EXAMINE FIFTH WORD OF EACH MASTER TCB. MLOOK JSB SERCH FIND ENTRIES WITH SAME CLASS OR PROCESS #. JMP MSTAD END-OF-LIST: GO TO ADD NEW ENTRY. ADB P4 GET THE 5TH WORD (ID SEGMENT ADDRESS) LDA B,I FROM ENTRY WITH SAME NUMBER. IO"@R SIGN ADD BAD-ENTRY FLAG (BIT#15). STA B,I RETURN MODIFIED WORD.(UPLIN CLEARS TCB). JMP MLOOK SEARCH FOR MORE OBSOLETE ENTRIES.[E=1]. * MSTAD CCB CHECK FOR LDA MODE NEW PROCESS CPA P8 NUMBER MODE. RSS YES, STAY IN-LINE JMP MST0 LDA PRAM4 PICK UP TIME-OUT WORD JMP SETIM GO SET TIMEOUT * MST0 EQU * CLB,INB SET MASTER TCB LIST CODE LDA PRAM4 LOAD MASTER TIME-OUT JMP SETIM * SLVAD JSB LSTCK PREPARE REFERENCES FOR THE SLAVE LIST. ADA P2 POINT TO WORD #3 OF SLAVE-STREAM HEAD. LDA A,I GET THE MONITOR I.D. SEGMENT ADDRESS. SZA,RSS IF THE MONITOR HAS NOT BEEN INITIALIZED, JMP ERR01 THEN NOTHING MAY BE ADDED TO THIS LIST! LDA #SVTO VALID LIST: GET SLAVE TIMEOUT VALUE. * SETIM STA ENPNT,I SET TIMEOUT INTO ENTRY WORD #2 ISZ ENPNT POINT TO NEXT WORD OF ENTRY CLA OBTAIN AN ENTRY FROM THE NULL LIST. JSB LNK GO PROCESS LIST CHANGES.[B=LIST CODE] SZA LIST-PROCESSING ERROR? JMP ERR04 YES--INFORM THE CALLER! * LDA PRAM3 USE THIRD PARAMETER LDB MODE INSTEAD OF SEQUENCE CPB P8 NUMBER FOR MODE 8. JMP STOR3 STORE IN THIRD TCB WORD. * SKP SPC 3 LDA SEQN GET THE LAST SEQUENCE NUMBER. INA,SZA,RSS ADVANCE THE COUNT & TEST FOR ZERO. CLE,INA ROLL-OVER: RESET TO ONE. STA SEQN SAVE THE CURRENT SEQUENCE NUMBER. STOR3 STA ENPNT,I INSERT IT INTO THE THIRD ENTRY WORD. ISZ ENPNT ADVANCE THE ENTRY POINTER. LDA MODE IF A SLAVE-ENTRY IS TO BE CLE,ERA ADDED, SET =1. LDA PRAM1 GET THE CALLER'S PARAMETERS LDB XEQT GET CALLER'S ID SEGMENT ADDRESS SEZ SLAVE-LIST ADDITION? LDB PRAM3 YES, GET THE ORIGIN NODAL ADDRESS.  DST ENPNT,I ADD PARAMETERS TO ENTRY WORDS #4,#5. ISZ ENPNT BUMP POINTER TO ISZ ENPNT WORD 6 LDA PRAM2 LOAD 'M.A.' SEQUENCE NUMBER STA ENPNT,I STORE IN 6TH T.C.B. WORD * LDA SEQN RETURN WITH: =CURRENT SEQUENCE NO. LDB ENTAD =ENTRY ADDRESS. JMP EXIT GO TO PREPARE FOR RETURN TO CALLER. * SEQN NOP TRANSACTION SEQUENCE NUMBER. * SPC 3 * ERROR PROCESSING AND EXIT SECTION. SPC 1 ERR04 LDA P4 =4: ENTRY CANNOT BE LOCATED. JMP ERR00 ERR03 LDA P3 =3: NEW ENTRY NOT AVAILABLE. JMP ERR00 ERR02 LDA P2 =2: INVALID MODE PARAMETER. RSS ERR01 CLA,INA =1: INVALID LIST PARAMETER. * ERR00 CMA,INA NEGATE THE ERROR CODE. STA B ARE THE SAME FOR ERROR RETURN. * EXIT DST TEMP SAVE TEMPORARILY. CLA CLEAR PARAMETER ADDRESSES STA MODE TO FACILITATE CHECKING STA PRAM1 FOR MISSING PARAMETERS STA PRAM2 UPON NEXT ENTRY OF <#RSAX>. STA PRAM3 STA PRAM4 LDA #NULL IF NO TCB ENTRIES REMAIN AVAILABLE SZA,RSS IN THE ENTRY POOL, THEN DO NOT JMP RETRN CLEAR THE TABLE-ACCESS RN; ELSE, LDA #TBRN GET THE TABLE-ACCESS RN AND GO TO RTE JSB $CGRN TO MAKE IT AVAILABLE FOR NEXT ACCESS. RETRN DLD TEMP RESTORE THE RETURN-DATA TO & . * * LBEX JSB $LIBX RETURN TO THE CALLER, VIA THE RTE DEF #RSAX PRIVILEGED ROUTINE PROCESSOR. * SKP * SEARCH FOR & CLEAR PROCESS NUMBER LIST ENTRY * FNPNL EQU * LDA PDEF INITIALIZE SEARCH LIST HEAD TO STA LSTAD PROCESS NUMBER LIST CCA,CLE INITIALIZE LIST CODE FOR PNL STA LSTCD LDA P5 SET OFFSET TO SESSION ID WORD STA OFSET JMP FINDX AND SEARCH FOR ENTRY SPC 2 * SEARCH FOR MASTER & SLA=VE TCB ENTRIES. CLEAR AND RETURN TO POOL, * IF REQUESTED. SPC 1 FIND EQU * LDA P2 SEARCH KEY WILL BE THIRD WORD IN TCB * FIND. EQU * HERE WITH OFFSET IN (A) STA OFSET IN TCB LDA MDEF INITIALIZE POINTERS STA LSTAD TO THE CLA,INA MASTER STA LSTCD LIST. * CLE,SLB IF THIS IS A SLAVE REQUEST, THEN JSB LSTCK ESTABLISH REFERENCES TO THE SLAVE LIST. * FINDX EQU * HERE TO START/RESUME SEARCH LDA OFSET LOAD OFFSET IN TCB TO SEARCH KEY. JSB SERCH GO TO LOCATE THE TCB ENTRY [E=0]. JMP ERR04 * ERROR #4: ENTRY CANNOT BE LOCATED! * * STB ENTAD SAVE THE ENTRY ADDRESS FOR LATER USE. LDA MODE GET THE MODE OF OPERATION CPA P10 CLEAR PNL? JSB FPNLX YES, CHECK FURTHER, RETURN IF TRUE MATCH ADB P3 POINT TO THIRD WORD, FOR LATER USE, STB ENPNT IN RETURNING THE CONTENTS TO CALLER. * CPA P6 ARE WE JMP RELS SUPPOSED TO CPA P7 RELEASE JMP RELS THIS TCB? CPA P10 JMP RELS * JMP FOUND NONE OF THE ABOVE, DON'T RELEASE THE TCB * RELS LDA LSTCD REMOVE ENTRY FROM THE SPECIFIED LIST. CLB,CLE RETURN IT TO THE NULL LIST. JSB LNK GO TO PROCESS THE LIST CHANGES. CCE,SZA LIST PROCESSING ERROR? JMP ERR04 YES! GO TO INFORM THE CALLER. STA ENTAD ASSURE RETURNS TO CALLER W/ ZERO * FOUND EQU * LDA MODE IS THIS REQUEST TO: CPA P12 SET REQUEST ACKNOWLEDGEMENT FLAG? JMP SETRA .. YES, GO SET IT CPA P16 TEST R.A. FLAG? JMP TSTRA .. YES, GO TEST IT * FOND1 EQU * RETURN POINT FOR ALL "FIND TCB" PROCESSORS LDA ENPNT,I GET WORD #4 FOR RETURN TO CALLER. FOND2 LDB ENTAD GET THE TCB ADDRESS; JMP EXIT &ELSE, RETURN WITH =0. SPC 2 * HERE WHEN A PNL ENTRY HAS BEEN FOUND WHICH MATCHES * THE REMOTE SESSION ID NUMBER. IF REMOTE NODE NUMBER ALSO MATCHES, * THEN A GOOD MATCH HAS BEEN FOUND. OTHERWISE, CONTINUE SEARCH. * FPNLX NOP ADB P2 POINT TO REMOTE NODE NUMBER LDB B,I LOAD REMOTE NODE NUMBER CPB PRAM2 MATCH? RSS YES JMP FINDX NO MATCH, RESUME SEARCH AT NEXT ENTRY. LDB ENTAD RECOVER REGISTER & RETURN JMP FPNLX,I * * HERE TO FIND MASTER TCB, GIVEN M.A. SEQUENCE NUMBER * OPERATION IS THE SAME AS "FIND MASTER TCB" (MODE 4), EXCEPT * THAT THE SEARCH KEY IS THE 6TH WORD IN THE TCB, INSTEAD * OF THE THIRD. FNDMA EQU * LDA P5 6TH WORD IS SEARCH KEY LDB P4 (ESTABLISH MASTER LIST PNTRS) STA GOOD SET SEARCH FLAG TO ONLY GOOD TCBS JMP FIND. * SETRA EQU * HERE TO SET REQUEST ACKNOWLEDGEMENT FLAG LDB ENTAD GET ADDRESS INB OF THE FLAG LDA B,I GET THE FLAG, IOR RAFLG SET IT, STA B,I AND PUT IT BACK. ADB P4 --> TCB+5 CLA CLEAR THE MA IDENTIFIER STA B,I JMP FOND1 AND RETURN TO CALLER * RAFLG OCT 20000 BIT # 13 * TSTRA LDB ENTAD GET THE ADDRESS INB OF THE FLAG LDA B,I GET THE FLAG ITSELF AND RAFLG AND RETURN TO CALLER WITH ONLY THAT BIT SET JMP FOND2 * ENPNT NOP POINTER INTO TCB ENTRY. ENTAD NOP TCB ADDRESS STORAGE. * SKP * SYSTEM AVAILABLE MEMORY ALLOCATION/DE-ALLOCATION PROCESSOR. SPC 1 SAM EQU * LDA PRAM2 GET CALLER'S SECURITY CODE UNL CPA SECOD CODES MATCH? LST RSS CODES MATCH: ALLOW ACCESS, ELSE JMP ERR01 REPORT IMPROPER ACCESS! * LDA PRAM1 GET THE CALLER'S PڶARAMETER. SLB IF THE REQUEST IS FOR DE-ALLOCATION, JMP RTSAM GO TO RETURN THE MEMORY TO THE SYSTEM. * STA SZMEM ALLOCATE: SAVE NO. OF WORDS REQUESTED. LDA #FWAM IF SYSTEM-AVAILABLE-MEMORY SZA HAS ALREADY BEEN ALLOCATED, JMP ERR01 THEN REJECT THE REQUEST! * JSB $ALC REQUEST SYSTEM AVAILABLE MEMORY (S.A.M.) SZMEM DEC 128 IN THE AMOUNT SPECIFIED BY THE CALLER. JMP LBEX * NEVER AVAILABLE: =-1,=MAX EVER JMP LBEX * NOT AVAILABLE NOW: =0,=MAX NOW STA #FWAM O.K. SAVE THE ADDRESS OF MEMORY BLOCK. STB #SAVM SAVE THE SIZE OF THE MEMORY BLOCK. JMP LBEX RETURN WITH S.A.M. SPECIFICATIONS. * RTSAM CPA #FWAM IS CALLER SPECIFYING CORRECT BLOCK? RSS YES. PROCESS THE DE-ALLOCATION. JMP ERR01 NO. ** IGNORE THE REQUEST! ** * LDB #SAVM GET THE BLOCK-SIZE SPECIFICATION. DST RTN CONFIGURE THE DE-ALLOCATION REQUEST. * JSB $RTN RETURN A SYSTEM-AVAILABLE-MEMORY BLOCK; RTN NOP BEGINNING AT SPECIFIED ADDRESS, AND NOP CONTAINING SPECIFIED NO. OF WORDS. CLA CLEAR THE STORAGE LOCATIONS FOR: STA #FWAM MEMORY BLOCK ADDRESS. STA #SAVM MEMORY BLOCK SIZE. JMP LBEX RETURN TO THE CALLER. UNL SECOD DEC 3360 LST SKP * SUBROUTINE TO CHECK LIST PARAMETER & SET LIST CODE & LIST ADDRESS. SPC 1 * ENTER: = DON'T CARE. * RETURN: =LIST ADDRESS; =LIST CODE. * ERROR - RETURN VIA ERROR EXIT WITH ERROR #1. * LSTCK NOP ENTRY/EXIT: LIST ID ROUTINE. LDA PRAM2 GET THE STREAM PARAMETER. AND B77 ISOLATE THE STREAM NUMBER. ADA P2 ADD OFFSET FOR NULL & MASTER LISTS. STA LSTCD SAVE FOR USE ELSEWHERE. STA B SAVE FOR RETURN TO CALLER. ADA NMAX CHECK FOR SPECIFIC[ATION CLE,SSA,RSS OF AN UN-DEFINED LIST. JMP ERR01 * ERROR #1: INVALID LIST! LDA #LDEF GET THE LIST-TABLE ADDRESS. ADA B INDEX TO THE PROPER ENTRY. LDA A,I GET THE LIST ADDRESS. STA LSTAD SAVE THE ADDRESS FOR LATER USE. JMP LSTCK,I RETURN TO THE CALLER. * B77 OCT 77 LSTAD NOP ADDRESS OF LIST HEADER. LSTCD NOP LIST IDENTIFICATION CODE. * SKP * SUBROUTINE TO SEARCH FOR A SPECIFIC LIST ENTRY. SPC 1 * ENTER: = OFFSET INTO TCB ENTRY; = DON'T CARE. * =0: SEARCH FROM TOP; =1: CONTINUE SEARCH. * 'LSTAD' SET TO ADDRESS OF LIST TO BE SEARCHED. * 'KEYWD' CONTAINS SEARCH KEY * * RETURN: P+1 -- ENTRY NOT LOCATED; MEANINGLESS, =0. * P+2 -- ENTRY WAS LOCATED; MEANINGLESS, = ENTRY ADDRESS. * SERCH NOP ENTRY/EXIT:LIST SEARCH ROUTINE. LDB TEMP+1 GET NEXT-ENTRY ADDRESS TO CONTINUE. SEZ IS THIS A REQUEST TO CONTINUE? JMP SLOOP YES. GO TO CONTINUE THE SEARCH. STA OFSET SAVE OFFSET INTO TCB ENTRY. LDB LSTAD GET TOP-OF-LIST ADDRESS. * SLOOP LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB,RSS IS THIS THE END OF THE LIST? JMP SERCH,I YES. TAKE "NOT FOUND" EXIT (P+1). * STB TEMP+1 SAVE POINTER TO NEXT ENTRY. LDA GOOD ONLY "GOOD" TCBS WANTED? SZA,RSS JMP SER1 . NO BAD ONES OK LDA P4 ADA B --> ID SEGMENT ADDRESS TCB+4 LDA A,I CHECK FOR BAD BIT SET CCE,SSA BAD BIT SET? JMP SLOOP . YES IGNORE THIS TCB SER1 ADB OFSET POINT TO KEYWORD LOCATION. LDA B,I GET THE KEYWORD. LDB TEMP+1 PREPARE TO RETURN WITH ENTRY ADDRESS. CPA KEYWD DOES IT MATCH THE CALLER'S KEYWORD? CCE,RSS YES. SET FOR CONTINUATION--SKIP. JMP SLOOP NO. CONTINUE SEARCHING. * ISZ SERCH ENTRY FOUND: SET RETURN TO P+2. JMP SERCH,I RETURN TO THE CALLER. * OFSET NOP KEYWORD OFFSET INTO TCB ENTRY. KEYWD NOP SEARCH KEY GOOD NOP IF SET, ONLY "GOOD" TCBS WANTED * SKP * SUBROUTINE TO PROCESS LIST LINKAGE. SPC 1 * ENTER: = CODE OF REMOVAL LIST; = CODE OF ADDITION LIST. * 'ENTAD' SET TO ADDRESS OF ENTRY TO BE REMOVED. * * RETURN: & =0: NORMAL; =-1, =UNCHANGED: ERROR. * LNK NOP ENTRY/EXIT: LIST LINK ROUTINE. STA TEMP SAVE REMOVAL-LIST CODE, TEMPORARILY. ADA #LDEF FIND THE TABLE ADDRESS. LDA A,I GET ADDRESS: TOP-OF-REMOVAL-LIST. LNK1 STA PNTR SAVE LIST POINTER. LDA A,I GET THE LINK TO THE NEXT ENTRY. SZA,RSS IF THIS IS THE END OF THE LIST, JMP LNKER THEN INFORM THE CALLER OF THE ERROR. CPA ENTAD IS THIS THE ENTRY TO BE REMOVED? RSS YES. SKIP TO REMOVE IT. JMP LNK1 NO. TRY THE NEXT ONE. LDA ENTAD,I GET THE LINK TO THE FOLLOWING ENTRY, STA PNTR,I AND MOVE IT TO THE PREVIOUS ENTRY. * ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET ADDRESS: TOP-OF-ADDITION-LIST. LNK2 STB PNTR SAVE LIST POINTER. LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB IS THIS THE END OF THE LIST? JMP LNK2 NO. CONTINUE SEARCHING FOR THE END. STB ENTAD,I YES. MAKE NEW ENTRY = END-OF-LIST. LDA ENTAD GET THE ADDRESS OF THE NEW ENTRY. STA PNTR,I SAVE IN LINK-WORD OF PREVIOUS ENTRY. * LDA MODE IF MODE IS CPA P14 NOT = 14 CLA AND ADA M8 >= 8 THEN SSA,RSS PROCESSING JMP LNKER-1 IS ALL DONE. * CPB TEMP REMOVING ENTRY FROM NULL LIST? [=0] CLA,INA,RSS YES. PREPARE TO ADD TO ACTIVE COUNT. CCA NO. PREPdARE TO DECREMENT ACTIVE COUNT. ADA #BUSY COMPUTE THE NEW 'ACTIVE-ENTRY' COUNT, STA #BUSY AND UPDATE THE INDICATOR. CLA,RSS INDICATE NORMAL RETURN, AND SKIP. LNKER CCA =-1: NO ENTRIES IN REMOVAL LIST. JMP LNK,I RETURN IS MADE TO THE CALLER. * PNTR NOP LIST POINTER STORAGE. * SKP * TABLE OF LIST-HEADER ADDRESSES. LIST CODES: SPC 1 * #LDEF DEF SOT START-OF-TABLE DEFINITION. PDEF DEF #PNLH HP3000 PROCESS NUMBER HEADER -01 SOT DEF #NULL ENTRY-POOL HEADER 00 MDEF DEF #MRTH MASTER-REQUEST HEADER 01 SDEF DEF #ST00 SLAVE-STREAM 00 HEADER 02 DEF #ST01 SLAVE-STREAM 01 HEADER 03 DEF #ST02 SLAVE-STREAM 02 HEADER 04 DEF #ST03 SLAVE-STREAM 03 HEADER 05 DEF #ST04 SLAVE-STREAM 04 HEADER 06 DEF #ST05 SLAVE-STREAM 05 HEADER 07 DEF #ST06 SLAVE-STREAM 06 HEADER 10 DEF #ST07 SLAVE-STREAM 07 HEADER 11 DEF #ST08 SLAVE-STREAM 08 HEADER 12 DEF #ST09 SLAVE-STREAM 09 HEADER 13 DEF #ST10 SLAVE-STREAM 10 HEADER 14 DEF #ST11 SLAVE-STREAM 11 HEADER 15 * NEW ENTRY: .........DEF #STXX.....SLAVE-STREAM XX HEADER........15 * NMAX ABS SDEF-*-2 LIST CODE VALIDITY-CHECKING CONSTANT. * #MNUM ABS NMAX-SDEF NUMBER OF SLAVE-STREAM TYPES. SPC 1 * CONSTANTS AND STORAGE. SPC 1 M8 DEC -8 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P10 DEC 10 P12 DEC 12 P16 DEC 16 P14 DEC 14 SIGN OCT 100000 TEMP OCT 0,0 TEMPORARY STORAGE LOCATIONS. SPC 1 * HP3000 ID SEQUENCE SPECIFICATIONS * D$LID DEF LOC LOCAL ID SEQUENCE ADDRESS D$RID DEF REM REMOTE ID SEQUENCE ADDRESS SPC 1 #RDLY DEC -200 MAXIMUM RTRY DELAY: 200 CENTOSECONDS (2 SEC.) #PRLǕU DEF #PRGL DEFAULT LU FOP PROGL MESSAGES: NO MESSAGES * (NOTE: #PRGL IS IN #REQU. IT MUST BE SEPARATED * IN ORDER TO ALLOW 'ABS' AT GEN-TIME TO WORK, AS WELL * AS ON-LINE PATCHES TO #PRLU) * * GENERAL SYSTEM DATA [ INITIALIZED BY 'DINIT' ]. * * NOTE: ANY CHANGE IN THE ORDERING OF THIS AREA MUST BE ACCOMPANIED * BY A CHANGE TO THE CORRESPONDING AREA OF 'DINIT' * SPC 1 #SCLR DEF #TBRN START OF AREA CLEARED BY 'DINIT'. #FWAM NOP ADDRESS OF SYSTEM AVAIL. MEMORY BLOCK. #SAVM NOP SIZE OF SYSTEM AVAIL. MEMORY BLOCK. #TBRN NOP TABLE-ACCESS RESOURCE NUMBER. #QRN NOP QUIESCENT(RN) OR SHUT-DOWN(0). #GRPM NOP GENERAL PRE-PROCESS MODULE CLASS NO. #QCLM NOP QUEUE CLEAN-UP MONITOR CLASS NUMBER. #BUSY NOP NUMBER OF ACTIVE TCB ENTRIES. #MSTO NOP MASTER REQUEST TIMEOUT VALUE. #SVTO NOP SLAVE REQUEST TIMEOUT VALUE. #RTRY NOP RETRY-PROCESSOR'S CLASS NUMBER. #WAIT NOP D65MS QUIESCENT WAIT INTERVAL. #SWRD NOP NETWORK-NODE SECURITY CODE. #BREJ NOP D65MS RETRY COUNT FOR BUSY REJECT. #INCV NOP INCOMING MSG CNVTR CLASS NUMBER #OTCV NOP OUTGOING MSG CNVTR CLASS NUMBER #MHCT NOP MAXIMUM HOP COUNT #MDCT NOP MAX.# TIMES A LINK CAN GO DOWN IN 5 MIN #RPCV NOP HP3000 REPLY CONVERTER CLASS NO. #RQCV NOP HP3000 REQUEST CONVERTER CLASS NO. #LU3K NOP LU NUMBER OF HP3000 #QZRN NOP QUEZ RN FOR "LISTEN MODE" #CLRN NOP QUEX RESOURCE NUMBER FOR CLEANUP #QXCL NOP QUEX CLASS NO. #TST NOP HP3000 TRANS. STATUS TABLE ADDRESS NOP HP3000 TRANS. STATUS TABLE SIZE,IN ENTRIES * SKP * LIST HEADERS (REMAINDER OF LISTS LOCATED IN SYSTEM AVAILABLE MEMORY). SPC 3 #PNLH NOP HP3000 PROCESS # LIST SPC 1 #NULL NOP LIST HtEADER: ENTRY POOL. SPC 1 #MRTH NOP MASTER REQUEST LIST. SPC 1 #ST00 OCT 0,0,0,0,0 SLAVE-STREAM 00 LIST. SPC 1 #ST01 OCT 0,0,0,0,0 SLAVE-STREAM 01 LIST. SPC 1 #ST02 OCT 0,0,0,0,0 SLAVE-STREAM 02 LIST. SPC 1 #ST03 OCT 0,0,0,0,0 SLAVE-STREAM 03 LIST. SPC 1 #ST04 OCT 0,0,0,0,0 SLAVE-STREAM 04 LIST. SPC 1 #ST05 OCT 0,0,0,0,0 SLAVE-STREAM 05 LIST. SPC 1 #ST06 OCT 0,0,0,0,0 SLAVE-STREAM 06 LIST. SPC 1 #ST07 OCT 0,0,0,0,0 SLAVE-STREAM 07 LIST. SPC 1 #ST08 OCT 0,0,0,0,0 SLAVE-STREAM 08 LIST. SPC 1 #ST09 OCT 0,0,0,0,0 SLAVE-STREAM 09 LIST. SPC 1 #ST10 OCT 0,0,0,0,0 SLAVE-STREAM 10 LIST. SPC 1 #ST11 OCT 0,0,0,0,0 SLAVE-STREAM 11 LIST SPC 1 * NEW ENTRY: ...#STXX OCT 0,0,0,0,0 .............SLAVE-STREAM XX LIST. SKP #RFSZ NOP MAXIMUM NUMBER OF 'OPEN' RFA FILES. * * REMOTE SESSION MONITOR ITEMS * #RSM NOP REMOTE SESSION MONITOR CLASS NUMBER #POOL NOP POINTER TO REMOTE SESSION ID POOL #DFUN BSS 11 DEFAULT ACCOUNT FOR REMOTE SESSION #PASS BSS 5 PASSWOD FOR NON-SESSION ACCESS * * PLOG/TLOG ITEMS * #PLOG BSS 7 1000 LOGGING PROGRAM'S CLASS NO. #CL3K BSS 7 3000 LOGGING PROGRAM'S CLASS NO. * * RE-ROUTING ITEMS * #LV NOP LINK VECTOR PNTR (OR 0 IF NO RE-ROUTING) #LCNT NOP NUMBER OF "LINK VECTOR" ENTRIES #CM NOP "COST MATRIX" PNTR, OR 0 IF NO RE-ROUTING #CMCT NOP NUMBER OF "COST MATRIX" ENTRIES * * "MESSAGE ACCOUNTING" STORAGE AREA * #MCTR NOP NEGATIVE # OF M.A. TABLE ENTRIES #MTBL NOP PNTR TO M.A. TABLE (IN SAM) #MARN NOP M.A. TABLE ACCESS RESOURCE NUMBER #MAHC NOP M.A. 'HOLDING' CLASS (SLAVE REPLY QUEUE FOR RE-XMISN) #MARL NOP dxvr MAX. MSG RETRY LIMIT #MAZE NOP *-- MAX NUMBER OF TCBS IN THE SYSTEM (INCLUDING PNL) #TCB NOP #EXHC NOP EXECM HOLDING CLASS #EXTC NOP EXECM TEMP. HOLDING CLASS * * END OF AREA CLEARED BY "DINIT" * #NCLR ABS #TBRN-* NEGATIVE # LOCNS 'DINIT' CLEARS SPC 2 * NODAL ADDRESSING SPECIFICATIONS. * #CNOD NOP CURRENT-USER-NODE; -1: INACTIVE. #LNOD NOP DOWN-LOAD NODE * * * * #NODE NOP LOCAL NODE NUMBER. #ACRN NOP DOWN-LOAD FILE CRN * * * NOTE: #NCNT & #NRV MUST BE CONSECUTIVE! * #NCNT NOP NEG. NUMBER OF NRV TABLE ENTRIES (PAIRS) #NRV NOP S.A.M. ADDRESS OF NRV TABLE. #TRCL NOP 'TRACE' CLASS NUMBER #TRCN NOP 'TRACE' RESOURCE NUMBER SPC 2 #LEVL DEC 1 LOCAL NODE UPGRADE LEVEL #NMSC NOP NETWORK MANAGEMENT SECURITY CODE #LUMP NOP STORAGE FOR 'LUMAP' CLASS NUMBER #LMPE NOP STORAGE FOR ERRORS NOP (DOUBLE-WORD) NOP REPORTING NODE NUMBER SPC 2 * HP3000 ID SEQUENCE SPECIFICATIONS * LOC NOP LOCAL ID SEQUENCE: BYTE COUNT BSS 8 CHARACTERS * REM NOP REMOTE ID SEQUENCE: RESERVED WORD NOP BYTE COUNT BSS 8 CHARACTERS A EQU 0 B EQU 1 * XEQT EQU $XQT SPC 1 ORR [ INDICATES SIZE OF ] SPC 1 END ARE NETWORK * GLOBAL CONSTANTS & VARIOUS LISTS WHICH CONTAIN THE TRANSACTION-BLOCK * RECORDS OF CURRENT TRANSACTIONS-IN-PROCESS ON THE NETWORK. * SPC 5 * #RSAX IS A PRIVILEGED LIBRARY ROUTINE EMBEDDED IN RES * WHICH CONTROLS ACCESS TO, AND ALLOWS MAINTENANCE OF, THE * NETWORK'S TRANSACTION-CONTROL-BLOCKS (TCB'S) FOR CURRENT REQUESTS. * SKP * #RSAX OPERATION: SPC 1 * 1. SAVE PARAMETERSR IN PREPARATION FOR MAP-SWITCH. SPC 1 * 2. SAVE MAP STATUS AND SWITCH TO SYSTEM MAP. SPC 1 * 3. CHECK MODE OF OPERATION: * A. IF =0, GO TO 7. TO ALLOCATE SYSTEM MEMORY. * B. IF =1, GO TO 7. TO DE-ALLOCATE SYSTEM MEMORY. * C. IF =2, GO TO 4. TO ADD NEW ENTRY TO MASTER-REQUEST LIST. * D. IF =3, GO TO 5. TO ADD NEW ENTRY TO A SLAVE-STREAM LIST. * E. IF =4, GO TO 6. TO SEARCH FOR A MASTER TCB ENTRY. * F. IF =5, GO TO 6. TO SEARCH FOR A SLAVE TCB ENTRY. * G. IF =6, GO TO 6. TO REMOVE A MASTER ENTRY & RETURN IT TO THE POOL. * H. IF =7, GO TO 6. TO REMOVE A SLAVE ENTRY & RETURN IT TO THE POOL. * I. IF =8, GO TO 4. TO ADD AN HP3000 PROCESS. * J. IF=10, GO TO 6. TO REMOVE AN HP3000 PROCESS. * K. IF=11, SET SEARCH KEY OFFSET TO 5 (6TH TCB WORD IS SEARCH KEY) AND * GOTO 6. * L. IF=12, GO TO 6. TO SET THE M.A. REQUEST ACKNOWLEDGEMENT FLAG * M. IF=13, GO TO 6. TO TEST " " " " " * * NOTE: THE M.A. ACKNOWLEDGEMENT FLAG IS DOCUMENTED IN THE MESSAGE * ACCOUNTING SOFTWARE. * * N. IF=14, THEN SAME AS 2, BUT SKIP SEARCH FOR "OBSOLETE" ENTRIES. * M. IF NONE OF THE ABOVE - ERROR #2 --- REJECT! SPC 1 * 4. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE MASTER LIST. * A. IF NONE AVAILABLE, CALLER HAS NOT CHECKED AVAILABILITY OF * TABLE-ACCESS RN (#TBRN) BEFORE ENTRY - ERROR #3 --- REJECT! * B. IF ENTRY AVAILABLE, SEARCH BY ID SEG. ADDR. FOR OBSOLETE * ENTRIES IN THE MASTER REQUEST LIST (EXCEPT IF MODE =12). * C. FLAG ALL OBSOLETE MASTER-REQUEST ENTRIES AS BAD, IF THEY * ORIGINATED WITH SAME REQUESTOR (BIT#15 =1 OF WORD#5). * D. LINK THE NEW ENTRY INTO THE MASTER REQUEST LIST. * E. USE TIMEOUT SPECIFIED IN CALL, OR USE #MSTO IF VALUE IS ZERO. * F. TRANSFER THE CALLER'S DATA INTO THE NEW ENTRY. * G. IF ENTRY POOL NOT DEPLETED, CLEAR TABLE-ACCESS RN & RETURN. SPC 1 * 5. CHECK FOR AVAILABLE E%NTRY, BEFORE ADDING TO THE SLAVE-STREAM LIST. * A. IF NONE, #TBRN NOT CHECKED BEFORE ENTRY - ERROR #3 --- REJECT! * B. CHECK STREAM PARAMETER FOR ACCEPTABLE TYPE--ERROR #1, IF INVALID. * C. LINK THE NEW ENTRY INTO THE SPECIFIED SLAVE-STREAM LIST. * D. TRANSFER CALLER'S DATA INTO THE NEW ENTRY. * E. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 6. INITIALIZE LIST POINTERS, BEFORE SEARCHING FOR/CLEARING AN ENTRY. * A. IF IMPROPER LIST SPECIFIED - ERROR #1 --- REJECT! * B. SEARCH FOR ENTRY. IF ENTRY NOT LOCATED, REJECT---ERROR #4! * C. IF MODE=4/5, GET CONTENTS OF ENTRY WORD#4 & RETURN TO CALLER. * D. IF MODE=6/7, GET CONTENTS OF WD#4 & RE-LINK ENTRY IN NULL LIST. * E. CHECK MODE AGAIN: IF 12, THEN SET M.A. REQUEST ACKNOWLEDGEMENT * FLAG & RETURN CLASS # # TCB ADDR. * IF 13, THEN RETURN WITH ONLY M.A. R.A. FLAG * IN (A): IF 0 THEN FLAG CLEAR, * ELSE #0 IF FLAG SET. DON'T DEPEND * ON A PARTICULAR VALUE, IN CASE * THIS CHANGES. * F. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 7. VERIFY CALLER KNOWS CORRECT SECURITY CODE BEFORE ALLOCATING OR * DE-ALLOCATING SAM. * A. IF MODE & #FWAM =0, GO TO ALLOCATE SYSTEM AVAILABLE MEMORY. * B. IF REQUEST GRANTED, STORE BLOCK ADDRESS IN #FWAM, SIZE IN #SAVM. * D. IF REQUEST DENIED, RETURN REASON IN , FOR FURTHER ANALYSIS. * E. IF MODE=1 & PRAM1=#FWAM, RETURN MEMORY TO THE SYSTEM. * F. CLEAR #FWAM & #SAVM, BEFORE RETURNING TO . SKP * #RSAX CALLING SEQUENCE: * * JSB #RSAX * DEF RTN * DEF MODE MODE OF OPERATION (0 THRU 7) * DEF PRAM1 REQUIRED PARAMETER (SEE TABLE, BELOW) * DEF PRAM2 REQUIRED FOR MODES: 2,3,5,7 [OPTIONAL MODES: 0,1,4,6] * DEF 0PRAM3 REQUIRED FOR MODES 2 & 3 ONLY (NODAL ADDRESS) * DEF PRAM4 OPTIONAL FOR MODES 2,8 & 12 ONLY (MASTER TIME-OUT) *RTN : NORMAL-(SEE TABLE); ERROR-(SEE LATER DESCRIPTION) * * WHERE: * * +----+------------+--------------+------------+---------+-------+-------+ * !MODE! ACTION ! PRAM1 ! PRAM2 ! PRAM3 ! RTN! RTN! * !====+============+==============+============+=========+=======+=======+ * ! 0 ! GET MEMORY !#WORDS TO GET ! SECURITY ! NOT USED!FWA SAM! #WORDS! * ! ! ! ! CODE ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 1 ! RTN MEMORY !FWA SAM BLOCK ! SECURITY ! NOT USED! 0 ! 0 ! * ! ! ! ! CODE ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 2 ! ADD MASTER !MASTER CLASS# !MA 'SEND'CNT! NOT USED!LOC SEQ!TCB ADR! * ! ! ! NOTE: PRAM4 = MASTER TIME-OUT VALUE ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 3 ! ADD SLAVE !ORIG. SEQ. NO.!SLAVE STREAM!ORIG.NODE!LOC SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 4 ! FIND MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# !TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 5 ! FIND SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 6 !CLEAR MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 7 !CLEAR SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 8 ! ADD PNL ! LOGGING LU # !REMOTE SES ! REMOTE !LOC.SEQ!TCB ADR! * ! ! ! ) ! ID/SMP # ! NOTE # ! ! ! * ! ! ! NOTE: PRAM4 = MPE/RTE FLAG WORD ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 10 ! CLEAR PNL !REMOTE SESSION! REMOTE NODE! NOT USED! LOG LU! 0 ! * ! ! ! ID/SMP # ! NUMBER ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 11 ! FIND MA SEQ! M.A. SEQ. # ! NOT USED ! NOT USED! CLASS#! TCB ! * ! ! NUMBER ! ! ! ! ! ADDR ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 12 !SET REQUEST ! M.A. SEQ. # ! NOT USED ! NOT USED! CLASS#! TCB ! * ! !ACKNOWLEDGED! ! ! ! ! ADDR ! * ! !FLAG, SEE 16! ! ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 14 ! ADD MASTER ! SAME AS # 2, BUT NO SEARCH FOR OBSOLETE ENTRIES ! * +----+------------------------------------------------------------------+ * ! 16 !TEST REQUEST!LOCAL SEQ. NO.! NOT USED ! NOT USED!0 IF ! TCB ! * ! !ACKNOWLEDGED! ! ! !FLAG 0 ! ADDR ! * ! !FLAG, SEE 12! ! ! !ELSE<>0! ! * +----+------------+--------------+------------+---------+-------+-------+ * * IN PNL ENTRIES, CONTAINS -1 FOR MPE SESSIONS. * * #RSAX ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER WITH THE * REQUESTED ACTION NOT PERFORMED. * * = -1: AN INVALID LIST HAS BEEN SPECIFIED; FIRST CALLER * IS NOT ; MEMORY ALLOCATION/DE-ALLOCATION IMPROPER. * * = -2: THE SPECIFIED MODE OF OPERATION IS UN-DEFINED. * * = -3: NO SPACE FOR A NEW ENTRY. THE CALLER DID NOT WAIT FOR * THE TABLE-ACCESS RESOURCE NUMBER (#TBRN) TO BE CLEARED, * PRIOR TO CALLING #RSAX. (THIS SHOULD NOT OCCUR IF ALL * CALLERS ADHERE TO THE RN CONVENTION, PRIOR TO CALLING.) * * = -4: ENTRY CANNOT BE LOCATED; ACCESSING AN EMPTY LIST. * * MODE 0 ( ALLOCATION ): ==-1 IF BAD SECURITY CODE SPECIFIED. * ELSE: * =-1,=MAXIMUM POSSIBLE NO. OF WORDS. * = 0,=MAXIMUM WORDS AVAILABLE NOW. * 1 (DE-ALLOCATION): = = -1 IF ADDRESS OF BLOCK BEING * RETURNED IS NOT EQUAL TO #FWAM, OR IF * SECURITY CODE IS INCORRECT. SKP * LIST FORMATS: * * 'RES' SYSTEM AVAILABLE MEMORY * ------------------------------- ------------------------- * * #PNLH < ADDR 1ST PROCESS# LIST ENTRY>... * <0!D! 0 > * < REMOTE NODE NUMBER > * < 0 ! LOCAL TERM- > * INAL LU * * * * BIT 14 OF WORD 3 (D) IS SET FOR MPE SESSIONS, * CLEAR FOR RTE SESSIONS. * * #MRTH < ADDR.=1RST MASTER-LIST ENTRY>... * < UDF-----*TIMEOUT CNTR. > * < LOCAL SEQUENCE NUMBER > * * * * * #ST00 ... * . <- * MONITOR'S CLASS NUMBER > < UD------*TIMEOUT CNTR. > * . < LOCAL SEQUENCE NUMBER > * . < MONITOR NAME (CHARS 3 & 4 > < ORIGIN SEQUENCE NUMBER > * . < MONITOR NAME (CHAR 5) > < ORIGIN NODAL ADDRESS > * . < *** RESERVED ******** > * . * . * #STXX < ******* FORMAT SAME ******* >...< **** FORMAT SAME ***** > * < ********* FOR ALL ********* > < ******** FOR ********* > * < ****** SLAVE STREAMS ****** > < ******** ALL ********* > * < *************************** > < ******* SLAVE ******** > * < *************************** > < ****** STREAMS ******* > * < ********************** > * * WHERE: - = RESERVED FOR FUTURE USE. A(#15) = ABORT OK. * B(#15) = DUPLICATE ENTRY, OR ONE WHICH MAY BE DELETED. * SET TO "FLAG" 'UPLIN' THAT THIS TCB MAY BE RELEASED. * C(#15) = LONG MASTER TIMEOUT (APPROXIMATELY 20 MIN.) * U(#15) = UPLIN TEMPORARY BIT. D(#14) = HP3000 REQUEST. * F(#13) = M.A. "REQUEST ACKNOWLEDGED" FLAG. 1 = SET, 0=CLEAR * * *NOTE: 0 IN LIST HEAD OR FIRST WORD OF ENTRY SIGNALS END OF LIST. * * * NETWORK ROUTE VECTOR TABLE: * * #NCNT < NEGATIVE NUMBER OF NRV PAIRS> * NRV TABLE FORMAT: * * +--------------------------+ * #NRV----> ! CPU NUMBER (16-BITS) ! * +--------------------------+ * ! TIME-OUT ! FORMAT # ! * ! (8 BITS) ! (8 BITS) ! * +----------+---------------+ * !RESERVED!N! COMM-LINK LU ! * !(7 BITS)! ! (8 BITS) ! * +----------+---------------+ * * N = 1 IF CPU IS NEIGHBOR TO LOCAL NODE, ELSE 0 SKP MODEp NOP MODE OF OPERATION. PRAM1 NOP USER PRAM2 NOP SPECIFIED PRAM3 NOP PARAMETERS. PRAM4 NOP SUP [SUPPRESS EXTENDED LISTING] #RSAX NOP ENTRY/EXIT: TCB MANAGEMENT. JSB $LIBR DECLARE THIS TO BE NOP A PRIVILEGED ROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES DEF MODE FOR PARAMETERS & RETURN POINT. * INIT JSB CONFG 1RST ENTRY: CONFIGURE; 'NOP' THEREAFTER. * CLA [PROTECT AGAINST MISSING PARAMETER] STA GOOD CLEAR SEARCH FLAG LDA PRAM1,I OBTAIN STA PRAM1 PARAMETERS STA KEYWD (ASSUME THIS IS OUR SEARCH KEY) CLA FOR LDA PRAM2,I LOCAL USE, STA PRAM2 IN PREPARATION CLA FOR A LDA PRAM3,I POSSIBLE STA PRAM3 DMS MAP-SWITCH. CLA LDA PRAM4,I STA PRAM4 CLA LDB MODE,I GET THE MODE OF OPERATION, SSB NEGATIVE MODE? JMP ERR02 YES, ILLEGAL MODE! STB MODE AND SAVE IT LOCALLY, ALSO. * DMS1 JMP MODCK BYPASS MAP CODE: RTE-M-II / 'NOP': RTE-M-III&RTE-IVB * RSA GET CURRENT MAP STATUS. RAL,RAL POSITION CURRENT STATUS FOR RESTORATION. STA DMSTS SAVE FOR RESTORATION BEFORE EXIT. SJP MODCK ENABLE SYSTEM MAP AND CONTINUE. * DMSTS NOP DMS MAP-STATUS STORAGE. * MODCK EQU * HERE TO CHECK FOR LEGAL MODE & BRANCH TO PROCESSOR LDA B PICK UP MODE ADA NMODX SUBTRACT MAX. ALLOWABLE 'MODE' CODE SSA,RSS TOO BIG? JMP ERR02 YES, ERROR! LDA B RECOVER MODE AGAIN ADA @JTBL ADD JUMP TABLE ADDRESS JMP A,I & BRANCH TO PROPER PROCESSOR SPC 2 * 'JUMP' TABLE. DO NOT DISTURB ORDER! * @JTBL DEF *+1,I MODE ACTION DEF SAM 0 ALLOCATE MEMORY. DEF SAM 1 RETURN MEMORY TO RTE DEF ADENT 2 CREATE A MASTER TCB ENTRY DEF ADENT 3 CREATE A SLAVE TCB ENTRY DEF FIND 4 SEARCH FOR A MASTER TCB ENTRY DEF FIND 5 SEARCH FOR A SLAVE TCB ENTRY DEF FIND 6 SEARCH FOR/CLEAR A MASTER TCB ENTRY DEF FIND 7 SEARCH FOR/CLEAR A SLAVE TCB ENTRY DEF ADENT 8 CREATE A PROCESS # ENTRY DEF ERR02 9 *** ERROR, ILLEGAL MODE *** DEF FNPNL 10 SEARCH FOR/CLEAR A PROCESS # ENTRY DEF FNDMA 11 FIND MASTER TCB GIVEN M.A. SEQ. NUMBER DEF FNDMA 12 SET M.A. REQUEST ACKNOWLEDGEMENT FLAG DEF ERR02 13 *** ERROR, ILLEGAL MODE *** DEF ADENT 14 CREATE A MASTER ENTRY (W/O DUPL. ENTRY SEARCH) DEF ERR02 15 *** ERROR, ILLEGAL MODE *** DEF FIND 16 TEST M.A. REQUEST ACKNOWLEDGEMENT FLAG * NMODX ABS @JTBL-* NEG. SIZE OF TABLE SPC 10 * ADD A NEW ENTRY TO THE MASTER OR SLAVE-STREAM LIST. SPC 1 ADENT LDA #NULL GET THE NULL LIST LINK-WORD. SZA,RSS IS AN ENTRY AVAILABLE FROM THE POOL? JMP ERR03 * NO. ERROR #3: NO ENTRY AVAILABLE! STA ENTAD YES. SAVE ADDRESS OF NEW ENTRY. * INA POINT TO THE SECOND WORD OF THE ENTRY. STA ENPNT SAVE THE POINTER FOR ENTRY BUILDING. CPB P14 BUILT NEW MASTER W/O "OBS.ENTRY" SEARCH? JMP MST0 YES CPB P8 IS THIS A PNL ENTRY? JMP MSTAD . YES SKP "OBS ENTRY" SEARCH CLE,SLB IF THIS IS TO BE A SLAVE ENTRY, JMP SLVAD THEN SKIP THE SEARCH FOR MASTER ENTRIES. * LDA MDEF INITIALIZE THE LIST PTR TO REFERENCE STA LSTAD THE MASTER LIST. * LDA XEQT SEARCH KEY IS: ID SEGMENT ADDRESS STA KEYWD LDA P4 EXAMINE FIFTH WORD OF EACH MASTER TCB. MLOOK JSB SERCH FIND ENTRIES WITH SAME CLASS OR PROCESS #. JMP MSTAD END-OF-LIST: GO TO ADD NEW ENTRY. ADB P4 GET THE 5TH WORD (ID SEGMENT ADDRESS) LDA B,I FROM ENTRY WITH SAME NUMBER. IOR SIGN ADD BAD-ENTRY FLAG (BIT#15). STA B,I RETURN MODIFIED WORD.(UPLIN CLEARS TCB). JMP MLOOK SEARCH FOR MORE OBSOLETE ENTRIES.[E=1]. * MSTAD CCB CHECK FOR LDA MODE NEW PROCESS CPA P8 NUMBER MODE. RSS YES, STAY IN-LINE JMP MST0 LDA PRAM4 PICK UP TIME-OUT WORD JMP SETIM GO SET TIMEOUT * MST0 EQU * CLB,INB SET MASTER TCB LIST CODE LDA PRAM4 LOAD MASTER TIME-OUT JMP SETIM * SLVAD JSB LSTCK PREPARE REFERENCES FOR THE SLAVE LIST. ADA P2 POINT TO WORD #3 OF SLAVE-STREAM HEAD. LDA A,I GET THE MONITOR I.D. SEGMENT ADDRESS. SZA,RSS IF THE MONITOR HAS NOT BEEN INITIALIZED, JMP ERR01 THEN NOTHING MAY BE ADDED TO THIS LIST! LDA #SVTO VALID LIST: GET SLAVE TIMEOUT VALUE. * SETIM STA ENPNT,I SET TIMEOUT INTO ENTRY WORD #2 ISZ ENPNT POINT TO NEXT WORD OF ENTRY CLA OBTAIN AN ENTRY FROM THE NULL LIST. JSB LNK GO PROCESS LIST CHANGES.[B=LIST CODE] SZA LIST-PROCESSING ERROR? JMP ERR04 YES--INFORM THE CALLER! * LDA PRAM3 USE THIRD PARAMETER LDB MODE INSTEAD OF SEQUENCE CPB P8 NUMBER FOR MODE 8. JMP STOR3 STORE IN THIRD TCB WORD. * SKP SPC 3 LDA SEQN GET THE LAST SEQUENCE NUMBER. INA,SZA,RSS ADVANCE THE COUNT & TEST FOR ZERO. CLE,INA ROLL-OVER: RESET TO ONE. STA SEQN SAVE THE CURRENT SEQUENCE NUMBER. STOR3 STA ENPNT,I INSERT IT INTO THE THIRD ENTRY WORD. ISZ ENPNT ADVANCE THE ENTRY POINTER. LDA MODE IF A SLAVE-ENTRY IS TO BE CLE,ERA ADDED, SET =1. LDA PRAM1 GET THE CALLER'S PARAMETERS pN LDB XEQT GET CALLER'S ID SEGMENT ADDRESS SEZ SLAVE-LIST ADDITION? LDB PRAM3 YES, GET THE ORIGIN NODAL ADDRESS. DST ENPNT,I ADD PARAMETERS TO ENTRY WORDS #4,#5. ISZ ENPNT BUMP POINTER TO ISZ ENPNT WORD 6 LDA PRAM2 LOAD 'M.A.' SEQUENCE NUMBER STA ENPNT,I STORE IN 6TH T.C.B. WORD * LDA SEQN RETURN WITH: =CURRENT SEQUENCE NO. LDB ENTAD =ENTRY ADDRESS. JMP EXIT GO TO PREPARE FOR RETURN TO CALLER. * SEQN NOP TRANSACTION SEQUENCE NUMBER. * SPC 3 * ERROR PROCESSING AND EXIT SECTION. SPC 1 ERR04 LDA P4 =4: ENTRY CANNOT BE LOCATED. JMP ERR00 ERR03 LDA P3 =3: NEW ENTRY NOT AVAILABLE. JMP ERR00 ERR02 LDA P2 =2: INVALID MODE PARAMETER. RSS ERR01 CLA,INA =1: INVALID LIST PARAMETER. * ERR00 CMA,INA NEGATE THE ERROR CODE. STA B ARE THE SAME FOR ERROR RETURN. * EXIT DST TEMP SAVE TEMPORARILY. CLA CLEAR PARAMETER ADDRESSES STA MODE TO FACILITATE CHECKING STA PRAM1 FOR MISSING PARAMETERS STA PRAM2 UPON NEXT ENTRY OF <#RSAX>. STA PRAM3 STA PRAM4 LDA #NULL IF NO TCB ENTRIES REMAIN AVAILABLE SZA,RSS IN THE ENTRY POOL, THEN DO NOT JMP RETRN CLEAR THE TABLE-ACCESS RN; ELSE, LDA #TBRN GET THE TABLE-ACCESS RN AND GO TO RTE JSB $CGRN TO MAKE IT AVAILABLE FOR NEXT ACCESS. RETRN DLD TEMP RESTORE THE RETURN-DATA TO & . * DMS2 JMP LBEX BYPASS MAP CODE: RTE-II / 'NOP': RTE-III JRS DMSTS LBEX *** RESTORE THE APPROPRIATE MAPS *** * LBEX JSB $LIBX RETURN TO THE CALLER, VIA THE RTE DEF #RSAX PRIVILEGED ROUTINE PROCESSOR. * SKP * SEARCH FOR & CLEAR PROCESS NUMBER LIST ENTRY * FNPNL EQU * LDA PDEF INITIALIZE SEARCH LIST HEAD TO STA LSTAD PROCESS NUMBER LIST CCA,CLE INITIALIZE LIST CODE FOR PNL STA LSTCD LDA P5 SET OFFSET TO SESSION ID WORD STA OFSET JMP FINDX AND SEARCH FOR ENTRY SPC 2 * SEARCH FOR MASTER & SLAVE TCB ENTRIES. CLEAR AND RETURN TO POOL, * IF REQUESTED. SPC 1 FIND EQU * LDA P2 SEARCH KEY WILL BE THIRD WORD IN TCB * FIND. EQU * STA OFSET * LDA MDEF INITIALIZE POINTERS STA LSTAD TO THE CLA,INA MASTER STA LSTCD LIST. * CLE,SLB IF THIS IS A SLAVE REQUEST, THEN JSB LSTCK ESTABLISH REFERENCES TO THE SLAVE LIST. * FINDX EQU * HERE TO START/RESUME SEARCH LDA OFSET LOAD OFFSET IN TCB TO SEARCH KEY. JSB SERCH GO TO LOCATE THE TCB ENTRY [E=0]. JMP ERR04 * ERROR #4: ENTRY CANNOT BE LOCATED! * * STB ENTAD SAVE THE ENTRY ADDRESS FOR LATER USE. LDA MODE GET THE MODE OF OPERATION CPA P10 CLEAR PNL? JSB FPNLX YES, CHECK FURTHER, RETURN IF TRUE MATCH ADB P3 POINT TO THIRD WORD, FOR LATER USE, STB ENPNT IN RETURNING THE CONTENTS TO CALLER. * CPA P6 ARE WE JMP RELS SUPPOSED TO CPA P7 RELEASE THIS JMP RELS TCB? CPA P10 JMP RELS * JMP FOUND NONE OF THE ABOVE, DON'T RELEASE THE TCB * RELS LDA LSTCD REMOVE ENTRY FROM THE SPECIFIED LIST. CLB,CLE RETURN IT TO THE NULL LIST. JSB LNK GO TO PROCESS THE LIST CHANGES. CCE,SZA LIST PROCESSING ERROR? JMP ERR04 YES! GO TO INFORM THE CALLER. STA ENTAD ASSURE RETURNS W/ ZERO * FOUND EQU * LDA MODE IS THIS REQUEST TO: CPA P12 SET REQUEST ACKNOWLEDGEMENT FLAG? JMP SETRA .. YES, GO SET IT CPA P16 TEST R.A. FLAG? JMP TSTRA Ϭ .. YES, GO TEST IT * FOND1 EQU * RETURN POINT FOR ALL "FIND TCB" PROCESSORS LDA ENPNT,I GET WORD #4 FOR RETURN TO CALLER. FOND2 LDB ENTAD GET THE TCB ADDRESS; JMP EXIT ELSE, RETURN WITH =0. SPC 2 * HERE WHEN A PNL ENTRY HAS BEEN FOUND WHICH MATCHES * THE REMOTE SESSION ID NUMBER. IF REMOTE NODE NUMBER ALSO MATCHES, * THEN A GOOD MATCH HAS BEEN FOUND. OTHERWISE, CONTINUE SEARCH. * FPNLX NOP ADB P2 POINT TO REMOTE NODE NUMBER LDB B,I LOAD REMOTE NODE NUMBER CPB PRAM2 MATCH? RSS YES JMP FINDX NO MATCH, RESUME SEARCH AT NEXT ENTRY. LDB ENTAD RECOVER REGISTER & RETURN JMP FPNLX,I * * HERE TO FIND MASTER TCB, GIVEN M.A. SEQUENCE NUMBER * OPERATION IS THE SAME AS "FIND MASTER TCB" (MODE 4), EXCEPT * THAT THE SEARCH KEY IS THE 6TH WORD IN THE TCB, INSTEAD * OF THE THIRD. FNDMA EQU * LDA P5 6TH WORD IS SEARCH KEY LDB P4 (ESTABLISH MASTER LIST PNTRS) STA GOOD SET SEARCH FLAG TO ONLY GOOD TCBS JMP FIND. * SETRA EQU * HERE TO SET REQUEST ACKNOWLEDGEMENT FLAG LDB ENTAD GET ADDRESS INB OF THE FLAG LDA B,I GET THE FLAG, IOR RAFLG SET IT, STA B,I AND PUT IT BACK. ADB P4 --> TCB+5 CLA CLEAR THE MA IDENTIFIER STA B,I JMP FOND1 AND RETURN TO CALLER * RAFLG OCT 20000 BIT # 13 * TSTRA LDB ENTAD GET THE ADDRESS INB OF THE FLAG LDA B,I GET THE FLAG ITSELF AND RAFLG AND RETURN TO CALLER WITH ONLY THAT BIT SET JMP FOND2 * ENPNT NOP POINTER INTO TCB ENTRY. ENTAD NOP TCB ADDRESS STORAGE. * SKP * SYSTEM AVAILABLE MEMORY ALLOCATION/DE-ALLOCATION PROCESSOR. SPC 1 SAM EQU * LDA PRAM2 GET CALLER'S SECURITY CODE UNL CPA SECOD CODES MATCH? LST RSS CODES MATCH: ALLOW ACCESS, ELSE JMP ERR01 REPORT IMPROPER ACCESS! * LDA PRAM1 GET THE CALLER'S PARAMETER. SLB IF THE REQUEST IS FOR DE-ALLOCATION, JMP RTSAM GO TO RETURN THE MEMORY TO THE SYSTEM. * STA SZMEM ALLOCATE: SAVE NO. OF WORDS REQUESTED. LDA #FWAM IF SYSTEM-AVAILABLE-MEMORY SZA HAS ALREADY BEEN ALLOCATED, JMP ERR01 THEN REJECT THE REQUEST! * JSB $ALC REQUEST SYSTEM AVAILABLE MEMORY (S.A.M.) SZMEM DEC 128 IN THE AMOUNT SPECIFIED BY THE CALLER. JMP DMS2 * NEVER AVAILABLE: =-1,=MAX EVER JMP DMS2 * NOT AVAILABLE NOW: =0,=MAX NOW STA #FWAM O.K. SAVE THE ADDRESS OF MEMORY BLOCK. STB #SAVM SAVE THE SIZE OF THE MEMORY BLOCK. JMP DMS2 RETURN WITH S.A.M. SPECIFICATIONS. * RTSAM CPA #FWAM IS CALLER SPECIFYING CORRECT BLOCK? RSS YES. PROCESS THE DE-ALLOCATION. JMP ERR01 NO. ** IGNORE THE REQUEST! ** * LDB #SAVM GET THE BLOCK-SIZE SPECIFICATION. DST RTN CONFIGURE THE DE-ALLOCATION REQUEST. * JSB $RTN RETURN A SYSTEM-AVAILABLE-MEMORY BLOCK; RTN NOP BEGINNING AT SPECIFIED ADDRESS, AND NOP CONTAINING SPECIFIED NO. OF WORDS. CLA CLEAR THE STORAGE LOCATIONS FOR: STA #FWAM MEMORY BLOCK ADDRESS. STA #SAVM MEMORY BLOCK SIZE. JMP DMS2 RETURN TO THE CALLER. UNL SECOD DEC 3360 LST SKP * SUBROUTINE TO CHECK LIST PARAMETER & SET LIST CODE & LIST ADDRESS. SPC 1 * ENTER: = DON'T CARE. * RETURN: =LIST ADDRESS; =LIST CODE. * ERROR - RETURN VIA ERROR EXIT WITH ERROR #1. * LSTCK NOP ENTRY/EXIT: LIST ID ROUTINE. LDA PRAM2 GET THE STREAM PARAMETER. AND B77 ISOLAwTE THE STREAM NUMBER. ADA P2 ADD OFFSET FOR NULL & MASTER LISTS. STA LSTCD SAVE FOR USE ELSEWHERE. STA B SAVE FOR RETURN TO CALLER. ADA NMAX CHECK FOR SPECIFICATION CLE,SSA,RSS OF AN UN-DEFINED LIST. JMP ERR01 * ERROR #1: INVALID LIST! LDA #LDEF GET THE LIST-TABLE ADDRESS. ADA B INDEX TO THE PROPER ENTRY. LDA A,I GET THE LIST ADDRESS. STA LSTAD SAVE THE ADDRESS FOR LATER USE. JMP LSTCK,I RETURN TO THE CALLER. * B77 OCT 77 LSTAD NOP ADDRESS OF LIST HEADER. LSTCD NOP LIST IDENTIFICATION CODE. * SKP * SUBROUTINE TO SEARCH FOR A SPECIFIC LIST ENTRY. SPC 1 * ENTER: = OFFSET INTO TCB ENTRY; = DON'T CARE. * =0: SEARCH FROM TOP; =1: CONTINUE SEARCH. * 'LSTAD' SET TO ADDRESS OF LIST TO BE SEARCHED. * 'KEYWD' CONTAINS SEARCH KEY * * RETURN: P+1 -- ENTRY NOT LOCATED; MEANINGLESS, =0. * P+2 -- ENTRY WAS LOCATED; MEANINGLESS, = ENTRY ADDRESS. * SERCH NOP ENTRY/EXIT:LIST SEARCH ROUTINE. LDB TEMP+1 GET NEXT-ENTRY ADDRESS TO CONTINUE. SEZ IS THIS A REQUEST TO CONTINUE? JMP SLOOP YES. GO TO CONTINUE THE SEARCH. STA OFSET SAVE OFFSET INTO TCB ENTRY. LDB LSTAD GET TOP-OF-LIST ADDRESS. * SLOOP LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB,RSS IS THIS THE END OF THE LIST? JMP SERCH,I YES. TAKE "NOT FOUND" EXIT (P+1). * STB TEMP+1 SAVE POINTER TO NEXT ENTRY. LDA GOOD ONLY GOOD TCBS WANTED? SZA,RSS JMP SER1 . NO BAD TCBS OK LDA P4 ADA B --> ID SEGMENT ADDRESS TCB+4 LDA A,I CHECK FOR BAD BIT SET CCE,SSA BAD BIT SET? JMP SLOOP . YES IGNORE THIS TCB SER1 ADB OFSET POINT TO KEYWORD LOCATION. LDA B,I GET THE KEYWORD. LDB TEKMP+1 PREPARE TO RETURN WITH ENTRY ADDRESS. CPA KEYWD DOES IT MATCH THE CALLER'S KEYWORD? CCE,RSS YES. SET FOR CONTINUATION--SKIP. JMP SLOOP NO. CONTINUE SEARCHING. * ISZ SERCH ENTRY FOUND: SET RETURN TO P+2. JMP SERCH,I RETURN TO THE CALLER. * OFSET NOP KEYWORD OFFSET INTO TCB ENTRY. KEYWD NOP SEARCH KEY GOOD NOP IF SET, ONLY "GOOD" TCBS WANTED * SKP * SUBROUTINE TO PROCESS LIST LINKAGE. SPC 1 * ENTER: = CODE OF REMOVAL LIST; = CODE OF ADDITION LIST. * 'ENTAD' SET TO ADDRESS OF ENTRY TO BE REMOVED. * * RETURN: & =0: NORMAL; =-1, =UNCHANGED: ERROR. * LNK NOP ENTRY/EXIT: LIST LINK ROUTINE. STA TEMP SAVE REMOVAL-LIST CODE, TEMPORARILY. ADA #LDEF FIND THE TABLE ADDRESS. LDA A,I GET ADDRESS: TOP-OF-REMOVAL-LIST. LNK1 STA PNTR SAVE LIST POINTER. LDA A,I GET THE LINK TO THE NEXT ENTRY. SZA,RSS IF THIS IS THE END OF THE LIST, JMP LNKER THEN INFORM THE CALLER OF THE ERROR. CPA ENTAD IS THIS THE ENTRY TO BE REMOVED? RSS YES. SKIP TO REMOVE IT. JMP LNK1 NO. TRY THE NEXT ONE. LDA ENTAD,I GET THE LINK TO THE FOLLOWING ENTRY, STA PNTR,I AND MOVE IT TO THE PREVIOUS ENTRY. * ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET ADDRESS: TOP-OF-ADDITION-LIST. LNK2 STB PNTR SAVE LIST POINTER. LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB IS THIS THE END OF THE LIST? JMP LNK2 NO. CONTINUE SEARCHING FOR THE END. STB ENTAD,I YES. MAKE NEW ENTRY = END-OF-LIST. LDA ENTAD GET THE ADDRESS OF THE NEW ENTRY. STA PNTR,I SAVE IN LINK-WORD OF PREVIOUS ENTRY. * LDA MODE IF MODE IS CPA P14 NOT = 14 CLA AND ADA M8 >= 8 THEN SSA,RSS ^q PROCESSING JMP LNKER-1 IS ALL DONE. * CPB TEMP REMOVING ENTRY FROM NULL LIST? [=0] CLA,INA,RSS YES. PREPARE TO ADD TO ACTIVE COUNT. CCA NO. PREPARE TO DECREMENT ACTIVE COUNT. ADA #BUSY COMPUTE THE NEW 'ACTIVE-ENTRY' COUNT, STA #BUSY AND UPDATE THE INDICATOR. CLA,RSS INDICATE NORMAL RETURN, AND SKIP. LNKER CCA =-1: NO ENTRIES IN REMOVAL LIST. JMP LNK,I RETURN IS MADE TO THE CALLER. * PNTR NOP LIST POINTER STORAGE. * SKP * TABLE OF LIST-HEADER ADDRESSES. LIST CODES: SPC 1 #LDEF DEF SOT START-OF-TABLE DEFINITION. PDEF DEF #PNLH HP3000 PROCESS NUMBER HEADER -01 SOT DEF #NULL ENTRY-POOL HEADER 00 MDEF DEF #MRTH MASTER-REQUEST HEADER 01 SDEF DEF #ST00 SLAVE-STREAM 00 HEADER 02 DEF #ST01 SLAVE-STREAM 01 HEADER 03 DEF #ST02 SLAVE-STREAM 02 HEADER 04 DEF #ST03 SLAVE-STREAM 03 HEADER 05 DEF #ST04 SLAVE-STREAM 04 HEADER 06 DEF #ST05 SLAVE-STREAM 05 HEADER 07 DEF #ST06 SLAVE-STREAM 06 HEADER 10 DEF #ST07 SLAVE-STREAM 07 HEADER 11 DEF #ST08 SLAVE-STREAM 08 HEADER 12 DEF #ST09 SLAVE-STREAM 09 HEADER 13 DEF #ST10 SLAVE-STREAM 10 HEADER 14 DEF #ST11 SLAVE-STREAM 11 HEADER 15 * NEW ENTRY: .........DEF #STXX.....SLAVE-STREAM XX HEADER........15 * NMAX ABS SDEF-*-2 LIST CODE VALIDITY-CHECKING CONSTANT. * #MNUM ABS NMAX-SDEF NUMBER OF SLAVE-STREAM TYPES. SPC 1 * CONSTANTS AND STORAGE. SPC 1 M8 DEC -8 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P10 DEC 10 P12 DEC 12 P16 DEC 16 P14 DEC 14 SIGN OCT 100000 TEMP OCT 0,0 TEMPORARY STORAGE LOCATIONS. SPC 1 D$BSZ NOP E MSG SIZE MAX FOR MPE LINK * HP3000 ID SEQUENCE SPECIFICATIONS * D$LID DEF LOC LOCAL ID SEQUENCE ADDRESS D$RID DEF REM REMOTE ID SEQUENCE ADDRESS SPC 1 #RDLY DEC -200 MAXIMUM RTRY DELAY: 200 CENTOSECONDS (2 SEC.) #PRLU DEF #PRGL DEFAULT LU FOR PROGL MESSAGES: NO MESSAGES * (NOTE: #PRGL IS IN #REQU. IT MUST BE SEPARATED * IN ORDER TO ALLOW 'ABS' AT GEN-TIME TO WORK, AS WELL * AS ON-LINE PATCHES TO #PRLU) * * GENERAL SYSTEM DATA [ INITIALIZED BY 'DINIT' ]. * * NOTE: ANY CHANGE IN THE ORDERING OF THIS AREA MUST BE ACCOMPANIED * BY A CHANGE TO THE CORRESPONDING AREA OF 'DINIT' * SPC 1 #SCLR DEF #TBRN START OF AREA CLEARED BY 'DINIT'. #FWAM NOP ADDRESS OF SYSTEM AVAIL. MEMORY BLOCK. #SAVM NOP SIZE OF SYSTEM AVAIL. MEMORY BLOCK. #TBRN NOP TABLE-ACCESS RESOURCE NUMBER. #QRN NOP QUIESCENT(RN) OR SHUT-DOWN(0). #GRPM NOP GENERAL PRE-PROCESS MODULE CLASS NO. #QCLM NOP QUEUE CLEAN-UP MONITOR CLASS NUMBER. #BUSY NOP NUMBER OF ACTIVE TCB ENTRIES. #MSTO NOP MASTER REQUEST TIMEOUT VALUE. #SVTO NOP SLAVE REQUEST TIMEOUT VALUE. #RTRY NOP RETRY-PROCESSOR'S CLASS NUMBER. #WAIT NOP D65MS QUIESCENT WAIT INTERVAL. #SWRD NOP NETWORK-NODE SECURITY CODE. #BREJ NOP D65MS RETRY COUNT FOR BUSY REJECT. #INCV NOP INCOMING MSG CNVTR CLASS NUMBER #OTCV NOP OUTGOING MSG CNVTR CLASS NUMBER #MHCT NOP MAXIMUM HOP COUNT #MDCT NOP MAX. # TIMES A LINK CAN GO DOWN IN 5 MIN. #RPCV NOP HP3000 REPLY CONVERTER CLASS NO. #RQCV NOP HP3000 REQUEST CONVERTER CLASS NO. #LU3K NOP LU NUMBER OF HP3000 #QZRN NOP QUEZ RN FOR "LISTEN MODE" #CLRN NOP QUEX RESOURCE NUMBER FOR CLEANUP #QXCL NOP QUEX CLASS NO. #TST NOP HP3000 TRANS. STATUS TABLE ADDRESS [NOP HP3000 TRANS. STATUS TABLE SIZE,IN ENTRIES * SKP * LIST HEADERS (REMAINDER OF LISTS LOCATED IN SYSTEM AVAILABLE MEMORY). SPC 3 #PNLH NOP HP3000 PROCESS # LIST SPC 1 #NULL NOP LIST HEADER: ENTRY POOL. SPC 1 #MRTH NOP MASTER REQUEST LIST. SPC 1 #ST00 OCT 0,0,0,0,0 SLAVE-STREAM 00 LIST. SPC 1 #ST01 OCT 0,0,0,0,0 SLAVE-STREAM 01 LIST. SPC 1 #ST02 OCT 0,0,0,0,0 SLAVE-STREAM 02 LIST. SPC 1 #ST03 OCT 0,0,0,0,0 SLAVE-STREAM 03 LIST. SPC 1 #ST04 OCT 0,0,0,0,0 SLAVE-STREAM 04 LIST. SPC 1 #ST05 OCT 0,0,0,0,0 SLAVE-STREAM 05 LIST. SPC 1 #ST06 OCT 0,0,0,0,0 SLAVE-STREAM 06 LIST. SPC 1 #ST07 OCT 0,0,0,0,0 SLAVE-STREAM 07 LIST. SPC 1 #ST08 OCT 0,0,0,0,0 SLAVE-STREAM 08 LIST. SPC 1 #ST09 OCT 0,0,0,0,0 SLAVE-STREAM 09 LIST. SPC 1 #ST10 OCT 0,0,0,0,0 SLAVE-STREAM 10 LIST. SPC 1 #ST11 OCT 0,0,0,0,0 SLAVE-STREAM 11 LIST. SPC 1 * NEW ENTRY: ...#STXX OCT 0,0,0,0,0 .............SLAVE-STREAM XX LIST. SKP #RFSZ NOP MAXIMUM NUMBER OF 'OPEN' RFA FILES. * * REMOTE SESSION MONITOR ITEMS * #RSM NOP REMOTE SESSION MONITOR CLASS NUMBER #POOL NOP POINTER TO REMOTE SESSION ID POOL #DFUN BSS 11 DEFAULT ACCOUNT FOR REMOTE SESSION #PASS BSS 5 PASSWOD FOR NON-SESSION ACCESS * * PLOG/TLOG ITEMS * #PLOG BSS 7 1000 LOGGING PROGRAM'S CLASS NO. #CL3K BSS 7 3000 LOGGING PROGRAM'S CLASS NO. * * RE-ROUTING ITEMS * #LV NOP LINK VECTOR PNTR (OR 0 IF NO RE-ROUTING) #LCNT NOP NUMBER OF "LINK VECTOR" ENTRIES #CM NOP "COST MATRIX" PNTR, OR 0 IF NO RE-ROUTING #CMCT NOP NUMBER OF "COST MATRIX" ENTRIES * * "MESSAGE ACCOUNTING" STORAGE AREA * #MCTR NOP NEGATIVE # OF M.A. TABLE ENTRIES #MTBL NOP PNTR TO M.A. TABLE (IN SAM) #MARN NOP M.A. TABLE ACCESS RESOURCE NUMBER #MAHC NOP M.A. 'HOLDING' CLASS (SLAVE REPLY QUEUE FOR RE-XMISN) #MARL NOP MAX. MSG RETRY LIMIT #MAZE NOP MA DEBUG TRACE FLAG *-- MAX NUMBER OF TCBS IN THE SYSTEM (INCLUDING PNL) #TCB NOP #EXHC NOP EXECM HOLDING CLASS #EXTC NOP EXECM TEMP. HOLDING CLASS * * END OF AREA CLEARED BY "DINIT" * #NCLR ABS #TBRN-* NEGATIVE # LOCNS 'DINIT' CLEARS SPC 2 * NODAL ADDRESSING SPECIFICATIONS. * #CNOD NOP CURRENT-USER-NODE; -1: INACTIVE. #LNOD NOP DOWN-LOAD NODE * * * * #NODE NOP LOCAL NODE NUMBER. #ACRN NOP DOWN-LOAD FILE CRN * * * NOTE: #NCNT & #NRV MUST BE CONSECUTIVE! * #NCNT NOP NEG. NUMBER OF NRV TABLE ENTRIES (PAIRS) #NRV NOP S.A.M. ADDRESS OF NRV TABLE. #TRCL NOP 'TRACE' CLASS NUMBER #TRCN NOP 'TRACE' RESOURCE NUMBER SPC 2 #LEVL DEC 1 LOCAL NODE UPGRADE LEVEL #NMSC NOP NETWORK MANAGEMENT SECURITY CODE #LUMP NOP STORAGE FOR 'LUMAP' CLASS NUMBER #LMPE NOP STORAGE FOR ERRORS NOP (DOUBLE-WORD) NOP REPORTING NODE NUMBER SPC 2 * HP3000 ID SEQUENCE SPECIFICATIONS * LOC NOP LOCAL ID SEQUENCE: BYTE COUNT BSS 8 CHARACTERS * REM NOP REMOTE ID SEQUENCE: RESERVED WORD NOP BYTE COUNT BSS 8 CHARACTERS SKP * INITIALIZATION SECTION: DMS SETUP * * NOTE: THIS CODE IS USED ONLY UPON INITIAL ENTRY. * IT IS OVERLAID BY THE SYSTEM SPECIFICATIONS. * ORG #GRPM CODE RESIDES IN SYSTEM DATA AREA. * CONFG NOP ENTRY/EXIT: INITIALIZATION ROUTINE. * LDA $OPSY f~|x GET THE OP-SYSTEM IDENTIFIER. AND P2 ISOLATE THE DMS BIT(#1). RAR,CLE,ERA =0 AND = DMS BIT. SEZ,CLE,RSS IF DMS SYSTEM, SKIP & ENABLE DMS CODE; JMP NODMS ELSE, MERELY DISABLE CONFIGURATION CALL. * STA DMS1 CLEAR THE BYPASS-SWITCHES STA DMS2 TO ENABLE DMS PROCESSING. * NODMS STA INIT CLEAR ACCESS TO THE CONFIGURATOR. JMP CONFG,I RETURN TO NORMAL PROCESSING. * * A EQU 0 B EQU 1 * XEQT EQU 1717B SPC 1 ORR [ INDICATES SIZE OF ] SPC 1 END ~ b| 91750-18163 2013 S C0122 &RESSM +              H0101 ~ASMB,R,Q,C HED RTE-IVB (W/ SESSION MONITOR) VERSION NAM RESSM,30 91750-1X163 REV 2013 801014 RTE-IVB(SM) SPC 1 * ENT #MCTR,#MTBL,#MARN,#MAHC,#MARL,#MAZE ENT #RSM,#POOL,#DFUN,#PASS ENT #BUSY,#FWAM,#GRPM,#BREJ,#LDEF,#MNUM,#MRTH ENT #PNLH,#TRCL,#TRCN,#CL3K,#NRV,#NCNT ENT #RDLY,#PRLU,#LEVL,#ACRN,#LUMP,#LMPE ENT #MSTO,#NODE,#NULL,#QRN,#RSAX,#RTRY ENT #ST00,#ST01,#ST02,#ST03,#ST04,#ST05,#ST06,#ST07 ENT #ST08,#ST09,#ST10,#SVTO,#TBRN,#WAIT,#CNOD,#LNOD ENT #ST11 ENT #QCLM,#NCLR,#SCLR,#SWRD,#PLOG,#RFSZ,#SAVM ENT #RPCV,#RQCV,#LU3K,#QZRN,#CLRN,#QXCL,#TST ENT D$LID,D$BSZ,D$RID,#INCV,#OTCV,#MHCT,#NMSC ENT #LV,#LCNT,#CM,#CMCT,#MDCT,#EXHC,#EXTC,#TCB SPC 1 EXT $BALC,$CGRN,$LIBR,$LIBX,$BRTN,.ENTP,#PRGL * * NAME: RESSM (21MX-M/E/F/ COMPUTERS, W/ RTE-IVB & SESSION MONITOR) * SOURCE: 91750-18??? * RELOC: 91750-16??? * PGMR: LYLE WEIMAN [ 03/30/79 ] * MODIFICATIONS FOR 91750: * --------------------------- * GAB [02/06/79] REPLACE EXTENDED INSTR'S W/ JSB'S * LAW [03/30/79] ADD MODE 12 * " 4-11-79 ADD ENTRY PTS #CLRN,#INCV,#OTCV * " 4-30-79 SECURITY CODE FOR SAM CALLS; REMOVES * REQUIREMENT THAT PROGRAM NAME BE 'DINIT' * MASTER TIME-OUT PASSED IN 'ALLOCATE MASTER TCB' * CALLS; CODE TO SCAN NRV REMOVED. * "LOOP COUNTER" ADDED (#MHCT) * #ACRN ENTRY POINT ADDED * 5-9-79 FIXED BAD MASTER TCB LIST CODE PROBLEM * ALSO FIXED BAD LOCATION FOR 'SECOD' * 5-16-79 CHANGED NAME OF "GHOST COUNTER" TO #MHCT (MAX. HOP * COUNT) * ADDED NETWORK MANAGEMENT SECURITY CODE STORAGE WORD * (#NMSC) * 5-17-79 FIXED ORDER OF #NCNT & #NRV TO BE OUT OF AREA * CLEARED BY 'DINIT'. MOVED #ACRN * 6-5-79 CREATED SEPARATE VERSION FOR RTE-L (PHASE V) * 6-11-79 ADDED ENTRY PTS #RSM,#POOL,#DFUN,#PASS FOR JIM H.+j * 6-18-79 ADDED ENTRY PTS FOR RE-ROUTING & CHANGED CALLING * SEQUENCE # ( & TCB FORMAT) FOR MODE 8 * 6-12-79 6-WORD TCBS, CHANGED MODE CHECK TO USE 'JUMP TABLE' * 6-19-79 ADD CHANGES TO PNL ENTRY FORMAT & SEARCH CALLS, * AS REQUIRED FOR REMOTE SESSION. * 6-27-79 CHANGE SLAVE STREAM HEADER TO INCLUDE MODULE * NAME, INSTEAD OF ID SEGMENT ADDRESS * 8-14-79 SEPARATE 'RES' INTO THREE MODULES: * RESL -- RTE-L * RESM -- RTE-M & RTE-IVB W/O SESSION MONITOR * RESSM-- RTE-IVB W/ SESSION MONITOR * * 9-18-79 ADDED #MDCT--MAXIMUM LINE DOWN CNTR IN 5 MIN. * TKM 1.03.80 CHANGED '$BRTN' CALL (SEE LABEL 'SAM2'). * TKM 3.27.80 ADDED ENTRY POINTS #EXHC, #EXTC, #TCB. * TKM 4.09.80 MODIFIED SEARCH TO IGNORE 'BAD' TCBS. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 * RES IS A MEMORY-RESIDENT SYSTEM LIBRARY MODULE USED BY THE * DS/1000 (DISTRIBUTED SYSTEMS) SOFTWARE PACKAGE TO PROVIDE * CONTROLLED-ACCESS COMMON STORAGE. ITEMS STORED IN ARE NETWORK * GLOBAL CONSTANTS & VARIOUS LISTS WHICH CONTAIN THE TRANSACTION-BLOCK * RECORDS OF CURRENT TRANSACTIONS-IN-PROCESS ON THE NETWORK. * SPC 5 * #RSAX IS A PRIVILEGED LIBRARY ROUTINE EMBEDDED IN RES * WHICH CONTROLS ACCESS TO, AND ALLOWS MAINTENANCE OF, THE * NETWORK'S TRANSACTION-CONTROL-BLOCKS (TCB'S) FOR CURRENT REQUESTS. SKP * #RSAX OPERATION: SPC 1 * 1. SAVE PARAMETERS IN PREPARATION FOR MAP-SWITCH. SPC 1 * 2. SAVE MAP STATUS AND SWITCH TO SYSTEM MAP. SPC 1 * 3. CHECK MODE OF OPERATION: * A. IF =0, GO TO 7. TO ALLOCATE SYSTEM MEMORY. * B. IF =1, GO TO 7. TO DE-ALLOCATE SYSTEM MEMORY. * C. IF =2, GO TO 4. TO ADD NEW ENTRY TO MASTER-REQUEST LIST. * D. IF =3, GO TO 5. TO ADD NEW ENTRY TO A SLAVE-STREAM LIST. * E. IF =4, GO TO 6. TO SEARCH FOR A MASTER TCB ENTRY. * F. IF =5, GO TO 6. TO SEARCH FOR A SLAVE TCB ENTRY. * G. IF =6, GO TO 6. TO REMOVE A MASTER ENTRY & RETURN IT TO THE POOL. * H. IF =7, GO TO 6. TO REMOVE A SLAVE ENTRY & RETURN IT TO THE POOL. * I. IF =8, GO TO 4. TO ADD AN HP3000 PROCESS. * J. IF=10, GO TO 6. TO REMOVE AN HP3000 PROCESS. * K. IF=11, SET SEARCH KEY OFFSET TO 5 (6TH TCB WORD IS SEARCH KEY) AND * GOTO 6. * L. IF=12, GO TO 6. TO SET THE M.A. REQUEST ACKNOWLEDGEMENT FLAG * M. IF=13, GO TO 6. TO TEST " " " " " * * NOTE: THE M.A. ACKNOWLEDGEMENT FLAG IS DOCUMENTED IN THE MESSAGE * ACCOUNTING SOFTWARE. * * N. IF=14, THEN SAME AS 2, BUT SKIP SEARCH FOR "OBSOLETE" ENTRIES. * M. IF NONE OF THE ABOVE - ERROR #2 --- REJECT! SPC 1 * 4. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE MASTER LIST. * A. IF NONE AVAILABLE, CALLER HAS NOT CHECKED AVAILABILITY OF * TABLE-ACCESS RN (#TBRN) BEFORE ENTRY - ERROR #3 --- REJECT! * B. IF ENTRY AVAILABLE, SEARCH BY ID SEG. ADDR. FOR OBSOLETE * ENTRIES IN THE MASTER REQUEST LIST (EXCEPT IF MODE =12). * C. FLAG ALL OBSOLETE MASTER-REQUEST ENTRIES AS BAD, IF THEY * ORIGINATED WITH SAME REQUESTOR (BIT#15 =1 OF WORD#5). * D. LINK THE NEW ENTRY INTO THE MASTER REQUEST LIST. * E. USE TIMEOUT SPECIFIED IN CALL, OR USE #MSTO IF VALUE IS ZERO. * F. TRANSFER THE CALLER'S DATA INTO THE NEW ENTRY. * G. IF ENTRY POOL NOT DEPLETED, CLEAR TABLE-ACCESS RN & RETURN. SPC 1 * 5. CHECK FOR AVAILABLE ENTRY, BEFORE ADDING TO THE SLAVE-STREAM LIST. * A. IF NONE, #TBRN NOT CHECKED BEFORE ENTRY - ERROR #3 --- REJECT! * B. CHECK STREAM PARAxMETER FOR ACCEPTABLE TYPE--ERROR #1, IF INVALID. * C. LINK THE NEW ENTRY INTO THE SPECIFIED SLAVE-STREAM LIST. * D. TRANSFER CALLER'S DATA INTO THE NEW ENTRY. * E. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 6. INITIALIZE LIST POINTERS, BEFORE SEARCHING FOR/CLEARING AN ENTRY. * A. IF IMPROPER LIST SPECIFIED - ERROR #1 --- REJECT! * B. SEARCH FOR ENTRY. IF ENTRY NOT LOCATED, REJECT---ERROR #4! * C. IF MODE=4/5, GET CONTENTS OF ENTRY WORD#4 & RETURN TO CALLER. * D. IF MODE=6/7, GET CONTENTS OF WD#4 & RE-LINK ENTRY IN NULL LIST. * E. CHECK MODE AGAIN: IF 12, THEN SET M.A. REQUEST ACKNOWLEDGEMENT * FLAG & RETURN CLASS # # TCB ADDR. * IF 13, THEN RETURN WITH ONLY M.A. R.A. FLAG * IN (A): IF 0 THEN FLAG CLEAR, * ELSE #0 IF FLAG SET. DON'T DEPEND * ON A PARTICULAR VALUE, IN CASE * THIS CHANGES. * F. RETURN VIA 4.G.(ABOVE), TO UPDATE STATUS OF TABLE-ACCESS RN. SPC 1 * 7. VERIFY CALLER KNOWS CORRECT SECURITY CODE BEFORE ALLOCATING OR * DE-ALLOCATING SAM. * A. IF MODE & #FWAM =0, GO TO ALLOCATE SYSTEM AVAILABLE MEMORY. * B. IF REQUEST GRANTED, STORE BLOCK ADDRESS IN #FWAM, SIZE IN #SAVM. * D. IF REQUEST DENIED, RETURN REASON IN , FOR FURTHER ANALYSIS. * E. IF MODE=1 & PRAM1=#FWAM, RETURN MEMORY TO THE SYSTEM. * F. CLEAR #FWAM & #SAVM, BEFORE RETURNING TO . SKP * #RSAX CALLING SEQUENCE: * * JSB #RSAX * DEF RTN * DEF MODE MODE OF OPERATION (0 THRU 7) * DEF PRAM1 REQUIRED PARAMETER (SEE TABLE, BELOW) * DEF PRAM2 REQUIRED FOR MODES: 2,3,5,7 [OPTIONAL MODES: 0,1,4,6] * DEF PRAM3 REQUIRED FOR MODES 2 & 3 ONLY (NODAL ADDRESS) * DEF PRAM4 OPTIONAL FOR MODES 2,8 & 12 ONLY (MASTER TIME-OUT) *RTN : NORMAL-(SEE TABLE); ERROR-(SEE LATER DESCRIPTION) * * WHERE: * * +----+------------+--------------+------------+---------+-------+-------+ * !MODE! ACTION ! PRAM1 ! PRAM2 ! PRAM3 ! RTN! RTN! * !====+============+==============+============+=========+=======+=======+ * ! 0 ! GET MEMORY !#WORDS TO GET ! SECURITY ! NOT USED!FWA SAM! #WORDS! * ! ! ! ! CODE ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 1 ! RTN MEMORY !FWA SAM BLOCK ! SECURITY ! NOT USED! 0 ! 0 ! * ! ! ! ! CODE ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 2 ! ADD MASTER !MASTER CLASS# !MA 'SEND'CNT! NOT USED!LOC SEQ!TCB ADR! * ! ! ! NOTE: PRAM4 = MASTER TIME-OUT VALUE ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 3 ! ADD SLAVE !ORIG. SEQ. NO.!SLAVE STREAM!ORIG.NODE!LOC SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 4 ! FIND MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# !TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 5 ! FIND SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ!TCB ADR! * +----+------------+--------------+------------+---------+-------+-------+ * ! 6 !CLEAR MASTER!LOCAL SEQ. NO.! NOT USED ! NOT USED!CLASS# ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 7 !CLEAR SLAVE !LOCAL SEQ. NO.!SLAVE STREAM! NOT USED!ORG SEQ! 0 ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 8 ! ADD PNL ! LOGGING LU # !REMOTE SES ! REMOTE !LOC.SEQ!TCB ADR! * ! ! ! ! ID/SMP # ! NOTE # ! ! ! * ! ! ! NOTE: PRAM4 = MPE/RTE FLAG WORD ! ! ! * +----+--------)t----+--------------+------------+---------+-------+-------+ * ! 10 ! CLEAR PNL !REMOTE SESSION! REMOTE NODE! NOT USED! LOG LU! 0 ! * ! ! ! ID/SMP # ! NUMBER ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 11 ! FIND MA SEQ! M.A. SEQ. # ! NOT USED ! NOT USED! CLASS#! TCB ! * ! ! NUMBER ! ! ! ! ! ADDR ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 12 !SET REQUEST ! M.A. SEQ. # ! NOT USED ! NOT USED! CLASS#! TCB ! * ! !ACKNOWLEDGED! ! ! ! ! ADDR ! * ! !FLAG, SEE 16! ! ! ! ! ! * +----+------------+--------------+------------+---------+-------+-------+ * ! 14 ! ADD MASTER ! SAME AS # 2, BUT NO SEARCH FOR OBSOLETE ENTRIES ! * +----+------------------------------------------------------------------+ * ! 16 !TEST REQUEST!LOCAL SEQ. NO.! NOT USED ! NOT USED!0 IF ! TCB ! * ! !ACKNOWLEDGED! ! ! !FLAG 0 ! ADDR ! * ! !FLAG, SEE 12! ! ! !ELSE<>0! ! * +----+------------+--------------+------------+---------+-------+-------+ * * IN PNL ENTRIES, CONTAINS -1 FOR MPE SESSIONS. * * #RSAX ERROR INDICATIONS: * * ERROR DETECTION WILL RESULT IN A RETURN TO THE CALLER WITH THE * REQUESTED ACTION NOT PERFORMED. * * = -1: AN INVALID LIST HAS BEEN SPECIFIED; FIRST CALLER * IS NOT ; MEMORY ALLOCATION/DE-ALLOCATION IMPROPER. * * = -2: THE SPECIFIED MODE OF OPERATION IS UN-DEFINED. * * = -3: NO SPACE FOR A NEW ENTRY. THE CALLER DID NOT WAIT FOR * THE TABLE-ACCESS RESOURCE NUMBER (#TBRN) TO BE CLEARED, * PRIOR TO CALLING #RSAX. (THIS SHOULD NOT OCCUR IF ALL * CALLERS ADHERE TO THE RN CONVENTION91, PRIOR TO CALLING.) * * = -4: ENTRY CANNOT BE LOCATED; ACCESSING AN EMPTY LIST. * * MODE 0 ( ALLOCATION ): < 0 IF BAD SECURITY CODE SPECIFIED, * OR INSUFFICIENT SAM AVAILABLE. * * > : #FWAM & #SAVM CONTAIN ADDRESS & SIZE * OF ALLOCATED AREA * 1 (DE-ALLOCATION): = = -1 IF ADDRESS OF BLOCK BEING * RETURNED IS NOT EQUAL TO #FWAM, OR IF * SECURITY CODE IS INCORRECT. SKP * LIST FORMATS: * * 'RES' SYSTEM AVAILABLE MEMORY * ------------------------------- ------------------------- * * #PNLH < ADDR 1ST PROCESS# LIST ENTRY>... * <0!D! 0 > * < REMOTE NODE NUMBER > * < 0 ! LOCAL TERM- > * INAL LU * * * * BIT 14 OF WORD 3 (D) IS SET FOR MPE SESSIONS, * CLEAR FOR RTE SESSIONS. * * #MRTH < ADDR.=1RST MASTER-LIST ENTRY>... * < UDF-----*TIMEOUT CNTR. > * < LOCAL SEQUENCE NUMBER > * * * * * #ST00 ... * . <- * MONITOR'S CLASS NUMBER > < UD------*TIMEOUT CNTR. > *  . < LOCAL SEQUENCE NUMBER > * . < MONITOR NAME (CHARS 3 & 4 > < ORIGIN SEQUENCE NUMBER > * . < MONITOR NAME (CHAR 5) > < ORIGIN NODAL ADDRESS > * . < *** RESERVED ******** > * . * . * #STXX < ******* FORMAT SAME ******* >...< **** FORMAT SAME ***** > * < ********* FOR ALL ********* > < ******** FOR ********* > * < ****** SLAVE STREAMS ****** > < ******** ALL ********* > * < *************************** > < ******* SLAVE ******** > * < *************************** > < ****** STREAMS ******* > * < ********************** > * * WHERE: - = RESERVED FOR FUTURE USE. A(#15) = ABORT OK. * B(#15) = DUPLICATE ENTRY, OR ONE WHICH MAY BE DELETED. * SET TO "FLAG" 'UPLIN' THAT THIS TCB MAY BE RELEASED. * C(#15) = LONG MASTER TIMEOUT (APPROXIMATELY 20 MIN.) * U(#15) = UPLIN TEMPORARY BIT. D(#14) = HP3000 REQUEST. * F(#13) = M.A. "REQUEST ACKNOWLEDGED" FLAG. 1 = SET, 0=CLEAR * * *NOTE: 0 IN LIST HEAD OR FIRST WORD OF ENTRY SIGNALS END OF LIST. * * * NETWORK ROUTE VECTOR TABLE: * * #NCNT < NEGATIVE NUMBER OF NRV PAIRS> * NRV TABLE FORMAT: * * +--------------------------+ * #NRV----> ! CPU NUMBER (16-BITS) ! * +--------------------------+ * ! TIME-OUT ! FORMAT # ! * ! (8 BITS) ! (8 BITS) ! * +----------+---------------+ * !RESERVED!N! COMM-LINK LU ! * !(7 BITS)! ! (8 BITS) ! * +----------+---------------+ * * N = 1 IF CPU IS NEIGHBOR TO LOCAL NODE, ELSE 0 SKP MODE NOP MODE OF OPERATION. PRAM1 NOP USER PRAM2 NOP SPECIFIED PRAM3 NOP PARAMETERS. vPRAM4 NOP SUP [SUPPRESS EXTENDED LISTING] #RSAX NOP ENTRY/EXIT: TCB MANAGEMENT. JSB $LIBR DECLARE THIS TO BE NOP A PRIVILEGED ROUTINE. JSB .ENTP OBTAIN DIRECT ADDRESSES DEF MODE FOR PARAMETERS & RETURN POINT. * * CLA [PROTECT AGAINST MISSING PARAMETER] STA GOOD CLEAR SEARCH FLAG LDA PRAM1,I OBTAIN STA PRAM1 PARAMETERS STA KEYWD (ASSUME WE WILL SEARCH ON THIS KEY) CLA FOR LDA PRAM2,I LOCAL USE, STA PRAM2 IN PREPARATION CLA FOR A LDA PRAM3,I POSSIBLE STA PRAM3 DMS MAP-SWITCH. CLA LDA PRAM4,I STA PRAM4 CLA LDB MODE,I GET THE MODE OF OPERATION, SSB NEGATIVE MODE? JMP ERR02 YES, ILLEGAL MODE! STB MODE AND SAVE IT LOCALLY, ALSO. * * RSA GET CURRENT MAP STATUS. RAL,RAL POSITION CURRENT STATUS FOR RESTORATION. STA DMSTS SAVE FOR RESTORATION BEFORE EXIT. SJP MODCK ENABLE SYSTEM MAP AND CONTINUE. * DMSTS NOP DMS MAP-STATUS STORAGE. * MODCK EQU * HERE TO CHECK FOR LEGAL MODE & BRANCH TO PROCESSOR LDA B PICK UP MODE ADA NMODX SUBTRACT MAX. ALLOWABLE 'MODE' CODE SSA,RSS TOO BIG? JMP ERR02 YES, ERROR! LDA B RECOVER MODE AGAIN ADA @JTBL ADD JUMP TABLE ADDRESS JMP A,I & BRANCH TO PROPER PROCESSOR SPC 2 * 'JUMP' TABLE. DO NOT DISTURB ORDER! * @JTBL DEF *+1,I MODE ACTION DEF SAM 0 ALLOCATE MEMORY. DEF SAM 1 RETURN MEMORY TO RTE DEF ADENT 2 CREATE A MASTER TCB ENTRY DEF ADENT 3 CREATE A SLAVE TCB ENTRY DEF FIND 4 SEARCH FOR A MASTER TCB ENTRY DEF FIND 5 SEARCH FOR A SLAVE TCB ENTRY B DEF FIND 6 SEARCH FOR/CLEAR A MASTER TCB ENTRY DEF FIND 7 SEARCH FOR/CLEAR A SLAVE TCB ENTRY DEF ADENT 8 CREATE A PROCESS # ENTRY DEF ERR02 9 *** ERROR, ILLEGAL MODE *** DEF FNPNL 10 SEARCH FOR/CLEAR A PROCESS # ENTRY DEF FNDMA 11 FIND MASTER TCB GIVEN M.A. SEQ. NUMBER DEF FNDMA 12 SET REQUEST ACKNOWLEDGEMENT FLAG DEF ERR02 13 *** ERROR, ILLEGAL MODE *** DEF ADENT 14 CREATE A MASTER ENTRY (W/O DUPL. ENTRY SEARCH) DEF ERR02 15 *** ERROR, ILLEGAL MODE *** DEF FIND 16 TEST REQUEST ACKNOWLEDGEMENT FLAG * NMODX ABS @JTBL-* NEG. SIZE OF TABLE SPC 10 * ADD A NEW ENTRY TO THE MASTER OR SLAVE-STREAM LIST. SPC 1 ADENT LDA #NULL GET THE NULL LIST LINK-WORD. SZA,RSS IS AN ENTRY AVAILABLE FROM THE POOL? JMP ERR03 * NO. ERROR #3: NO ENTRY AVAILABLE! STA ENTAD YES. SAVE ADDRESS OF NEW ENTRY. * INA POINT TO THE SECOND WORD OF THE ENTRY. STA ENPNT SAVE THE POINTER FOR ENTRY BUILDING. CPB P14 BUILT NEW MASTER W/O "OBS.ENTRY" SEARCH? JMP MST0 YES CPB P8 IS THIS A PNL ENTRY? JMP MSTAD . YES, SKP "OBS ENTRY" SEARCH CLE,SLB IF THIS IS TO BE A SLAVE ENTRY, JMP SLVAD THEN SKIP THE SEARCH FOR MASTER ENTRIES. * LDA MDEF INITIALIZE THE LIST PTR TO REF THE STA LSTAD MASTER LIST. * LDA XEQT SEARCH KEYWORD IS: ID SEG ADDR. STA KEYWD LDA P4 EXAMINE FIFTH WORD OF EACH MASTER TCB. JSB SERCH FIND ENTRIES WITH SAME CLASS OR PROCESS #. JMP MSTAD END-OF-LIST: GO TO ADD NEW ENTRY. ADB P4 GET THE 5TH WORD (ID SEGMENT ADDRESS) LDA B,I FROM ENTRY WITH SAME NUMBER. IOR SIGN ADD BAD-ENTRY FLAG (BIT#15). STA B,I RETURN MODIFIED WORD.(UPLIN CLEARS TCB). * MSTAD CCB s CHECK FOR LDA MODE NEW PROCESS CPA P8 NUMBER MODE. RSS YES, STAY IN-LINE JMP MST0 LDA PRAM4 PICK UP TIME-OUT WORD JMP SETIM GO SET TIMEOUT * MST0 EQU * CLB,INB SET MASTER TCB LIST CODE LDA PRAM4 LOAD MASTER TIME-OUT JMP SETIM * SLVAD JSB LSTCK PREPARE REFERENCES FOR THE SLAVE LIST. ADA P2 POINT TO WORD #3 OF SLAVE-STREAM HEAD. LDA A,I GET THE MONITOR I.D. SEGMENT ADDRESS. SZA,RSS IF THE MONITOR HAS NOT BEEN INITIALIZED, JMP ERR01 THEN NOTHING MAY BE ADDED TO THIS LIST! LDA #SVTO VALID LIST: GET SLAVE TIMEOUT VALUE. * SETIM STA ENPNT,I SET TIMEOUT INTO ENTRY WORD #2 ISZ ENPNT POINT TO NEXT WORD OF ENTRY CLA OBTAIN AN ENTRY FROM THE NULL LIST. JSB LNK GO PROCESS LIST CHANGES.[B=LIST CODE] SZA LIST-PROCESSING ERROR? JMP ERR04 YES--INFORM THE CALLER! * LDA PRAM3 USE THIRD PARAMETER LDB MODE INSTEAD OF SEQUENCE CPB P8 NUMBER FOR MODE 8. JMP STOR3 STORE IN THIRD TCB WORD. * SKP SPC 3 LDA SEQN GET THE LAST SEQUENCE NUMBER. INA,SZA,RSS ADVANCE THE COUNT & TEST FOR ZERO. CLE,INA ROLL-OVER: RESET TO ONE. STA SEQN SAVE THE CURRENT SEQUENCE NUMBER. STOR3 STA ENPNT,I INSERT IT INTO THE THIRD ENTRY WORD. ISZ ENPNT ADVANCE THE ENTRY POINTER. LDA MODE IF A SLAVE-ENTRY IS TO BE CLE,ERA ADDED, SET =1. LDA PRAM1 GET THE CALLER'S PARAMETERS LDB XEQT GET CALLER'S ID SEGMENT ADDRESS SEZ SLAVE-LIST ADDITION? LDB PRAM3 YES, GET THE ORIGIN NODAL ADDRESS. DST ENPNT,I ADD PARAMETERS TO ENTRY WORDS #4,#5. ISZ ENPNT BUMP POINTER TO ISZ ENPNT WORD 6 LDA PRAM2 LOAD 'M.A.' SEQUENCE NUMBER STA iENPNT,I STORE IN 6TH T.C.B. WORD * LDA SEQN RETURN WITH: =CURRENT SEQUENCE NO. LDB ENTAD =ENTRY ADDRESS. JMP EXIT GO TO PREPARE FOR RETURN TO CALLER. * SEQN NOP TRANSACTION SEQUENCE NUMBER. * SPC 3 * ERROR PROCESSING AND EXIT SECTION. SPC 1 ERR04 LDA P4 =4: ENTRY CANNOT BE LOCATED. JMP ERR00 ERR03 LDA P3 =3: NEW ENTRY NOT AVAILABLE. JMP ERR00 ERR02 LDA P2 =2: INVALID MODE PARAMETER. RSS ERR01 CLA,INA =1: INVALID LIST PARAMETER. * ERR00 CMA,INA NEGATE THE ERROR CODE. STA B ARE THE SAME FOR ERROR RETURN. * EXIT DST TEMP SAVE TEMPORARILY. CLA CLEAR PARAMETER ADDRESSES STA MODE TO FACILITATE CHECKING STA PRAM1 FOR MISSING PARAMETERS STA PRAM2 UPON NEXT ENTRY OF <#RSAX>. STA PRAM3 STA PRAM4 LDA #NULL IF NO TCB ENTRIES REMAIN AVAILABLE SZA,RSS IN THE ENTRY POOL, THEN DO NOT JMP RETRN CLEAR THE TABLE-ACCESS RN; ELSE, LDA #TBRN GET THE TABLE-ACCESS RN AND GO TO RTE JSB $CGRN TO MAKE IT AVAILABLE FOR NEXT ACCESS. RETRN DLD TEMP RESTORE THE RETURN-DATA TO & . * JRS DMSTS LBEX *** RESTORE THE APPROPRIATE MAPS *** * LBEX JSB $LIBX RETURN TO THE CALLER, VIA THE RTE DEF #RSAX PRIVILEGED ROUTINE PROCESSOR. * SKP * SEARCH FOR & CLEAR PROCESS NUMBER LIST ENTRY * FNPNL EQU * LDA PDEF INITIALIZE SEARCH LIST HEAD TO STA LSTAD PROCESS NUMBER LIST CCA,CLE INITIALIZE LIST CODE FOR PNL STA LSTCD LDA P5 SET OFFSET TO SESSION ID WORD STA OFSET JMP FINDX AND SEARCH FOR ENTRY SPC 2 * SEARCH FOR MASTER & SLAVE TCB ENTRIES. CLEAR AND RETURN TO POOL, * IF REQUESTED. SPC 1 FIND EQU * LDA P2 SEARCH KEY W4ILL BE THIRD WORD IN TCB * FIND. EQU * HERE WITH OFFSET FOR SEARCH IN STA OFSET SAVE OFFSET LDA MDEF INITIALIZE POINTERS STA LSTAD TO THE CLA,INA MASTER STA LSTCD LIST. * CLE,SLB IF THIS IS A SLAVE REQUEST, THEN JSB LSTCK ESTABLISH REFERENCES TO THE SLAVE LIST. * FINDX EQU * HERE TO START/RESUME SEARCH LDA OFSET LOAD OFFSET IN TCB TO SEARCH KEY. JSB SERCH GO TO LOCATE THE TCB ENTRY [E=0]. JMP ERR04 * ERROR #4: ENTRY CANNOT BE LOCATED! * * STB ENTAD SAVE THE ENTRY ADDRESS FOR LATER USE. LDA MODE GET THE MODE OF OPERATION CPA P10 CLEAR PNL? JSB FPNLX YES, CHECK FURTHER, RETURN IF TRUE MATCH ADB P3 POINT TO THIRD WORD, FOR LATER USE, STB ENPNT IN RETURNING THE CONTENTS TO CALLER. * CPA P6 ARE WE SUPPOSED TO RELEASE THE TCB? JMP RELS YES,... CPA P7 (OTHER CASE FOR RELEASE) ? JMP RELS YES,... CPA P10 (RELEASE PNL) ? JMP RELS YES,... * JMP FOUND NONE OF THE ABOVE, DON'T RELEASE TCB * RELS LDA LSTCD REMOVE ENTRY FROM THE SPECIFIED LIST. CLB,CLE RETURN IT TO THE NULL LIST. JSB LNK GO TO PROCESS THE LIST CHANGES. CCE,SZA LIST PROCESSING ERROR? JMP ERR04 YES! GO TO INFORM THE CALLER. STA ENTAD ASSURE RETURNS W/ ZERO. * FOUND EQU * LDA MODE IS THIS REQUEST TO: CPA P12 SET REQUEST ACKNOWLEDGEMENT FLAG? JMP SETRA .. YES, GO SET IT CPA P16 TEST R.A. FLAG? JMP TSTRA .. YES, GO TEST IT * FOND1 EQU * RETURN POINT FOR ALL "FIND TCB" PROCESSORS LDA ENPNT,I GET WORD #4 FOR RETURN TO CALLER. FOND2 LDB ENTAD GET THE TCB ADDRESS; JMP EXIT ELSE, RETURN WITH =0. SPC 2 * HERE WHEw N A PNL ENTRY HAS BEEN FOUND WHICH MATCHES * THE REMOTE SESSION ID NUMBER. IF REMOTE NODE NUMBER ALSO MATCHES, * THEN A GOOD MATCH HAS BEEN FOUND. OTHERWISE, CONTINUE SEARCH. * FPNLX NOP ADB P2 POINT TO REMOTE NODE NUMBER LDB B,I LOAD REMOTE NODE NUMBER CPB PRAM2 MATCH? RSS YES JMP FINDX NO MATCH, RESUME SEARCH AT NEXT ENTRY. LDB ENTAD RECOVER REGISTER & RETURN JMP FPNLX,I * * HERE TO FIND MASTER TCB, GIVEN M.A. SEQUENCE NUMBER * OPERATION IS THE SAME AS "FIND MASTER TCB" (MODE 4), EXCEPT * THAT THE SEARCH KEY IS THE 6TH WORD IN THE TCB, INSTEAD * OF THE THIRD. FNDMA EQU * LDA P5 6TH WORD IS SEARCH KEY LDB P4 (ESTABLISH MASTER LIST PNTRS) STA GOOD SET FLAG THAT ONLY "GOOD" TCBS WANTED JMP FIND. * SETRA EQU * HERE TO SET REQUEST ACKNOWLEDGEMENT FLAG LDB ENTAD GET ADDRESS INB OF THE FLAG ( --> TCB+1) LDA B,I GET THE FLAG, IOR RAFLG SET IT, STA B,I AND PUT IT BACK. ADB P4 --> TCB+5 CLA CLEAR THE MA IDENTIFIER STA B,I JMP FOND1 * RAFLG OCT 20000 BIT # 13 * TSTRA LDB ENTAD GET THE ADDRESS INB OF THE FLAG LDA B,I GET THE FLAG ITSELF AND RAFLG AND RETURN TO CALLER WITH ONLY THAT BIT SET JMP FOND2 * ENPNT NOP POINTER INTO TCB ENTRY. ENTAD NOP TCB ADDRESS STORAGE. * SKP * SYSTEM AVAILABLE MEMORY ALLOCATION/DE-ALLOCATION PROCESSOR. SPC 1 SAM EQU * LDA PRAM2 GET CALLER'S SECURITY CODE UNL CPA SECOD CODES MATCH? LST RSS CODES MATCH: ALLOW ACCESS, ELSE JMP ERR01 REPORT IMPROPER ACCESS! * SLB IF THE REQUEST IS FOR DE-ALLOCATION, JMP RTSAM GO TO RETURN THE MEMORY TO THdE SYSTEM. * LDA #FWAM IF SYSTEM-AVAILABLE-MEMORY SZA HAS ALREADY BEEN ALLOCATED, JMP ERR01 THEN REJECT THE REQUEST! * JRS DMSTS SAM1 RETURN TO USER MAP SAM1 EQU * JSB $BALC REQUEST SYSTEM AVAILABLE MEMORY (S.A.M.) DEF *+4 DEF PRAM1 # WDS REQUESTED (RETURNED # WORDS ALLOCATED OR <0 IF ERR) DEF PRAM3 ADDRESS OF BLOCK (RETURNED) DEF LSTCK (RETURN) MAX. CONTIG. BLOCK SIZE AVAIL. LDA PRAM1 WAS REQUEST GRANTED? SSA JMP SAMEX ** NO, RETURN W/ < 0 STA #SAVM O.K. SAVE THE SIZE OF THE MEMORY BLOCK. LDB PRAM3 SET ADDRESS OF STB #FWAM ALLOCATED BLOCK JMP SAMEX RETURN TO CALLER * RTSAM EQU * LDA PRAM1 GET ADDRESS OF BLOCK BEING RETURNED CPA #FWAM IS CALLER SPECIFYING CORRECT BLOCK? RSS YES. PROCESS THE DE-ALLOCATION. JMP ERR01 NO. ** IGNORE THE REQUEST! ** * * JRS DMSTS SAM2 RETURN TO USER MAP SAM2 EQU * LDA #FWAM LDB #SAVM DST SAMA SETUP FOR $BRTN CALL JSB $BRTN RETURN A SYSTEM-AVAILABLE-MEMORY BLOCK; SAMA DEF *-* (ADDRESS OF BLOCK TO BE RETURNED TO SAM) DEF *-* (SIZE OF BLOCK TO BE RETURNED TO SAM) CLA CLEAR THE STORAGE LOCATIONS FOR: STA #FWAM MEMORY BLOCK ADDRESS. STA #SAVM MEMORY BLOCK SIZE. SAMEX EQU * RETURN TO CALLER JSB $LIBX DEF #RSAX UNL SECOD DEC 3360 LST SKP * SUBROUTINE TO CHECK LIST PARAMETER & SET LIST CODE & LIST ADDRESS. SPC 1 * ENTER: = DON'T CARE. * RETURN: =LIST ADDRESS; =LIST CODE. * ERROR - RETURN VIA ERROR EXIT WITH ERROR #1. * LSTCK NOP ENTRY/EXIT: LIST ID ROUTINE. LDA PRAM2 GET THE STREAM PARAMETER. AND B77 ISOLATE THE STREAM NUMBER. ADA P2 ADD OFFSET FOR NULL & MASTER LISTS. STA LS TCD SAVE FOR USE ELSEWHERE. STA B SAVE FOR RETURN TO CALLER. ADA NMAX CHECK FOR SPECIFICATION CLE,SSA,RSS OF AN UN-DEFINED LIST. JMP ERR01 * ERROR #1: INVALID LIST! LDA #LDEF GET THE LIST-TABLE ADDRESS. ADA B INDEX TO THE PROPER ENTRY. LDA A,I GET THE LIST ADDRESS. STA LSTAD SAVE THE ADDRESS FOR LATER USE. JMP LSTCK,I RETURN TO THE CALLER. * B77 OCT 77 LSTAD NOP ADDRESS OF LIST HEADER. LSTCD NOP LIST IDENTIFICATION CODE. * SKP * SUBROUTINE TO SEARCH FOR A SPECIFIC LIST ENTRY. SPC 1 * ENTER: = OFFSET INTO TCB ENTRY; = DON'T CARE. * =0: SEARCH FROM TOP; =1: CONTINUE SEARCH. * 'LSTAD' SET TO ADDRESS OF LIST TO BE SEARCHED. * 'KEYWD' CONTAINS SEARCH KEY * * RETURN: P+1 -- ENTRY NOT LOCATED; MEANINGLESS, =0. * P+2 -- ENTRY WAS LOCATED; MEANINGLESS, = ENTRY ADDRESS. * SERCH NOP ENTRY/EXIT:LIST SEARCH ROUTINE. LDB TEMP+1 GET NEXT-ENTRY ADDRESS TO CONTINUE. SEZ IS THIS A REQUEST TO CONTINUE? JMP SLOOP YES. GO TO CONTINUE THE SEARCH. STA OFSET SAVE OFFSET INTO TCB ENTRY. LDB LSTAD GET TOP-OF-LIST ADDRESS. * SLOOP LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB,RSS IS THIS THE END OF THE LIST? JMP SERCH,I YES. TAKE "NOT FOUND" EXIT (P+1). * STB TEMP+1 SAVE POINTER TO NEXT ENTRY. LDA GOOD ONLY GOOD TCBS WANTED? SZA,RSS JMP SER1 . NO BAD ONES OK LDA P4 ADA B --> ID SEGMENT ADDRESS TCB+4 LDA A,I CHECK FOR BAD BIT SET CCE,SSA BAD BIT SET? JMP SLOOP . YES IGNORE THIS TCB SER1 ADB OFSET POINT TO KEYWORD LOCATION. LDA B,I GET THE KEYWORD. LDB TEMP+1 PREPARE TO RETURN WITH ENTRY ADDRESS. CPA KEYWD DOES IT MATCH THE CALLER'SZB KEYWORD? CCE,RSS YES. SET FOR CONTINUATION--SKIP. JMP SLOOP NO. CONTINUE SEARCHING. * ISZ SERCH ENTRY FOUND: SET RETURN TO P+2. JMP SERCH,I RETURN TO THE CALLER. * OFSET NOP KEYWORD OFFSET INTO TCB ENTRY. KEYWD NOP SEARCH KEY GOOD NOP IF SET, ONLY "GOOD" TCBS WANTED * SKP * SUBROUTINE TO PROCESS LIST LINKAGE. SPC 1 * ENTER: = CODE OF REMOVAL LIST; = CODE OF ADDITION LIST. * 'ENTAD' SET TO ADDRESS OF ENTRY TO BE REMOVED. * * RETURN: & =0: NORMAL; =-1, =UNCHANGED: ERROR. * LNK NOP ENTRY/EXIT: LIST LINK ROUTINE. STA TEMP SAVE REMOVAL-LIST CODE, TEMPORARILY. ADA #LDEF FIND THE TABLE ADDRESS. LDA A,I GET ADDRESS: TOP-OF-REMOVAL-LIST. LNK1 STA PNTR SAVE LIST POINTER. LDA A,I GET THE LINK TO THE NEXT ENTRY. SZA,RSS IF THIS IS THE END OF THE LIST, JMP LNKER THEN INFORM THE CALLER OF THE ERROR. CPA ENTAD IS THIS THE ENTRY TO BE REMOVED? RSS YES. SKIP TO REMOVE IT. JMP LNK1 NO. TRY THE NEXT ONE. LDA ENTAD,I GET THE LINK TO THE FOLLOWING ENTRY, STA PNTR,I AND MOVE IT TO THE PREVIOUS ENTRY. * ADB #LDEF FIND THE TABLE ADDRESS. LDB B,I GET ADDRESS: TOP-OF-ADDITION-LIST. LNK2 STB PNTR SAVE LIST POINTER. LDB B,I GET THE LINK TO THE NEXT ENTRY. SZB IS THIS THE END OF THE LIST? JMP LNK2 NO. CONTINUE SEARCHING FOR THE END. STB ENTAD,I YES. MAKE NEW ENTRY = END-OF-LIST. LDA ENTAD GET THE ADDRESS OF THE NEW ENTRY. STA PNTR,I SAVE IN LINK-WORD OF PREVIOUS ENTRY. * LDA MODE IF MODE IS CPA P14 NOT = 14 CLA AND ADA M8 >= 8 THEN SSA,RSS PROCESSING JMP LNKER-1 IS ALL DONE. * CPB TEMP REMOVING ENTRY FROM NULL LIST? [=0] CLA,INA,RSS YES. PREPARE TO ADD TO ACTIVE COUNT. CCA NO. PREPARE TO DECREMENT ACTIVE COUNT. ADA #BUSY COMPUTE THE NEW 'ACTIVE-ENTRY' COUNT, STA #BUSY AND UPDATE THE INDICATOR. CLA,RSS INDICATE NORMAL RETURN, AND SKIP. LNKER CCA =-1: NO ENTRIES IN REMOVAL LIST. JMP LNK,I RETURN IS MADE TO THE CALLER. * PNTR NOP LIST POINTER STORAGE. * SKP * TABLE OF LIST-HEADER ADDRESSES. LIST CODES: SPC 1 #LDEF DEF SOT START-OF-TABLE DEFINITION. PDEF DEF #PNLH HP3000 PROCESS NUMBER HEADER -01 SOT DEF #NULL ENTRY-POOL HEADER 00 MDEF DEF #MRTH MASTER-REQUEST HEADER 01 SDEF DEF #ST00 SLAVE-STREAM 00 HEADER 02 DEF #ST01 SLAVE-STREAM 01 HEADER 03 DEF #ST02 SLAVE-STREAM 02 HEADER 04 DEF #ST03 SLAVE-STREAM 03 HEADER 05 DEF #ST04 SLAVE-STREAM 04 HEADER 06 DEF #ST05 SLAVE-STREAM 05 HEADER 07 DEF #ST06 SLAVE-STREAM 06 HEADER 10 DEF #ST07 SLAVE-STREAM 07 HEADER 11 DEF #ST08 SLAVE-STREAM 08 HEADER 12 DEF #ST09 SLAVE-STREAM 09 HEADER 13 DEF #ST10 SLAVE-STREAM 10 HEADER 14 DEF #ST11 SLAVE-STREAM 11 HEADER 15 * NEW ENTRY: .........DEF #STXX.....SLAVE-STREAM XX HEADER........15 * NMAX ABS SDEF-*-2 LIST CODE VALIDITY-CHECKING CONSTANT. * #MNUM ABS NMAX-SDEF NUMBER OF SLAVE-STREAM TYPES. SPC 1 * CONSTANTS AND STORAGE. SPC 1 M8 DEC -8 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P10 DEC 10 P12 DEC 12 P16 DEC 16 P14 DEC 14 SIGN OCT 100000 TEMP OCT 0,0 TEMPORARY STORAGE LOCATIONS. SPC 1 D$BSZ NOP MSG SIZE MAX FOR MPE LINK * HP3000 ID SEQUENCE SPECIFICATIONS * D$LID DEF LOC LOCAL ID SEQUENCE ADDRESS D$RID DEF REM REMOTE ID SEQUENCE ADDRESS SPC 1 #RDLY DEC -200 MAXIMUM RTRY DELAY: 200 CENTOSECONDS (2 SEC.) #PRLU DEF #PRGL DEFAULT LU FOR PROGL MESSAGES: NO MESSAGES * (NOTE: #PRGL IS IN #REQU. IT MUST BE SEPARATED * IN ORDER TO ALLOW 'ABS' AT GEN-TIME TO WORK, AS WELL * AS ON-LINE PATCHES TO #PRLU) * * GENERAL SYSTEM DATA [ INITIALIZED BY 'DINIT' ]. * * NOTE: ANY CHANGE IN THE ORDERING OF THIS AREA MUST BE ACCOMPANIED * BY A CHANGE TO THE CORRESPONDING AREA OF 'DINIT' * SPC 1 #SCLR DEF #TBRN START OF AREA CLEARED BY 'DINIT'. #FWAM NOP ADDRESS OF SYSTEM AVAIL. MEMORY BLOCK. #SAVM NOP SIZE OF SYSTEM AVAIL. MEMORY BLOCK. #TBRN NOP TABLE-ACCESS RESOURCE NUMBER. #QRN NOP QUIESCENT(RN) OR SHUT-DOWN(0). #GRPM NOP GENERAL PRE-PROCESS MODULE CLASS NO. #QCLM NOP QUEUE CLEAN-UP MONITOR CLASS NUMBER. #BUSY NOP NUMBER OF ACTIVE TCB ENTRIES. #MSTO NOP MASTER REQUEST TIMEOUT VALUE. #SVTO NOP SLAVE REQUEST TIMEOUT VALUE. #RTRY NOP RETRY-PROCESSOR'S CLASS NUMBER. #WAIT NOP D65MS QUIESCENT WAIT INTERVAL. #SWRD NOP NETWORK-NODE SECURITY CODE. #BREJ NOP D65MS RETRY COUNT FOR BUSY REJECT. #INCV NOP INCOMING MSG CNVTR CLASS NUMBER #OTCV NOP OUTGOING MSG CNVTR CLASS NUMBER #MHCT NOP MAXIMUM HOP COUNT #MDCT NOP MAX. TIMES A LINK CAN GO DOWN IN 5 MIN #RPCV NOP HP3000 REPLY CONVERTER CLASS NO. #RQCV NOP HP3000 REQUEST CONVERTER CLASS NO. #LU3K NOP LU NUMBER OF HP3000 #QZRN NOP QUEZ RN FOR "LISTEN MODE" #CLRN NOP QUEX RESOURCE NUMBER FOR CLEANUP #QXCL NOP QUEX CLASS NO. #TST NOP HP3000 TRANS. STATUS TABLE ADDRESS NOP HP3000 TRANS. STATUS TABLE SIZE,IN ENTRIES * SKP * LIST HEADERS (REMAINDER OF LISTS LOCATED IN SYSTEM AVAILABLE MEMORY). SPC 3 #PNLH NOP HP3000 PROCESS # LIST SPC 1 #NULL NOP LIST HEADER: ENTRY POOL. SPC 1 #MRTH NOP MASTER REQUEST LIST. SPC 1 #ST00 OCT 0,0,0,0,0 SLAVE-STREAM 00 LIST. SPC 1 #ST01 OCT 0,0,0,0,0 SLAVE-STREAM 01 LIST. SPC 1 #ST02 OCT 0,0,0,0,0 SLAVE-STREAM 02 LIST. SPC 1 #ST03 OCT 0,0,0,0,0 SLAVE-STREAM 03 LIST. SPC 1 #ST04 OCT 0,0,0,0,0 SLAVE-STREAM 04 LIST. SPC 1 #ST05 OCT 0,0,0,0,0 SLAVE-STREAM 05 LIST. SPC 1 #ST06 OCT 0,0,0,0,0 SLAVE-STREAM 06 LIST. SPC 1 #ST07 OCT 0,0,0,0,0 SLAVE-STREAM 07 LIST. SPC 1 #ST08 OCT 0,0,0,0,0 SLAVE-STREAM 08 LIST. SPC 1 #ST09 OCT 0,0,0,0,0 SLAVE-STREAM 09 LIST. SPC 1 #ST10 OCT 0,0,0,0,0 SLAVE-STREAM 10 LIST. SPC 1 #ST11 OCT 0,0,0,0,0 SLAVE-STREAM 11 LIST. SPC 1 * NEW ENTRY: ...#STXX OCT 0,0,0,0,0 .............SLAVE-STREAM XX LIST. SKP #RFSZ NOP MAXIMUM NUMBER OF 'OPEN' RFA FILES. * * REMOTE SESSION MONITOR ITEMS * #RSM NOP REMOTE SESSION MONITOR CLASS NUMBER #POOL NOP POINTER TO REMOTE SESSION ID POOL #DFUN BSS 11 DEFAULT ACCOUNT FOR REMOTE SESSION #PASS BSS 5 PASSWOD FOR NON-SESSION ACCESS * * PLOG/TLOG ITEMS * #PLOG BSS 7 1000 LOGGING PROGRAM'S CLASS NO. #CL3K BSS 7 3000 LOGGING PROGRAM'S CLASS NO. * * EXECM ITEMS * #EXHC BSS 1 EXECM HOLDING CLASS #EXTC BSS 1 EXECM TEMPORARY CLASS * * RE-ROUTING ITEMS * #LV NOP LINK VECTOR PNTR (OR 0 IF NO RE-ROUTING) #LCNT NOP NUMBER OF "LINK VECTOR" ENTRIES #CM NOP "COST MATRIX" PNTR, OR 0 IF NO RE-ROUTING #CMCT NOP NUMBER OF "COST MATRIX" ENTRIES * * "MESSAGE Atf~|xCCOUNTING" STORAGE AREA * #MCTR NOP NEGATIVE # OF M.A. TABLE ENTRIES #MTBL NOP PNTR TO M.A. TABLE (IN SAM) #MARN NOP M.A. TABLE ACCESS RESOURCE NUMBER #MAHC NOP M.A. 'HOLDING' CLASS (SLAVE REPLY QUEUE FOR RE-XMISN) #MARL NOP MAX. MSG RETRY LIMIT #MAZE NOP MA DEBUG TRACE FLAG * *-- MAX NUMBER OF TCBS IN THE SYSTEM (INCLUDES PNL ENTRYS) #TCB NOP * * END OF AREA CLEARED BY "DINIT" * #NCLR ABS #TBRN-* NEGATIVE # LOCNS 'DINIT' CLEARS SPC 2 * NODAL ADDRESSING SPECIFICATIONS. * #CNOD NOP CURRENT-USER-NODE; -1: INACTIVE. #LNOD NOP DOWN-LOAD NODE * * * * #NODE NOP LOCAL NODE NUMBER. #ACRN NOP DOWN-LOAD FILE CRN * * * NOTE: #NCNT & #NRV MUST BE CONSECUTIVE! * #NCNT NOP NEG. NUMBER OF NRV TABLE ENTRIES (PAIRS) #NRV NOP S.A.M. ADDRESS OF NRV TABLE. #TRCL NOP 'TRACE' CLASS NUMBER #TRCN NOP 'TRACE' RESOURCE NUMBER SPC 2 #LEVL DEC 1 LOCAL NODE UPGRADE LEVEL #NMSC NOP NETWORK MANAGEMENT SECURITY CODE #LUMP NOP STORAGE FOR 'LUMAP' CLASS NUMBER #LMPE NOP STORAGE FOR ERRORS NOP (DOUBLE-WORD) NOP REPORTING NODE NUMBER SPC 2 * HP3000 ID SEQUENCE SPECIFICATIONS * LOC NOP LOCAL ID SEQUENCE: BYTE COUNT BSS 8 CHARACTERS * REM NOP REMOTE ID SEQUENCE: RESERVED WORD NOP BYTE COUNT BSS 8 CHARACTERS SPC 2 A EQU 0 B EQU 1 * XEQT EQU 1717B SPC 1 SIZE EQU * [ INDICATES SIZE OF ] SPC 1 END ~ c} 91750-18164 2013 S C0122 &RFAM1              H0101 zjASMB,C,Q HED RFAM * SINGLE DCB - RFA MONITOR * (C) HEWLETT-PACKARD CO. 1980 NAM RFAM,19,30 91750-16164 REV.2013 800721 ALL SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * SINGLE DCB VERSION OF RFA MONITOR * * NAME: RFAM * SOURCE: 91750-18164 * RELOC: 91750-16164 * PGMR: DAN GIBBONS * *************************************************************** SPC 2 EXT #ATCH,DTACH EXT EXEC,#GET,#SLAV,$OPSY EXT APOSN,CLOSE,FCONT,CREAT,LOCF,NAMF EXT OPEN,POSNT,PURGE,READF,FSTAT,RWNDF EXT WRITF,#NODE,#RFSZ EXT .MVW,.CMW,.CAX,.DSX,.LDX,.SBX,.ISX EXT #RPB RQB EQU #RPB SUP * BUFSZ EQU 129 MAXIMUM DATA BUFFER * SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * **************************.**************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * RFBLK-START * ****************************************************************** * * * R F A B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY: * * * * RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO RFA REQUEST BUFFERS. J * #FCN EQU #REQ RFA FUNCTION CODE. #DCB EQU #FCN+1 DCB/FILENAME AREA. #IRC EQU #DCB+3 DAPOS: IREC #IRB EQU #IRC+1 IRB #XIB EQU #IRC+2 IRB (DXAPO) #IOF EQU #IRB+1 IOFF #XIO EQU #XIB+2 IOFF (DXAPO) #ITR EQU #DCB+3 DCLOS: ITRUN #IC1 EQU #DCB+3 DCONT: ICON1 #IC2 EQU #IC1+1 ICON2 #ICR EQU #DCB+3 DCRET,DNAME,DOPEN,DPURG: ICR(1) #ID EQU #ICR+1 IDSEG #ISC EQU #ID+1 ISECU #SIZ EQU #ISC+1 DCRET: ISIZE(1) #SZ2 EQU #SIZ+1 ISIZE(2) #XRS EQU #SIZ+2 RECSZ (DXCRE) #TYP EQU #SZ2+1 ITYPE #XTY EQU #XRS+2 ITYPE (DXCRE) #NNM EQU #ISC+1 DNAME: NNAME #IOP EQU #ISC+1 DOPEN: IOPTN #NUR EQU #DCB+3 DPOSN: NUR #IR EQU #NUR+1 IR #XIR EQU #NUR+2 IR (DXPOS) #IL EQU #DCB+3 DREAD,DWRIT: IL #NUM EQU #IL+1 NUM #LEN EQU #FCN+1 DSTAT: ILEN #FOR EQU #LEN+1 IFORM #OPT EQU #FOR+1 IOP #NOD EQU #ICR+1 "FLUSH" REQUEST: NODE NUMBER * * OFFSETS INTO RFA REPLY BUFFERS. * #RFD EQU #REP DCRET,DOPEN: RFAMD ENTRY # #JSZ EQU #RFD+1 DCRET: JSIZE (DXCRE) #LOG EQU #REP DREAD: XLOG #REC EQU #REP DLOCF: IREC #RB EQU #REC+1 IRB #XRB EQU #REC+2 IRB (DXLOC) #OFF EQU #RB+1 IOFF #XOF EQU #XRB+2 IOFF (DXLOC) #JSC EQU #OFF+1 JSECT #XJS EQU #XOF+1 JSECT (DXLOC) #JLU EQU #JSC+1 JLU #XJL EQU #XJS+2 JLU (DXLOC) #JTY EQU #JLU+1 JTY #XJT EQU #XJL+1 JTY (DXLOC) #JRC EQU #JTY+1 JREC #XJR EQU #XJT+1 JREC (DXLOC) #IAD EQU #REP DSTAT: IADD * * MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. * #RLW EQU #MHD+13 M A X I M U M S I Z E ! ! ! * * RFBLK-END SKP SPC 3 ICLAS NOP RFAM LDA B,I GET THE CLASS STA ICLAS * LDA D1 SET MAX # RFAM FILES STA #RFSZ TO ONE. * JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 (IN CASE DINIT RUN FROM SESSION) * * * WE COME HERE INITIALLY AND EACH TIME A REQUEST HAS BEEN PROCESSED. * GO JSB #GET WAIT FOR A REQUEST TO COME DEF *+6 DEF ICLAS CLASS # DEF RQB BUFFER DEF C#RLW MAXIMUM LENGTH OF THE INCOMING BUFFER DTBFA DEF DTBFR DATA BUFFER ADDRESS DEF BUFLN MAXIMUM DATA LENGTH JMP ERR53 MUST BE A LENGTH ERROR * STA RQLN SAVE THE REQUEST LENGTH LDA RQB+#FCN GET THE FUNCTION CODE STA FCODE SAVE IT FOR LATER SSA CHECK FOR VALIDITY JMP ERR25 <0, NO GOOD ADA DM14 CHECK UPPER BOUND SSA,RSS JMP ERR25 >13, NO GOOD EITHER * * SINCE FUNCTION CODE LOOKS OK, WE USE IT AS INDEX IN A TABLE * TO GO TO THE PROPER PREPROCESSING. * CLA STA IERR LDA RQB+#FCN GET FCODE AGAIN ADA JSBTB LDA 0,I STA CALLI SET UP "JSB" ADR LDA RQB+#FCN ADA BRNCH ADD TO THE BEGINNING OF THE BRANCH TABLE JMP A,I GO EXECUTE THE PREPROCESSING HED RFAM: ORIENTATION * (C) HEWLETT-PACKARD CO. 1980 * * * WE WILL TRY TO DESCRIBE HERE THE FLOW OF OPERATIONS * IN THIS PROGRAM. * * * * 1. EACH REQUEST IS PROCESSED IN 4 PHASES: * - PREPROCESS * - FMP CALL BUILDING * - EXECUTION OF THE FMP CALL * - POSTPROCESS * * THE CHOICE OF THE PROCESSOR IS MADE EACH TIME BY USING * THE REQUEST CODE AS AN INDEX IN A BRANCH TABLE. * * * 2. PREPROCESSING * THE READER SHOULD FIND IN THE PREPROCESSING BRANCH TABLE * (BRNCH) THE LABEL AT WHICH THE CURRENT PREPROCESS WILL START. * * * * 3. FMP CALL FORMATING. * THE TABLE WE WILL USE TO SELECT A PROCESSOR IS BLDTB. * IN THIS PART WE ONLY SET THE ADDRESSES OF THE PARAMETERS * IN THE CALL BUFFER. * * * 4. POSTPROCESSING * ON COMPLETION OF THE FMP CALL WE GO TO "DONE" WHERE THE * SELECTION OF THE PREPROCESSOR IS DONE THROUGH THE TABLE * PSTBL. * * PST05 USED FOR DNAME AND DPURG * IF THE FILE WAS OPEN BEFORE THE FMP CALL AND THE CALL * WAS EXECUTED WITHOUT ERROR, THE CURRENT RFAMD ENTRY * IS DELETED. * * PST04 USED FOR DCRET * IF THE ICR WAS NOT SPECIFIED IN THIS REQUEST, SET THE * PROPER CRN VALUE IN THE RFAMD ENTRY. * IN ANY CASE, FIND THE RFAMD ENTRY # AND PASS IT TO * THE USER. * * PST00 USED FOR DSTAT * SET THE DATA LENGTH TO 125 WORDS. * * PST02 USED FOR DREAD * SET THE DATA LENGTH * * PST03 USED FOR DOPEN * IF THE ICR WAS SPECIFIED IN THE REQUEST, THE RFAMD * ENTRY # IS SET IN THE REQST, AND THE REPLY IS SENT. * IF THE ICR WAS NOT SPECIFIED IN THE REQUEST, THE * LEGALITY OF THIS OPEN IS CHECKED, AND EITHER: * - REJECTED (ERR -08) THE TYPE OF THE OPEN MAY HAVE * BE RESTORED * - ACCEPTED, THE CRN IS SET IN THE RFAMD ENTRY AND THE ENTRY * NUMBER IS SET IN THE REQST. * THE REPLY IS SENT. * * * 5. IF THE OPERATION WAS A SUCCESSFUL CLOSE, THE CURRENT RFAMD * ENTRY IS DELETED. * * * * HED RFAM: PREPROCESSING * (C) HEWLETT-PACKARD CO. 1980 SPC 3 * * HERE ON A "DCRET" BRN3 LDA %NAME CURRENT DCB ID SZA IS ENTRY AVAILABLE? JMP ERR28 NO, GIVE ERROR -28 * BRN31 LDB FNAMA LDA NAMA JSB .MVW SET UP CURRENT ENTRY: NAME, CRN, ID SEG DEF D5 NOP LDA RQB+#SRC GET ORIGINATOR'S NODE STA %NODE & SAVE IN LOCAL ENTRY JMP BUILD CURRENT ENTRY IS ALL SET! SPC 3 * * HERE ON A DOPEN * BRN4 JSB CKENT SET CRN, CHECK NAME, NODE, AND ID JMP BRN31 OK OR CURRENT ENTRY IS EMPTY SPC 3  * * PROCESSOR FOR FLUSH * BRN6 LDB FNAMA LDA NAMA JSB .CMW COMPARE NAME WITH CURRENT ENTRY DEF D3 NOP JMP *+3 MATCHES NOP JMP ERR11 DOESN'T MATCH, GIVE DCB NOT OPEN * LDB RQB+#NOD CPB DM1 CLOSE ALL? JMP BUILD YES, DO IT CPB %NODE IS IT THE ASSIGNED NODE? JMP BUILD YES, FLUSH IT JMP ERR11 NO, GIVE DCB NOT OPEN SPC 3 * * HERE FOR DPURG AND DNAME * BRN8 JSB CKENT CHECK NAME, NODE, AND ID STA TMPAD VALUE=0 IF NO CURRENT ENTRY JMP BUILD OK TO PROCEED SPC 3 * * * HERE FOR DSTAT. THIS IS A SPECIAL CALL, IT DOES NOT * NEED ANY DCB. SPECIAL TREATMENT. * BRN10 EQU * * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB FSTAT DEF *+2 DEF DTBFR STATUS BUFFER * JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 * * LDB D125 SET THE LENGTH OF THE JMP REPLY+1 DATA BUFFER & RETURN SPC 3 * * ENTER HERE FOR FUNCTIONS WHICH MUST ALREADY HAVE OPEN DCB * BRN1 LDB %NAME LDA RQB+#DCB+1 CPA %SEQ IS IT CORRECT ENTRY NUMBER? SZB,RSS YES, IS ENTRY STILL OPEN? JMP ERR26 ANSWER TO EITHER IS NO, GIVE -26 SKP SPC 3 * HERE WE BRANCH TO THE PROPER CALL SETUP ROUTINE. * BUILD LDA DCBA STA LDCB INITIALIZE DCB ADDR IN CALL LDA NAMA STA LDCB+2 INITIALIZE ADDR OF FILE NAME LDA SZOPA STA LDCB+3 INITIALIZE ADDR OF SIZE/OPTNL PARAM LDB PARAM GET ADDR OF PARAMETER DESTINATION LDA RQB+#FCN GET FCODE AGAIN / ADA BLDTB MAP IN "BUILD" TABLE JMP A,I GO PREPARE THE CALL TO FMP * SPC 3 * * CALL BUILDER FOR DWRIT * BLD12 LDA DTBFA STA LDCB+2 SET BUFFER ADDRESS IN CALL INB SPC 3 * * CALL BUILDER FOR DAPOS,DCLOS,DCONT,DPOSN,DWIND,FLUSH * BLD0 LDA RQLN REQUEST LENGTH ADA HDLEN COMPUTE # OF PARAMETERS + 1 JSB .CAX LDA PRM0A GET ADDR PRECEEDING REQ PARAMS * BLDCM JSB .DSX DECREMENT COUNT INA,RSS JMP BLD01 DONE MOVING PARAMETER "DEF"S * BLDC2 STA 1,I STORE "DEF" IN CALL SEQUENCE INB JMP BLDCM ITERATE SPC 3 * * CALL BUILDER FOR DCRET * BLD3 LDA TYPEA ADDR OF TYPE STA LDCB+4 * LDB D3 * * THE FOLLOWING PART IS COMMON TO DCRET, DNAME,DOPEN * AND DPURG, IT SETS THE SECURITY CODE AND THE CRN IN THE CALL * BLD31 ADB PARAM COMPUTE ADDR WITHIN CALL LDA SECUA GET ADDRESS OF ISECU STA B,I SET IT IN THE CALL LDA CRA GET ADDRESS OF ICR INB STEP TO NEXT PARAM IN CALL STA B,I SET IT IN THE CALL LDA A,I GET CRN SZA PRESENT ? INB YES, PUSH B TO NEXT JMP BLD01 DONE HERE, GO COMPLETE AND CALL SPC 3 * * CALL BUILDER FOR DLOCF * BLD4 JSB .LDX SET COUNTER DEF D7 LDA IRECA GET ADDR OF 1ST RETURN PARAM IN REPLY JMP BLDC2 GO SET-UP "DEF"S TO PARAMETERS SPC 3 * * CALL BUILDER FOR DNAME * BLD5 LDB D2 LDA TMPAD WAS THE FILE ALREADY OPEN ? SZA JMP BLD31 YES, DCB ADDRESS ALREADY SET JMP BLD81 NO, USE DATA BUFFER AS DCB SPACE. SPC 3 * * CALL BUILDER FOR DOPEN * * BLD6 CLB SET "FILE NOT OPEN" STB %DCB+9 STATUS * LDB D2 JMP BLD31 GO COMPLETE THE CALL SPC 3 * * CALL BUILDER FOR DPURG * BLD8 LDA NAMA]b GET FILE NAME ADDRESS STA LDCB+2 SET IT IN CALL CLB,INB BLD81 LDA DTBFA GET THE ADDRESS OF THE DATA BUFFER STA LDCB USE IT AS THE DCB ADDRESS FOR THIS CALL JMP BLD31 GO COMPLETE SPC 3 * * CALL BUILDER FOR DREAD * BLD9 LDA RQB+#IL REQUESTED DREAD LENGTH CMA,INA ADA BUFLN BUFFER SIZE - REQUESTED LENGTH SSA BUFFER EXCEEDED? JMP ERR53 YES, GIVE LENGTH ERROR LDA DTBFA GET ADDRESS OF DATA BUFFER STA LDCB+2 SET IT IN CALL CLB STB RQB+#LOG PRE-INITIALIZE RETURNED LENGTH LDA CRA GET ADDRESS OF REQUEST LENGTH LDB LOGA ALWAYS PASS LEN BACK. GET ITS ADDR DST LDCB+3 INA LDB A,I GET NUM SZB,RSS PRESENT ? JMP BLD91 NO STA LDCB+5 YES, SET IN CALL CLB,INB GET A 1 BLD91 ADB PARAM FIND RETURN ADDRESS ADB D3 * * WRAP-UP PREPROCESSING * BLD01 STB RTNAD SET THE RETURN ADDRESS CLA STA 1,I CLEAN OUT REST OF CALL INB CPB RTN MORE? JMP CALL NO, GO EXECUTE FMGR CALL JMP *-4 YES HED RFAM: POSTPROCESSING * (C) HEWLETT-PACKARD CO. 1980 * * POSTPROCESS FOR DNAME AND DPURG * PST05 CLB CPB TMPAD WAS IT AN ALREADY OPEN FILE ? JMP REPLY NO LDA IERR GET COMPLETION CODE SSA,RSS ERROR ? STB %NAME NO, DELETE THE OLD ENTRY LDA FCODE YES, GET FUNCTION CODE CPA DPURG ERROR ON A DPURG? STB %NAME YES, DELETE ENTRY (FMP CLOSED FILE) JMP REPLY SEND THE REPLY SPC 2 * * POSTPROCESS FOR DCRET AND DOPEN * PST04 LDA IERR SSA ANY ERROR ? JMP CLENT YES, JUST CLEAR OUT CURRENT ENTRY * LDA RQB+#ICR GET ICR SZA SPECIFIED ? JMP PST41 YES * LDA %DCB NO, GET 1ST WORD OF DCB AND B7a7 GET DISC LU CMA,INA STA RQB+#ICR REPLACE IN THE REQST PST41 JSB LUCR TRANSFORM INTO CRN STB %CRN SET IT * ISZ %SEQ BUMP CURRENT SEQUENCE NUMBER NOP LDA %SEQ STA #RPB+#RFD SAVE IT IN REPLY JMP REPLY SPC 2 * * WE COME HERE AFTER A DREAD * PST02 LDB RQB+#LOG GET LENGTH OF DATA SSB SKIP IF NOT EOF CLB ELSE DO ZERO LENGTH XFER JMP REPLY+1 SPC 2 * * POST PROCESS FOR FLUSH * PST08 CLA,INA ONE FLUSHED ENTRY STA IERR SET AS COMPLETION CODE * CLENT CLB STB %NAME CLEAN OUT CURRENT ENTRY HED RFAM: SEND REPLY * (C) HEWLETT-PACKARD CO. 1980 * * POST-PROCESSING COMPLETED, SET-UP TO SEND REPLY * REPLY CLB SET FOR NO DATA RETURNED STB LENGT LDA #NODE GET LOCAL NODE # STA #RPB+#ENO SET AS COMPLETION LOCATION LDA IERR SET THE COMPLETION CODE STA #RPB+#EC2 IN THE REPLY * PST1A LDA FCODE GET THE OPCODE ADA LNTBL INDEX IN THE REPLY LENGTH TABLE LDA A,I GET THE LENGTH STA RQLN SET THE LENGTH * * THE REPLY REQST IS READY, SEND IT BACK * JSB #SLAV DEF *+4 DEF RQLN REQST LENGTH DEF DTBFR DATA BUFFER DEF LENGT DATA LENGTH * NOP IGNORE THE ERROR RETURN FROM #SLAV * * IF THE OPERATION WAS A DCLOS, AND IT WORKED PROPERLY, WE * HAVE TO DELETE THE RFAMD ENTRY. * LDA FCODE GET OPCODE FOR THE LAST TIME CPA D1 DCLOS ? CLB,RSS JMP PST06 * * LDA IERR GET COMPLETION CODE SSA,RSS ERROR ? STB %NAME NO, CLEAR OUT CURRENT ENTRY * PST06 JSB .LDX GET A COUNTER DEF DM9 CLB GET A 0 PST07 JSB .SBX CLEAN THE OPTIONAL AREA DEF RQB+#RLW JSB .ISX JMP PST07 CONTINUE JMP GO GET NEXT REQUEST. HED RFAM: UTILITY ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * THIS ROUTINE CHECKS FILE NAME, CARTRIDGE REFERENCE, NODE, AND * ID SEGMENT ADDRESS IN THE NEW REQUEST AND RETURNS IF THEY * MATCH THE CURRENT ENTRY * CKENT NOP JSB LUCR CONVERT POSSIBLE LU TO CRN LDA %NAME SZA,RSS CURRENT ENTRY AVAILABLE JMP CKENT,I YES LDA RQB+#SRC CPA %NODE NODES MATCH? RSS YES JMP ERR28 NO, GIVE NO TABLE SPACE ERROR? SZB,RSS WAS CRN SPECIFIED LDB %CRN NO, USE CURRENT ENTRY'S CRN STB RQB+#ICR LDB FNAMA LDA NAMA JSB .CMW COMPARE NAME,CRN, & ID SEGMENT ADDRS DEF D5 NOP JMP CKENT,I MATCHED OK NOP JMP ERR28 DOESN'T MATCH, GIVE NO TABLE SPACE ERROR * * THIS ROUTINE WILL TRANSFORM A NEGATIVE DISC LU * INTO A CARTRIDGE NUMBER. BOTH INPUT AND RESULTS * ARE PASSED VIA REQST+#ICR. THE RESULT WILL ALSO BE * FOUND IN B REGISTER. IF AN ERROR IS DISCOVERED * WE WILL DIRECTLY JUMP TO THE ERROR ROUTINE. * LUCR NOP LDB RQB+#ICR SSB,RSS IS IT AN LU? JMP LUCR,I NO * LDA $OPSY CHECK TYPE AND DM15 CPA DM15 RTE-M? RSS YES JMP NOTM NO, SKIP CTU-SYS CHECK * CMB,INB YES, MAKE IT POSITIVE AND STB DTBFR SET UP STATUS CALL. * JSB EXEC GET EQUIPMENT-TYPE CODE DEF *+4 DEF D13I DEF DTBFR USE DTBFR FOR CONWD DEF DTBFR+1 AND EQT5. JMP ERR06 ILLEGAL LU * LDA DTBFR+1 GET EQT5 ALF,ALF AND B77 ISOLATE EQUIP-TYPE CODE LDB RQB+#ICR IF DVR05 (CTU SYSTEM), CPA D5 RETURN WITH JMP LUCR,I B = -LU. * NOTM EQU * * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB FSTAT GET INFO ON THE CURRENTLY DEF *+2 MOUNTED CARTRIGES. DBFAD DEF DTBFR SEND THE INFO IN THE DATA BUFFER * JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 * * LDA DBFAD DCB BUFFER ADDR LP84 LDB 0,I GET W1 OF ENTRY CMB,INB CPB RQB+#ICR IS IT OUR LU? JMP FND84 YES SZB,RSS END OF TABLE ? JMP ERR06 YES, ILLEGAL DISC LU ADA D4 PUSH THE ADDR TO THE NEXT ENTRY JMP LP84 CONTINUE * FND84 ADA D2 STEP TO THE CRN LDB 0,I GET IT STB RQB+#ICR SET IT IN THE REQST JMP LUCR,I SPC 3 * * THIS IS THE SKELETON OF THE FMP CALL * PARAM DEF LDCB+2 DEF LDCB * CALL EQU * * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB CALLI,I CALL FMP ROUTINE RTNAD NOP DEF RTRN LDCB DEF %DCB ADDRESS OF DCB IF ANY DEF IERR ERROR REP 8 NOP * DONE EQU * * JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 * LDA IERR GET RETURNED ERROR CODE SSA,RSS DID FMP DETECT AN ERROR? JMP NOERR NO LDA "FM" YES, INDICATE AN FMP-DETECTED ERROR STA #RPB+#EC1 IN THE REPLY. * NOERR LDA FCODE GET FUNCTION CODE ADA PSTBL POST-PROCESSING TABLE JMP 0,I JUMP TO POST-PROCESSOR * RTN DEF DONE CALLI NOP ADR OF FMP CALL "FM" ASC 1,FM SPC 3 ERR06 @JSB FMERR THIS IS REPORTED AS AN FMP ERROR CODE DEC -6 ERR11 JSB FMERR THIS IS REPORTED AS AN FMP ERROR CODE DEC -11 ERR25 EQU * INVALID FCODE. SET TO ZERO TO CLA INSURE VALID INDEX INTO REPLY STA FCODE LENGTH TABLE LATER. JSB ERRXX DEC -25 ERR26 JSB ERRXX DEC -26 ERR28 JSB ERRXX DEC -28 ERR53 JSB ERRXX DEC -53 * ERRXX NOP LDB ERRXX,I PICK UP ERROR CODE LDA "DS" INDICATE A DS-DETECTED ERROR * * ENTER HERE WITH = "DS" OR "FM" (GENERAL CATEGORY OF ERROR) * = ERROR CODE (STORED IN #EC2 WHEN SENDING BACK REPLY) * ERRYY EQU * STA #RPB+#EC1 STORE CATEGORY CODE OF ERROR STB IERR SET THE ERROR CODE IN THE REPLY JMP REPLY AND SHIP IT. SPC 2 FMERR NOP HERE ON FMP ERRORS LDB FMERR,I PICK UP ERROR CODE LDA "FM" RETURN "FM" ERROR CODE JMP ERRYY AND RETURN VALUE OF "IERR" * "DS" ASC 1,DS * RSERR LDA "RS" RETURN SPECIAL ASCII STA #RPB+#EC1 REMOTE SESSION MONITOR LDA "01" ERROR CODE "RS01". STA #RPB+#EC2 LDA BIT15 SET SIGN BIT IN IERR TO SIMULATE STA IERR NEG ERROR CODE FOR 'CLOS'. IOR #NODE SET LOCAL NODE # AND ASCII-ERROR STA #RPB+#ENO BIT INTO REPLY. CLA SET DATA LENGTH FOR STA LENGT CALL TO #SLAV. JMP PST1A GO SEND REPLY * * "RS" ASC 1,RS "01" ASC 1,01 HED RFAM: DATA AREA * (C) HEWLETT-PACKARD CO. 1980 A EQU 0 B EQU 1 SPC 2 **** DEFINE CURRENT OPEN RFAM ENTRY **** %NAME DEC 0,0,0 %CRN NOP %IDSG NOP %NODE NOP %SEQ NOP **** END OF CURRENT ENTRY **** SPC 2 B10 OCT 10 B377 OCT 377 DPURG EQU B10 FCODE FOR DPURG DM15 DEC -15 DM14 DEC -14 DM9 DEC -9 DM1 DEC -1 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D7 DEC 7 D13I OCT 100015 D125 cDEC 125 BUFLN ABS BUFSZ BIT15 OCT 100000 B77 OCT 77 FNAMA DEF %NAME HDLEN ABS -#DCB-2 NAMA DEF RQB+#DCB ADDR OF THE FILE NAME PRM0A DEF RQB+#DCB+2 ADDR PRECEEDING REQUEST PARAMS CRA DEF RQB+#ICR ADDR OF THE ICR SECUA DEF RQB+#ISC ADDR OF ISECU SZOPA DEF RQB+#SIZ ADDR OF SIZE/IOPTN TYPEA DEF RQB+#TYP ADDR OF TYPE IRECA DEF #RPB+#REC ADDR OF IREC (DLOCF PARAM) DCBA DEF %DCB LOGA DEF #RPB+#LOG ADDR OF LEN (XMISSION LOG) * * VARIABLES LENGT NOP IERR NOP TMPAD NOP RQLN NOP REQUEST LENGTH FCODE NOP FUNCTION CODE TEMP NOP HED RFAM: TABLES * (C) HEWLETT-PACKARD CO. 1980 BRNCH DEF *+1,I DEF BRN1 DAPOS DEF BRN1 DCLOS DEF BRN1 DCONT DEF BRN3 DCRET DEF BRN1 DLOCF DEF BRN8 DNAME DEF BRN4 DOPEN DEF BRN1 DPOSN DEF BRN8 DPURG DEF BRN1 DREAD DEF BRN10 DSTAT DEF BRN1 DWIND DEF BRN1 DWRIT DEF BRN6 FLUSH * JSBTB DEF *+1 DEF APOSN DEF CLOSE DEF FCONT DEF CREAT DEF LOCF DEF NAMF DEF OPEN DEF POSNT DEF PURGE DEF READF NOP DEF RWNDF DEF WRITF DEF CLOSE FLUSH * BLDTB DEF *+1,I CALL BUILDING TABLE DEF BLD0 DAPOS DEF BLD0 DCLOS DEF BLD0 DCONT DEF BLD3 DCRET DEF BLD4 DLOCF DEF BLD5 DNAME DEF BLD6 DOPEN DEF BLD0 DPOSN DEF BLD8 DPURG DEF BLD9 DREAD NOP DEF BLD0 DWIND DEF BLD12 DWRIT DEF BLD0 FLUSH * SPC 3 LNTBL DEF *+1 REPLY LENGTH TABLE ABS #REP DAPOS ABS #REP DCLOS ABS #REP DCONT ABS #RFD+1 DCRET ABS #JRC+1 DLOCF ABS #REP DNAME ABS #RFD+1 DOPEN ABS #REP DPOSN [TRN ABS #REP DPURG ABS #LOG+1 DREAD ABS #REP DSTAT ABS #REP DWIND ABS #REP DWRIT ABS #REP FLUSH SPC 3 PSTBL DEF *+1,I POST PROCESSING TABLE DEF REPLY DAPOS DEF REPLY DCLOS DEF REPLY DCONT DEF PST04 DCRET DEF REPLY DLOCF DEF PST05 DNAME DEF PST04 DOPEN DEF REPLY DPOSN DEF PST05 DPURG DEF PST02 DREAD NOP DEF REPLY DWIND DEF REPLY DWRIT DEF PST08 FLUSH HED RFAM: BUFFERS * (C) HEWLET-PACKARD CO. 1980 C#RLW ABS #RLW MAX LEN REQ/REPLY BUFFER. * * DTBFR BSS BUFSZ %DCB BSS 144 * SIZE EQU * * END RFAM @T dw 91750-18165 2013 S C0122 &RFAM2              H0101 {kASMB,C,Q,N IFN * START EXTENDED FILE CODE HED RFAM 91750-16165 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM RFAM,19,30 91750-16165 REV 2013 800703 MEF XIF * END EXTENDED FILE CODE * * IFZ * START NON-EXTENDED FILE CODE HED RFAM 91750-16ZZZ REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM RFAM,19,30 91750-16ZZZ REV 2013 800703 MEF XIF * END NON-EXTENDED FILE CODE SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 SPC 2 **************************************************************** * * RFAM RFA MONITOR * UNL IFN * START EXTENDED FILE CODE LST * NAME: RFAM * SOURCE: 91750-18165 * RELOC: 91750-16165 * PGMR: DAN GIBBONS UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST * SOURCE PART # 91750-18ZZZ REV 2013 * * REL PART # 91750-16ZZZ REV 2013 UNL XIF * END NON-EXTENDED FILE CODE LST * *************************************************************** SPC 2 EXT EXEC,#GET,#SLAV EXT .MVW,.CBX,.STX,.CMW EXT APOSN,CLOSE,FCONT,CREAT,LOCF,NAMF EXT OPEN,POSNT,PURGE,READF,FSTAT,RWNDF EXT WRITF,#NODE,#RFSZ EXT $LIBR,$LIBX,$CVT3,$OPSY EXT #RPB,.DRCT,#ATCH,DTACH RQB EQU #RPB UNL IFN * START EXTENDED FILE CODE LST EXT ECREA,ECLOS,EREAD,EWRIT EXT EAPOS,EPOSN,ELOCF UNL XIF F * END EXTENDED FILE CODE LST SUP SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIկMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * RFBLK-START * ****************************************************************** * * * R F A B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY: * * * * RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO RFA REQUEST BUFFERS. * #FCN EQU #REQ RFA FUNCTION CODE. #DCB EQU #FCN+1 DCB/FILENAME AREA. #IRC EQU #DCB+3 DAPOS: IREC #IRB EQU #IRC+1 IRB #XIB EQU #IRC+2 IRB (DXAPO) #IOF EQU #IRB+1 IOFF #XIO EQU #XIB+2 IOFF (DXAPO) #ITR EQU #DCB+3 DCLOS: ITRUN #IC1 EQU #DCB+3 DCONT: ICON1 #IC2 EQU #IC1+1 ICON2 #ICR EQU #DCB+3 DCRET,DNAME,DOPEN,DPURG: ICR(1) #ID EQU #ICR+1 IDSEG #ISC EQU #ID+1 ISECU #SIZ EQU #ISC+1 DCRET: ISIZE(1) #SZ2 EQU #SIZ+1 ISIZE(2) #XRS EQU #SIZ+2 RECSZ (DXCRE) #TYP EQU #SZ2+1 ITYPE #XTY EQU #XRS+2 ITYPE (DXCRE) #NNM EQU #ISC+1 DNAME: NNAME #IOP EQU #ISC+1 DOPEN: IOPTN #NUR EQU #DCB+3 DPOSN: NUR #IR EQU #NUR+1 IR #XIR EQU #NUR+2 IR (DXPOS) #IL EQU #DCB+3 DREAD,DWRIT: IL #NUM EQU #IL+1 NUM #LEN EQU #FCN+1 DSTAT: ILEN #FOR EQU #LEN+1 IFORM #OPT EQU #FOR+1 IOP #NOD EQU #ICR+1 "FLUSH" REQUEST: NODE NUMBER * * OFFSETS INTO RFA REPLY BUFFERS. * #RFD EQU #REP DCRET,DOPEN: RFAMD ENTRY # #JSZ EQU #RFD+1 DCRET: JSIZE (DXCRE) #LOG EQU #REP DREAD: XLOG #REC EQU #REP DLOCF: IREC #RB EQU #REC+1 IRB #XRB EQU #REC+2 IRB (DXLOC) #OFF EQU #RB+1 IOFF #XOF EQU #XRB+2 IOFF (DXLOC) #JSC EQU #OFF+1 JSECT #XJS EQU #XOF+1 JSECT (DXLOC) #JLU EQU #JSC+1 JLU #XJL EQU #XJS+2 JLU (DXLOC) #JTY EQU #JLU+1 JTY #XJT EQU #XJL+1 JTY (DXLOC) #JRC EQU #JTY+1 JREC #XJR EQU #XJT+1 JREC (DXLOC) #IAD EQU #REP DSTAT: IADD * * MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. * #RLW EQU #MHD+13 M A X I M U M S I Z E ! ! ! * * RFBLK-END SKP ICLAS NOP RFAM LDA B,I GET THE CLASS STA ICLAS JMP INIT GO EXECUTE THE INITIALIZATION PHASE SPC 3 HED RFAM: ACTIVATOR * (C) HEWLETT-PACKARD CO. 1980 * * WE COME HERE THE FIRST TIME WHEN THE INITIALIZATION IS COMPLETED * WE COME BACK HERE EACH TIME A REQUEST HAS BEEN PROCESSED. * AS USUAL, WE HANG ON A CLASS WAITING FOR A REQUEST TO COME. * THE CLASS HAS BEEN PASSED TO US BY LSTEN AT SYSON TIME. * GO JSB #GET WAIT FOR A REQUEST TO COME DEF *+6 DEF ICLAS CLASS # RQBA DEF RQB BUFFER DEF C#RLW MAXIMUM LENGTH OF THE INCOMING BUFFER DTBFA DEF DTBFR DATA BUFFER ADDRESS DEF D512 MAXIMUM DATA LENGTH JMP GO IGNORE ERROR RETURN * STA RQLN SAVE THE REQUEST LENGTH LDA RQB+#FCN GET THE FUNCTION CODE SSA CHECK FOR VALIDITY JMP ERR25 <0, NO GOOD STA FCODE SAVE FUNCTION CODE ADA UBFCN SSA,RSS JMP ERR25 TOO BIG, NO GOOD EITHER * * SINCE FUNCTION CODE LOOKS OK, WE USE IT AS INDEX IN A TABLE * TO GO TO THE PROPER PREPROCESSING. * LDA FCODE GET FCODE AGAIN ADA BRNCH ADD TO THE BEGINNING OF THE BRANCH TABLE JMP A,I GO EXECUTE THE PREPROCESSING * HED RFAM: ORIENTATION * (C) HEWLETT-PACKARD CO. 1980 * * * WE WILL TRY TO DESCRIBE HERE THE FLOW OF OPERATIONS * IN THIS PROGRAM. * * * * 1. EACH REQUEST IS PROCESSED IN 4 PHASES: * - PREPROCESS * - FMP CALL BUILDING * - EXECUTION OF THE FMP CALL * - POSTPROCESS * * THE CHOICE OF THE PROCESSOR IS MADE EACH TIME BY USING * THE REQUEST CODE AS AN INDEX IN A BRANCH TABLE. * * * 2. PREPROCESSING * THE READER SHOULD FIND IN THE PREPROCESSING BRANCH TABLE * (BRNCH) THE LABEL AT WHICH THE CURRENT PREPROCESS WILL START. * HERE IS A DESCRIPTION OF THESE PREPROCESSES. * * BRN2 USED BY DCLOS & DXCLO * SCAN THE RFAMD TABLE FOR OTHER USERS OF THIS FILE. * ONLY USER ? * - YES => BRN9, GET READY FOR A REAL FILE CLOSE. * - NO => BRN7, FAKE A CLOSE, SEND THE REPLY. * * BRN8 USED FOR DPURG AND DNAME * SCAN THE RFAMD LIST FOR USERS OF THIS FILE. * - FILE NOT CURRENTLY USED => BRN5, PREPARE THE FMP CALL * - FILE CURRENTLY USED, BUT ONLY BY US => BRN9, GET * CURRENT DCB, THEN BUILD THE CALL. * - FILE CURRENTLY USED BY SOMEONE ELSE, RESTORE THE * TYPE OF THE OPEN IF NECESSARY (WE MIGHT HAVE HAD TO * OPEN THE FILE TO LOCATE IT IF ICR WAS NOT SPECIFIED) * THEN REJECT THE REQUEST (ERR -08) * * BRN4 USED ONLY BY DOPEN * IS ICR SPECIFIED ? * - YES, CHECK THE LEGALITY OF THIS OPEN (BRN41) * REJECT (ERR -08) IF ILLEGAL. * - NO, SKIP THE CHECKING, IT WILL BE DONE LATER. * => BRN3 * * BRN3 USED BY DCRET & DXCRE * GET A DCB SPACE IN CORE. SWAP AN OLD DCB IF NECESSARY. * GET AN RFAMD ENTRY, LINK IT TO THE LIST AND FORMAT IT. * * BRN1 USED BY DAPOS, DCONT, DLOCF, DPOSN, DREAD, DWIND, * DWRIT, DXREA, DXWRI, DXAPO, DXPOS, AND DXLOC. * HTHE RFAMD ENTRY # PASSED IN THE REQUEST IS CHECKED FOR * FOR VALIDITY. * THE ENTRY IS LOCATED. * THE DCB IS BROUGHT TO CORE IF CURRENTLY ON DISC. * THE RFAMD IS RELINKED: * - IF THE DCB WAS ALREADY IN CORE, THE ENTRY IS ADVANCED * ONE POSITION (I.E. INSERTED BEFORE THE ENTRY IN FRONT * ITSELF). * - IF THE DCB HAD TO BE BROUGHT TO CORE, THE ENTRY IS * INSERTED AS THE "LAST" ENTRY IN THE "DCB IN CORE" PART * OF THE RFAMD. * WE THEN GO TO PREPARE THE CALL. * * BRN10 FOR DSTAT ONLY * CALL FSTAT AND GO DIRECTLY TO THE REPLY SECTION * * BRN6 FOR FLUSH ONLY * - DELETE THE PROPER RFAMD TABLE ENTRIES AND RETURN * TO THE DCB FREE LIST THE DCB SPACES WHICH ARE NOT * ANY MORE NEEDED. * - MAKE A DECISION ON WETHER OR NOT WE HAVE TO CLOSE * THIS FILE. IF YES, JMP BRN9 FOR STANDARD CLOSE, ELSE * JMP BRN7 FOR TERMINATION. * * * 3. FMP CALL FORMATTING. * THE TABLE WE WILL USE TO SELECT A PROCESSOR IS BLDTB. * IN THIS PART WE ONLY SET THE ADDRESSES OF THE PARAMETERS * IN THE CALL BUFFER. * * * 4. POSTPROCESSING * ON COMPLETION OF THE FMP CALL WE GO TO "DONE" WHERE THE * SELECTION OF THE PREPROCESSOR IS DONE THROUGH THE TABLE * PSTBL. * * PST05 USED FOR DNAME AND DPURG * IF THE FILE WAS OPEN BEFORE THE FMP CALL AND THE CALL * WAS EXECUTED WITHOUT ERROR, THE CURRENT RFAMD ENTRY * IS DELETED. * * PST04 USED FOR DCRET & DXCRE * IF THE ICR WAS NOT SPECIFIED IN THIS REQUEST, SET THE * PROPER CRN VALUE IN THE RFAMD ENTRY. * IN ANY CASE, FIND THE RFAMD ENTRY # AND PASS IT TO * THE USER. * IF DXCRE CALL, SET FMP RETURN PARAM 'JSIZE' INTO * REPLY BUFFER. * * PST00 USED FOR DSTAT * SET THE DATA LENGTH TO 125 OR 253 WORDS. * * PST02 USED FOR DREAD &DXREA * SET THE DATA LENGTH F * * PST03 USED FOR DOPEN * IF THE ICR WAS SPECIFIED IN THE REQUEST, THE RFAMD * ENTRY # IS SET IN THE REPLY BUFFER, AND THE REPLY IS SENT. * IF THE ICR WAS NOT SPECIFIED IN THE REQUEST, THE * LEGALITY OF THIS OPEN IS CHECKED, AND EITHER: * - REJECTED (ERR -08) THE TYPE OF THE OPEN MAY HAVE * BE RESTORED * - ACCEPTED, THE CRN IS SET IN THE RFAMD ENTRY AND THE ENTRY * NUMBER IS SET IN THE REPLY BUFFER. * THE REPLY IS SENT. * * * 5. IF THE OPERATION WAS A SUCCESSFUL CLOSE, THE CURRENT RFAMD * ENTRY IS DELETED. * * * * HED RFAM: PREPROCESSING * (C) HEWLETT-PACKARD CO. 1980 SPC 3 * * HERE FOR DCLOS & DXCLO * BRN2 JSB ENTCK CHECK THE VALIDITY OF THE ENTRY # STA CRFAD ENTRY # OK. A = ADDRESS OF ENTRY. ADA D2 STEP TO THE FILE NAME LDB FNAMA GET THE DESTINATION ADDRESS JSB .MVW MOVE THE FILE NAME AND THE CRN DEF D4 NOP * LDA FIRST SET THE START POINTER TO STA PNTR1 SEARCH FROM THE FIRST ENTRY. * BRN21 JSB SERCH FILE OPEN TO ANYONE ELSE? JMP BRN9 NO, SO OK TO CLOSE * * SUCCESSFUL SEARCH. IS IT US ? * LDA PNTR1 GET SEARCH POINTER CPA CRFAD COMPARE TO CURRENT ENTRY RSS YES, US, NO PROBLEM JMP BRN22 NO, FAKE THE CLOSE. LDA PNTR1,I GET NEXT TO SEARCHED ENTRY STA PNTR1 RESET THE SEARCH POINTER JMP BRN21 CONTINUE TO SCAN. * BRN22 CLA SET FOR NO ERROR STA IERR JMP BRN7 RETURN SPC 3 * * HERE FOR DPURG AND DNAME * BRN8 JSB BRN84 SET UP FOR LIST SCAN. CLB STB TMPAD JSB SERCH SCAN THE LIST JMP BRN5 UNSUCCESFUL SEARCH => OK. * * IF THE FILE IS OPENED TO US AND ONLY TO US, * WE ARE ALLOWED TO EXECUTE THE REQUEST. * PNTR1 POINTS TO THE MATCHING ENTRY * JSB US? IS IT OUR ENTRY ? JMP BRN81 NO, NOT US STA TMPAD SAVE ENTRY ADDRESS SSB EXCLUSIVE OPEN ? JMP BRN82 YES, WE ARE THE ONLY USER * LDA A,I GET ADDRESS OF NEXT ENTRY STA PNTR1 SET THE POINTER TO CONTINUE THE SEARCH JSB SERCH DO IT RSS NOBODY ELSE IN THE GAME, EXECUTE JMP BRN81 SOMEONE ELSE, FORGET IT * LDA TMPAD GET ENTRY ADDRESS BRN82 STA CRFAD SET FOR DCB RETREIVAL JSB FNDX FIND THE ENTRY # JMP BRN91 GET THE DCB AND EXEC THE REQ. * * SUCCESSFUL SEARCH, WE CANNOT PURGE NOR RENAME A FILE OPEN TO * SOMEONE ELSE. * * THE FILE WAS FOUND TO BE CURRENTLY OPENED TO SOMEONE. * TO FIND THIS WE MIGHT HAVE HAD TO OPEN THE FILE. * IF THE CURRENT OWNER(S) HAD IT NON-EXCLUSIVELY OPENED, * WE HAVE TO RESTORE THIS STATUS. * BRN81 LDA DFLFL SZA,RSS DID WE HAVE TO DO AN OPEN ? JMP ERR08 NO LDA PNTR1 GET ADDRESS OF RFAMD ENTRY ADA D7 STEP TO THE NODE NUMBER LDA A,I GET IT SSA "EXCLUSIVE" BIT SET ? JMP ERR08 YES, WE DID NOT CHANGE ANYTHING * CLB SET THE DCB IN STB DTBFR+9 "FILE NOT OPEN" STATUS * JSB OPEN NO, REOPEN, NON EXCLUSIVELY DEF *+7 DEF DTBFR USE DATA AREA AS DCB DEF IERR1 DEF RQB+#DCB FILE NAME DEF D1 OPTION DEF RQB+#ISC ISECU DEF RQB+#ICR ICR * JMP ERR08 NOW, SEND ERROR SPC 3 * * WE COME HERE FOR DOPEN * BRN4 LDA RQB+#ICR GET ICR SZA,RSS PRESENT ? JMP BRN3 NO, WE WILL DO THE CHECKING LATER JSB BRN41 YES JMP BRN3 OK TO OPEN JMP ERR08 CANNOT OPEN SPC 3 * * HERE WE WILL CREATE AN RFAMD ENTRY. * THIS ENTRY WILL BE POSITIONED AT THE END OF THE * LIST OF RFAMD ENTRIES POINTING TO IN-CORE-DCB'S. * P WE WILL ALSO TAKE CARE OF FINDING A DCB SPACE AND * LINKING IT TO ITS RFAMD ENTRY. * BRN3 LDA BFREE GET FREE RFAMD-LIST HEAD POINTER SZA,RSS ANY FREE ENTRY ? JMP ERR28 NO, REJECT. * LDA FCORE GET FREE DCB-LIST HEAD POINTER. SZA ANY ROOM IN CORE ? JMP CRT1 YES, WE DONT HAVE TO SWAP ANYONE OUT. * * SINCE THERE IS NO ROOM FOR ANOTHER DCB IN CORE AT * THIS TIME, WE HAVE TO MAKE SOME ROOM. WE WILL SWAP * OUT THE "LAST" DCB. * JSB WLAST WRITE "LAST" DCB TO DISC * LDA LAST GET THE ENTRY ADDRESS INA STEP TO "PREVIOUS" POINTER LDB A,I GET ADDRESS OF PREVIOUS STB LAST RESET LAST ADA D7 STEP TO THE DCB POINTER CLB STB A,I SET IT FOR "DCB ON DISC" * JMP CRT2 * CRT1 LDB FCORE,I TAKE 1 DCB OUT OF THE STB FCORE FREE LIST AND RELINK THE LIST STA LDCB SAVE THE ADDRESS OF "OUR" DCB * * NOW THAT WE HAVE A DCB, LET'S TAKE CARE OF THE RFAMD ENTRY. * CRT2 LDA BFREE TAKE 1 OUT OF THE FREE LIST LDB BFREE,I AND RELINK THE FREE LIST STB BFREE * STA CRFAD SAVE ADDRESS OF OUR RFAM ENTRY LDB LDCB GET DCB ADDRESS ADA D8 STEP TO DCB POINTER STB A,I SET IT ADB D9 STEP TO OPEN FLAG AND DESTROY IT BY STB B,I BY MAKING IT DIFFERENT FROM RFAM'S IDSEG @ * * NOW INSERT CRFAD IN THE LIST * LDA LAST SZA IS THERE ANYTHING IN THIS LIST ? JMP CRT3 YES * * CRFAD WILL BE THE 1ST ENTRY OF THE LIST. * LDB CRFAD STB LAST SET IN-CORE LIMIT LDA FIRST SZA,RSS IS THE LIST EMPTY ? JMP CRT21 YES JSB INSRT INSERT STA FIRST RESET THE LIST HEAD JMP BRN31 * CRT21 STB FIRST STA 1,I NO "NEXT" INB STA 1,I NO "PREVIOUS" EITHERN JMP BRN31 ALL DONE FOR THIS CASE. * * WE HAVE TO INSERT THE NEW ENTRY AFTER THE "LAST" ONE * CRT3 CPA CRFAD ALREADY IN PLACE? JMP CRT33 YES LDB CRFAD ADDR OF CURRENT ENTRY LDA LAST,I GET NEXT(LAST) STA 1,I STORE IN CURR. ENTRY STB LAST,I LINK OLD LAST TO THIS ONE SZA,RSS BOTTOM? JMP *+3 YES **** INA STB 0,I INB LDA LAST STA 1,I PREV(CRFAD)=OLD LAST CRT33 LDA LAST,I GET "NEXT" OF LAST STA LAST UPDATE LAST * * AN RFAMD ENTRY IS CREATED AND LINKED INTO THE LIST. * WE NOW HAVE TO FILL THE BLANKS IN THE RFAMD ENTRY. * BRN31 LDB CRFAD GET POINTER TO NEW RFAMD ENTRY. ADB D2 STEP TO FILE NAME LDA NAMA JSB .MVW MOVE THE FILE NAME DEF D3 NOP LDA RQB+#ICR GET ICR STA B,I SET IT IN CRFAD LDA RQB+#ID GET THE ID SEGMENT @ OF THE OWNER INB STA B,I LDA RQB+#SRC GET ORIGIN NODE INB STA B,I * * ALL SET ! * JMP BRN5 SPC 2 * * SUBROUTINE TO SWAP OUT THE "LAST" IN-CORE DCB. * FIRST FIND ITS DISC ADDRESS. * WLAST NOP LDA LAST GET CORE ADDRESS OF RFAMD ENTRY. JSB FNDX FIND ENTRY # JSB CALDS CALCULATE DISC ADDRESS * LDA LAST NOW FIND ITS CORE ADDRESS ADA D8 STEP TO DCB ADDRESS LDB A,I GET IT STB LDCB SAVE * ADB D12 STEP TO FILE POSITION POINTER JSB .CBX SAVE THE ADDRESS LDB B,I GET THE POINTER LDA LDCB GET THE DCB ADDRESS CMA,INA SUBTRACT FROM FILE POSITION ADB A POINTER TO FORM RELATIVE POINTER. JSB .STX RETRIEVE POINTER ADR DEF A STB A,I SET RELATIVE POINTER INTO DCB * JSB EXEC NOW WRITE THE DCB DEF *+7 ON THE DISC. DEF D2I WR!vITE DEF IDISC DISC LU DEF LDCB,I CORE ADDRESS DEF D144 LENGTH DEF CTRK TRACK # DEF CSCT SECTOR ADDRESS * JMP DSCER DISC ERROR * JMP WLAST,I RETURN SPC 3 * * PREPROCESSOR FOR FLUSH * BRN6 CLA STA IERR SET FOR NO ERROR IN CASE OF NO ENTRY STA TMPNX SET A FLUSHED ENTRY COUNTER STA FLFLG SET A FLUSH FLAG TO INDICATE THE * ABSENCE/PRESENCE OF ENTRIES CORRESPONDING TO THIS FILE * WHICH MUST NOT BE FLUSHED. LDA NAMA LDB FNAMA SET THE FILE ID FOR THE SEARCH JSB .MVW DEF D4 NOP LDA FIRST STA PNTR1 SEARCH FROM THE START JSB BRN62 JMP ERR11 NO ENTRY MATCHES, GIVE "DCB" NOT OPEN * ISZ TMPNX INC THE ENTRY COUNTER LDA PNTR1 SAVE THE ENTRY @, WE WILL STA TMPAD USE IT FOR THE CLOSE BRN61 LDA PNTR1,I CONTINUE THE SEARCH STA PNTR1 JSB BRN62 JMP BRN64 ALL DONE ISZ TMPNX ONE MORE LDA PNTR1 JSB DELET DELETE THIS ENTRY JMP BRN61 CONTINUE * BRN64 LDA TMPAD LDB FLFLG GET THE FLUSH FLAG SZB DO WE CLOSE THIS FILE ? JMP BRN65 NO STA CRFAD SET THE ENTRY ADDRESS FOR THE CLOSE LDA C#ICR STA RQLN JMP BRN9 GO FOR A CLOSE * BRN65 JSB DELET DELETE THIS ENTRY JMP BRN7 AND RETURN. SPC 3 * * HERE WE DO THE COMMON PART OF NEARLY EVERY REQUEST * BRN1 JSB ENTCK FIRST, CHECK THE VALIDITY OF THE ENTRY. STA CRFAD SAVE THE ADDRESS OF THE CURRENT ENTRY. * * IN THIS PART, KNOWING THE ADDRESS OF THE CURRENT RFAMD * ENTRY (CRFAD) WE WILL DETERMINE IF THE MATCHING DCB * IS IN CORE OR ON DISC. IF THE DCB IS ON DISC, IT WILL * BE BROUGHT IN TO CORE. THIS MAY REQUIRE THE SWAPPING OUT * OF ANOTHER DCB. * BRN9 LDA RQB+#DCB+1 GET THE ENTRY # BRN91 STA SWѴNX AND SAVE IT FOR THE DISC ACCESS LDA CRFAD GET POINTER TO THE ENTRY. ADA D8 STEP TO THE DCB POINTER LDA A,I GET IT SZA IS DCB ON DISC ? JMP CASE1 NO * * SINCE WE HAVE TO BRING THE DCB INTO CORE, WE HAVE * TO FIND ROOM FOR IT. * LDA FCORE GET FREE DCB LIST HEAD POINTER SZA ANY FREE DCB SPACE ? JMP SWIN1 YES, SWAP IN ONLY. * * WE WILL SWAP OUT THE "LAST" IN-CORE DCB. * JSB WLAST WRITE "LAST" DCB TO DISC * LDB LAST ADB D8 STEP TO THE DCB POINTER CLA STA B,I SET IT FOR DCB ON DISC STA TMP1 THIS FLAG MEANS THAT WE HAD TO SWAP OUT JMP SWIN2 * SWIN1 STA LDCB SAVE ADDRESS OF LOCAL DCB LDA LDCB,I GET "NEXT" TO LDCB STA FCORE RELINK THE DCB FREE LIST CCA STA TMP1 SET THE FLAG TO "NO SWAP OUT" * SWIN2 LDA SWNX GET NUMBER OF RFAMD ENTRY JSB CALDS FIND WHERE OUR DCB IS ON DISC * JSB EXEC GET THE DCB INTO CORE DEF *+7 DEF D1I DEF IDISC DEF LDCB,I DEF D144 DCB LENGTH DEF CTRK TRACK # DEF CSCT SECTOR NUMBER * JMP DSCER DISC ERROR * * NOW THAT THE DCB IS IN, RESET THE DCB POINTER IN CRFAD * AND THE FILE POSITION POINTER IN THE DCB. * LDA CRFAD ADA D8 STEP TO DCB POINTER LDB LDCB GET ADDRESS OF DCB STB A,I SET THE POINTER ADB D12 STEP TO RELATIVE FILE POSITION PTR LDA B,I GET IT ADA LDCB ADD DCB ADR TO FORM ABSOLUTE FILE STA B,I POSITION POINTER & SET INTO DCB. * * NOW IS TIME TO RELINK THE RFAMD LIST. * WE HAVE 3 SEPARATE CASES: * 1) THE DCB WAS ALREADY IN CORE. WE SWITCH * CRFAD WITH ITS PREVIOUS ENTRY EXCEPT IF CRFAD * THE FIRST ENTRY. IF CRFAD WAS TH6E 2ND AND-OR * LAST ENTRY, THE FIRST AND-OR LAST POINTERS * HAVE TO BE RESET. * 2) THE DCB WAS ON DISC AND THERE WAS ROOM * IN CORE. CRFAD IS INSERTED AFTER THE "LAST" ENTRY, * AND LAST IS RESET TO POINT TO CRFAD. IF BEFORE THE * INSERTION LAST=0 (I.E. THERE IS NO DCB IN CORE ) * THEN INSERT CRFAD BEFORE FIRST AND RESET FIRST AND * LAST TO CRFAD. * 3) THE DCB WAS ON DISC AND THERE WAS NO ROOM * IN CORE. INSERT CRFAD BEFORE LAST AND RESET LAST * TO CRFAD. IF FIRST=LAST, RESET ALSO FIRST (CASE * OF ONLY ONE DCB IN CORE). * LDA TMP1 GET FLAG SZA,RSS WHAT CASE IS THIS ? JMP CASE3 GUESS * * HERE WE TREAT CASE 2 * LDA LAST GET ADDRESS OF LAST SZA LIMIT CASE ? JMP CASE2 NO, NORMAL CASE2 LDA CRFAD TAKE CRFAD OUT JSB COUT OF LIST. LDA FIRST INSERT IT ON TOP OF THE LIST JSB INSRT * STA LAST RESET LAST STA FIRST RESET FIRST JMP BRN5 ALL DONE. * * NOW FOR REAL CASE 2 * CASE2 LDA LAST,I GET NEXT TO LAST CPA CRFAD CRFAD ALREADY IN PLACE? JMP CAS21 YES, NO INSERTION NECESSARY. LDA CRFAD JSB COUT TAKE CRFAD OUT OF ITS LIST. LDA LAST,I SET POINTER JSB INSRT OF CRFAD AFTER LAST. * CAS21 STA LAST RESET LAST. JMP BRN5 ALL DONE FOR CASE2 * * HERE ON CASE 3 * CASE3 LDA CRFAD JSB COUT TAKE CRFAD OUT OF THE LIST LDA LAST SET POINTER JSB INSRT CRFAD BEFORE LAST STA LAST RESET LAST LDB 0 INA STEP TO PREVIOUS OF CRFAD LDA A,I GET IT SZA,RSS IS CRFAD FIRST NOW ? STB FIRST RESET FIRST TO CRFAD. ?JMP BRN5 GO AWAY * * HERE FOR CASE 1 * CASE1 STA LDCB SAVE ADDRESS OF DCB LDA CRFAD CPA FIRST ALREADY TOP OF LIST? JMP BRN5 YES, DONE * JSB COUT REMOVE CRFAD FROM ITS SLOT LDA CRFAD INA LDA A,I GET PREV(CRFAD) JSB INSRT BEFORE PREVIOUS. * INA LDA A,I GET PREV(CRFAD) SZA IS CRFAD NOW FIRST ENTRY ? JMP CAS11 NO LDA CRFAD YES, GET ITS ADDRESS AGAIN STA FIRST RESET FIRST. * CAS11 LDB CRFAD,I GET ADDR OF NEXT LDA LAST WAS LAST POINTING TO CRFAD CPA CRFAD BEFORE THE SWITCH ? STB LAST YES, RESET LAST TO CRFAD(NEXT) JMP BRN5 ALL DONE SPC 3 * * HERE FOR DSTAT. THIS IS A SPECIAL CALL, IT DOES NOT * NEED ANY DCB. SPECIAL TREATMENT. * BRN10 EQU * UNL IFN * START EXTENDED FILE CODE LST LDA RQB+#LEN PROTECT AGAINST AND B377 TOO LARGE STA RQB+#LEN A DATA BUFFER. UNL XIF * END EXTENDED FILE CODE LST * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB FSTAT DEF FRTN DEF DTBFR STATUS BUFFER UNL IFN * START EXTENDED FILE CODE LST DEF RQB+#LEN ILEN DEF RQB+#FOR IFORM DEF RQB+#OPT IOP DEF TEMP IADD (RETURN PARAM) UNL XIF * END EXTENDED FILE CODE LST * FRTN EQU * JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 * CLA STA IERR SET FOR NO ERROR UNL IFN * START EXTENDEDdj FILE CODE LST LDA TEMP SET RETURN PARAM (IADD) STA RQB+#IAD INTO REPLY BUFR. LDB RQB+#LEN SET LENGTH OF DATA BUFFER UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST LDB D125 SET LENGTH OF DATA BUFFER UNL XIF * END NON-EXTENDED FILE CODE LST JMP PST01 & RETURN. SPC 3 * * HERE WE BRANCH TO THE PROPER CALL SETUP ROUTINE. * BRN5 LDA FCODE GET THE FUNCTION CODE ADA JSBTB ADD POINTER TO FMP CALL DEF-TABLE LDA A,I GET ADR OF FMP CALL STA CALLI SET IT LDA FCODE GET FCODE AGAIN ADA BLDTB MAP IN "BUILD" TABLE JMP A,I GO PREPARE THE CALL TO FMP * UNL IFN * START EXTENDED FILE CODE LST SPC 2 * * CALL BUILDERS FOR DXCLO, DXAPO, AND DXPOS * BLD15 LDA MDXCL GET DXCLO PARAM MASK JMP BLD0A GO BUILD CALL * BLD18 LDA MDXAP GET DXAPO PARAM MASK JMP BLD0A GO BUILD CALL * BLD19 LDA MDXP0 GET DXPOS PARAM MASK JMP BLD0A GO BUILD CALL SPC 3 UNL XIF * END EXTENDED FILE CODE LST * * CALL BUILDER FOR DAPOS,DCLOS,DCONT,DPOSN,DWIND * BLD0 CLA SET PARAM MASK FOR NO DOUBLE WORDS BLD0A LDB PARAM GET @ OF NEXT PARAM DEST. BLD02 JSB BLDCL BUILD THE FMP CALL * BLD01 STB RTNAD SET THE RETURN ADDRESS JSB NOPS CLEAN THE END OF THE BUFFER JMP CALL EXECUTE THE CALL SPC 2 * * BLDCL: * SETS PARAM ADDRESSES FROM REQUEST BUFFER INTO FMP CALL. * ENTER WITH = PARAM MASK (BITS CORRESPOND TO REQ BUFFER * PARAMS; 0=SINGLE WORD PARAM, 1=DOUBLE WORD PARAM), * = ADR OF NEXT PARAM IN 'CALL'. RETURN WITH = * RETURN ADR OF FMP 'CALL'. * BLDCL NOP STB PARMA SAVE PARAM DESTINATION ADR LDB RQLN CALCULATE # OF PARAM WORDS IN RQST CMB,INB ADB C#1ST SZB,RSS JMP BLDCN NO PARAMS IN REQUEST STB CNTR1 SET # PARAM WORDS IN COUNTER LDB RQBA GET CALL ADR ADB C#1ST STEP TO 1ST PARAM LOC BLDCM STB PARMA,I SET PARAM ADR INTO CALL INB BUMP SOURCE POINTER SLA IS SOURCE PARAM DOUBLE WORD? INB YES, BUMP SOURCE POINTER AGAIN ISZ PARMA BUMP DEST POINTER SLA,RAR IS SOURCE PARAM DOUBLE WORD? ISZ CNTR1 YES, BUMP WORD COUNTER TWICE ISZ CNTR1 DONE? JMP BLDCM NO, CONTINUE BLDCN LDB PARMA YES, SET TO 'CALL' RTRN ADR JMP BLDCL,I RETURN * PARMA NOP SPC 3 * * CALL BUILDER FOR DCRET & DXCRE * BLD3 LDA NAMA STA PRAM1 SET NAME PARAM ADR INTO CALL LDA #SIZA STA PRAM1+1 SET SIZE PARAM ADR LDA #TYPA UNL IFN * START EXTENDED FILE CODE LST LDB FCODE GET FCODE CPB DXCRE DXCRE REQUEST? LDA #XTYA YES UNL XIF * END EXTENDED FILE CODE LST STA PRAM1+2 SET TYPE PARAM ADR * LDA CRFAD GET THE ADDRESS OF THE RFAMD ENTRY ADA D7 STEP TO THE NODE # LDB A,I GET IT CCE RBL,ERB SET THE EXCLUSIVE-OPEN BIT STB A,I RESTORE THE WORD * LDB PARAM ADB D3 SET B TO CURRENT RETURN * * THE FOLLOWING PART IS COMMON TO DCRET, DXCRE, DNAME, DOPEN * AND DPURG, IT SETS THE SECURITY CODE AND THE CRN IN THE CALL * BLD31 STB TEMP SAVE ADR OF NEXT PARAM DEST. LDA SECUA STA TEMP,I SET ISECU PARAM ADR INTO CALL LDA CRA ISZ TEMP BUMP DEST POINTER STA TEMP,I SET ICR PARAM @ INTO CALL ISZ TEMP BUMP DEST POINTER UNL IFN * START EXTENDED FILE CODE LST LDA FCODE GET FCODE u CPA DXCRE DXCRE REQUEST? RSS YES, KEEP BUILDING JMP BL31A NO, FINISHED LDA D0A SET IDCBS DUMMY PLACEHOLDER STA TEMP,I INTO CALL. ISZ TEMP LDA JSIZA STA TEMP,I SET JSIZE PARAM ADR INTO CALL ISZ TEMP UNL XIF * END EXTENDED FILE CODE LST BL31A LDB TEMP SET B TO 'CALL' RETURN ADR JMP BLD01 GO EXECUTE CALL * TEMP NOP UNL IFN * START EXTENDED FILE CODE LST JSIZA DEF JSIZE JSIZE BSS 2 JSIZE RETURN PARAM FOR DXCRE D0A DEF D0 SPC 3 * * CALL BUILDER FOR DXLOC * BLD20 LDB MDXLO GET DXLOC REPLY PARAM MASK RSS GO BUILD CALL UNL XIF * END EXTENDED FILE CODE LST SPC 3 * * CALL BUILDER FOR DLOCF * BLD4 CLB GET LOCF REPLY PARAM MASK LDA PARAM SET 'CALL' PARAM POINTER STA PARMA LDA DM7 SET COUNTER TO # STA CNTR1 OF PARAMS IN REPLY. LDA RQBA CALCULATE 1ST REPLY ADA C#REC PARAM ADDRESS. * BLD41 STA PARMA,I SET REPLY PARAM ADR INTO CALL INA INCR TO NEXT REPLY PARAM ADR SLB,RBR WAS REPLY PARAM A DBL WORD? INA YES, BUMP REPLY BUFR PNTR AGAIN ISZ PARMA BUMP CALL PNTR ISZ CNTR1 FINISHED XFRING REPLY ADRS TO CALL? JMP BLD41 NO, CONTINUE LOOP * LDB PARMA YES, SET TO NEXT-PARAM ADR JMP BLD01 GO EXECUTE CALL SPC 3 * * CALL BUILDER FOR DNAME * BLD5 LDA RQBA GET @ OF REQUEST BUFFER ADA C#DCB STEP TO NAME STA PRAM1 SET @ OF NAME IN CALL ADA D6 GET @ OF NNAME STA PRAM1+1 SET IN CALL LDB PARAM ADB D2 SET FOR THE REST LDA TMPAD WAS THE FILE ALREADY OPEN ? SZA JMP BLD31 YES, DCB ADDRESS ALREADY SET JMP BLD81 NO, USE DATA1 BUFFER AS DCB SPACE. SPC 3 * * CALL BUILDER FOR DOPEN * BLD6 LDA RQB+#IOP GET OPEN OPTION CCE,SLA EXCLUSIVE ? JMP BLD61 NO LDA CRFAD YES, GET ADDRESS OF RFAMD ENTRY ADA D7 TO SET "EXCLUSIVE" FLAG IN NODE WORD. LDB A,I GET THE NODE NUMBER RBL,ERB SET THE SIGN BIT STB A,I REPLACE IN THE ENTRY * BLD61 LDA RQBA GET ADR OF THE REQUEST BUFR ADA C#DCB STEP TO THE FILE NAME STA PRAM1 SET IT IN THE CALL TO FMP ADA D6 STEP TO THE OPEN OPTION STA PRAM1+1 SET IT IN THE CALL * LDA LDCB SET THE ADA D9 DCB IN CLB "FILE NOT OPEN" STB A,I STATUS * LDB PARAM ADB D2 GET CURRENT RETURN ADDRESS JMP BLD31 GO COMPLETE THE CALL SPC 3 * * CALL BUILDER FOR DPURG * BLD8 LDA NAMA GET FILE NAME ADDRESS STA PRAM1 SET IT IN CALL LDB PARAM INB BLD81 LDA DTBFA GET THE ADDRESS OF THE DATA BUFFER STA LDCB USE IT AS THE DCB ADDRESS FOR THIS CALL JMP BLD31 GO COMPLETE SPC 3 * * CALL BUILDER FOR DREAD & DXREA * BLD9 LDA DTBFA GET ADDRESS OF DATA BUFFER STA PRAM1 SET IT IN CALL LDA RQBA ADA C#IL GET ADDRESS OF REQUEST LENGTH STA PRAM1+1 SET IN CALL CLB CLEAR RETURNED LENGTH WORD STB LEN TO AVOID CONFUSION ON ERROR LDB LENA ALWAYS PASS LEN BACK. GET ITS @ STB PRAM1+2 LDA RQBA ADA C#NUM GET ADR OF NUM STA PRAM1+3 SET INTO CALL LDB PARAM GET RETURN ADB D4 ADDRESS. JMP BLD01 GO COMPLETE AND EXECUTE UNL IFN * START EXTENDED FILE CODE LST * * CALL BUILDER FOR DXWRI * BLD17 LDA MDXWR GET DXWRI PARAM MASK RSS GO BUILD CALL UNL XIF i * END EXTENDED FILE CODE LST SPC 3 * * CALL BUILDER FOR DWRIT * BLD12 CLA A = DWRIT PARAM MASK LDB DTBFA STB PRAM1 SET BUFFER ADDRESS IN CALL LDB PARAM INB GET RETURN ADDRESS JMP BLD02 GO COMPLETE AND EXECUTE SPC 3 HED RFAM: POSTPROCESSING * (C) HEWLETT-PACKARD CO. 1980 * * POSTPROCESS FOR DNAME AND DPURG * PST05 LDA TMPAD WAS IT AN ALREADY OPEN FILE ? SZA,RSS JMP BRN7 NO LDB IERR GET COMPLETION CODE SSB,RSS ERROR ? JMP DODEL NO, DELETE THE OLD ENTRY LDB FCODE YES. IF FCODE WAS A DPURG WE MUST CPB DPURG DELETE ENTRY SINCE FMP CLOSES DODEL JSB DELET REGARDLESS OF ERROR. JMP BRN7 SEND THE REPLY SPC 3 * * POSTPROCESS FOR DCRET AND DXCRE * PST04 LDA IERR GET ERROR CODE RETURNED BY FMP CALL SSA ANY ERROR ? JMP INDX YES, DON'T WORRY ABOUT ALL THIS * LDA RQB+#ICR GET ICR SSA LU ? JMP PST41 YES SZA SPECIFIED ? UNL IFN * START EXTENDED FILE CODE LST JMP PST42 YES, IT'S A CRN UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST JMP INDX YES, IT'S A CRN UNL XIF * END NON-EXTENDED FILE CODE LST * LDA LDCB,I GET 1ST WORD OF DCB AND B77 GET DISC LU CMA,INA STA RQB+#ICR REPLACE IN REQST BUFR PST41 JSB LUCR TRANSFORM INTO CRN LDA CRFAD GET THE @ OF THE RFAMD ENTRY ADA D5 STEP TO THE CRN STB A,I SET IT UNL IFN * START EXTENDED FILE CODE LST PST42 LDA FCODE GET FCODE CPA DXCRE DXCRE CALL? RSS YES JMP INDX NO, GO DO INDEX THING LD^A JSIZE SET FMP RETURN PARAM STA RQB+#JSZ 'JSIZE' INTO REPLY LDA JSIZE+1 BUFFER. STA RQB+#JSZ+1 UNL XIF * END EXTENDED FILE CODE LST JMP INDX DO THE INDEX THING SPC 3 * * WE COME HERE AFTER A DREAD OR DXREA * PST02 LDB LEN GET LEN STB RQB+#LOG SAVE IN REPLY SSB SKIP IF NOT EOF CLB ELSE DO ZERO LENGTH XFER JMP PST01 SPC 3 * * WE COME HERE AFTER A CALL TO DOPEN * PST03 LDA RQB+#ICR GET ICR SZA WAS IT SPECIFIED ? JMP INDX YES, PASS THE RFAMD ENTRY #, THAT'S ALL LDA IERR GET THE COMPLETION CODE SSA ERROR ? JMP INDX YES LDA LDCB,I NO, GET 1ST WORD OF DCB CPA MAGLU RTE-M "MAGIC LU" TYPE 0 FILE? JMP MGLU1 YES, SET SPECIAL CODE IN RQB+8 AND B77 ISOLATE THE DISC LU CMA,INA MAKE IT <0 (FOR LU) MGLU1 STA RQB+#ICR REPLACE IT IN REQST BUFR * JSB BRN41 FIND THE LEGALITY OF THIS OPEN JMP PST31 LEGAL, WE ARE IN LUCK ! * * THIS OPEN HAS BEEN FOUND TO BE ILLEGAL, THIS MEANS * THAT AT LEAST ONE OTHER USER HAS THIS FILE OPENED, * AND AT LEAST ONE OF US HAS IT OPENED EXCLUSIVELY. * THE PROBLEM NOW IS TO FIND IF OUR OPEN CHANGED THE * TYPE OF OPEN (X/NON-X) AND TO RESTORE THE OLD TYPE * IF IT HAS BEEN CHANGED. * LDA RQB+#IOP GET OUR OPEN OPTION SLA DID WE DO AN EXCLUSIVE OPEN ? JMP NOX3 NO LDA PNTR1 YES WE DID, GET THE ADDRESS OF THE ADA D7 OTHER USER'S RFAMD ENTRY. LDA A,I GET THE NODE # SSA DID HE ALSO DO AN EXCLUSIVE OPEN ? JMP BAD03 YES, NO TYPE PROBLEM (THIS ALSO PROVES * THAT HE IS THE ONLY OTHER USER OF THIS FILE) CLA RESTORE THE STATUS STA OPT03 OF THE FILE TO NON EXCLUSIVE OPEN JMP OP03 * NOX3 CLA,INA SET FOR EXCLUSIVE OPEN STA OPT03 CLA STA DTBFR+9 SET DCB IN NON OPEN STATUS * OP03 JSB OPEN DEF *+7 DEF DTBFR WE WILL NOT NEED THE DCB DEF IERR1 DEF RQB+#DCB FILE NAME DEF OPT03 OPTION DEF RQB+#ISC ISECU DEF RQB+#ICR ICR * BAD03 LDA DM8 GET THE ERROR CODE STA IERR SET IT IN THE REPLY * LDA CRFAD GET ADDRESS OF CURRENT RFAMD ENTRY JSB DELET DELETE IT JMP BRN7 SEND THE REPLY SPC 3 PST31 LDA RQB+#ICR GET THE CRN LDB CRFAD GET THE @ OF THE RFAMD ENTRY ADB D5 STEP TO THE ICR STA B,I SET IT JMP INDX DO THE INDEX THING SPC 3 * * POST PROCESS FOR FLUSH * PST08 LDA TMPNX GET THE # OF FLUSHED ENTRIES STA IERR SET AS COMPLETION CODE LDA CRFAD DELETE THE LAST ENTRY JSB DELET JMP BRN7 SEND THE REPLY SPC 3 * * THIS WILL SET THE RFAMD ENTRY NUMBER IN THE REQUEST * INDX LDA IERR GET THE ERROR RETURN FROM FMP SSA,RSS ANY ERROR ? JMP INDX1 NO LDA CRFAD ERROR, DELETE THE ENTRY. JSB DELET JMP BRN7 INDX1 LDA CRFAD GET ADDRESS OF THE CURRENT RFAMD ENTRY JSB FNDX CALCULATE IT'S NUMBER STA RQB+#RFD SAVE SPC 3 BRN7 CLB SET FOR NO DATA RETURNED * PST01 LDA #NODE GET LOCAL NODE # STA RQB+#ENO SET AS THE ERROR LOCATION STB LENGT SET DATA LENGTH LDA IERR SET THE COMPLETION CODE STA RQB+#EC2 IN THE REQST BUFR * PST1A LDA FCODE GET THE ICODE ADA LNTBL INDEX IN THE REPLY LENGTH TABLE LDA A,I GET THE LENGTH STA PRMBL SET THE LENGTH * * THE REPLY BUFFER IS READY, SEND IT BACK * JSB #SLAV DEF *+4 DEF PRMBL REQST BUFR LENGTH DEF DTBFR DATA BUFFER DEF LENGT DATA BUFFER LENGTH * NOP IGNORE THE ERROR RETURN FROM #SLAV * * IF THE OPERATION WAS A DCLOS OR DXCLO, AND IT WORKED * PROPERLY, WE HAVE TO DELETE THE RFAMD ENTRY. * LDA FCODE GET OPCODE FOR THE LAST TIME CPA D1 DCLOS ? JMP CLOS YES UNL IFN * START EXTENDED FILE CODE LST CPA DXCLO DXCLO? JMP CLOS YES UNL XIF * END EXTENDED FILE CODE LST JMP PST06 * * CLOS LDA IERR GET COMPLETION CODE SSA ERROR ? JMP PST06 YES, DO NOT DELETE THE ENTRY LDA CRFAD GET ADDRESS OF ENTRY JSB DELET GO DELETE IT AND ITS DCB * PST06 LDA C#RLW GET A COUNTER CMA,INA STA CNTR1 LDA RQBA GET ADR OF REQST BUFR CLB GET A 0 PST07 STB A,I CLEAN REQ-REPLY AREA INA ISZ CNTR1 JMP PST07 CONTINUE JMP GO GET NEXT REQUEST. SPC 3 HED RFAM: UTILITY ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * THIS ROUTINE WILL PICK UP THE FILE NAME AND THE CARTRIDGE * NUMBER FROM THE REQST BUFR AND SET THEM FOR THE CALL TO SEARCH. * * IF AN LU IS PASSED INSTEAD OF THE CARTRIDGE #, THIS IS * CONVERTED TO THE CR #, WHICH IS ALSO SAVED IN RQB+8. * SINCE THIS ROUTINE IS CALLED JUST BEFORE A SEARCH, WE * ALSO SET THE SEARCH POINTER TO THE FIRST WORD OF THE * RFAMD TABLE. * BRN84 NOP LDA RQB+#ICR GET THE ICR PARAMETER SZA,RSS PRESENT ? JMP DEFLT NO, DEFAULT CLB STB DFLFL SET THE DEFAULT FLAG SSA LU ? JSB LUCR YES JMP OK84 NO, CRN * * WE WANT TO FIND ON WHICH LU OUR FILE IS. WE WILL * DO AN EXCLUSIVE OPEN ON THIS FILE AND LOOK IN THE * DCB. * WE COME HERE ONLY ON A DNAME OR A DPURG * DEFLT CCB STB DFLFL SET THE DEFAULT FLAG CLB STB DTBFSCR+9 * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB OPEN DEF *+6 DEF DTBFR SEND THE DCB INTO THE DATA AREA DEF IERR1 DEF RQB+#DCB FILE NAME DEF D0 EXCLUSIVE OPEN DEF RQB+#ISC ISECU * STA TEMP SAVE JSB DTACH DETACH FROM SESSION CONTROL BLOCK DEF *+1 * LDA TEMP RESTORE SSA SUCCESFUL OPEN ? JMP FMERR DONT GO ANY FURTHER LDA DTBFR GET 1ST WORD OF DCB AND B77 GET THE LU CMA,INA STA RQB+#ICR SET IT INTO REQST BUFR JSB LUCR CONVERT TO CRN * OK84 LDA NAMA GET ADDRESS OF FILE NAME LDB FNAMA JSB .MVW SET THE FILE NAME FOR THE SEARCH DEF D4 NOP LDA FIRST WE ALSO SET THE SEARCH POINTER STA PNTR1 TO THE BEGINNING OF THE TABLE * JMP BRN84,I SPC 3 * * THIS ROUTINE WILL TRANSFORM A NEGATIVE DISC LU * INTO A CARTRIDGE NUMBER. BOTH INPUT AND RESULTS * ARE PASSED VIA RQB+#ICR. THE RESULT WILL ALSO BE * FOUND IN B REGISTER. IF AN ERROR IS DISCOVERED * WE WILL DIRECTLY JUMP TO THE ERROR ROUTINE. * LUCR NOP LDA RQB+#ICR GET LU/CR CPA MAGLU RTE-M "MAGIC-LU" CODE? JMP LUCR,I YES, JUST RETURN SSA,RSS LU? JMP LUCR1 NO CMA,INA YES, MAKE IT POSITIVE AND STA DTBFR SET UP STATUS CALL. * JSB EXEC GET EQUIPMENT-TYPE CODE DEF *+4 DEF D13I DEF DTBFR USE DTBFR FOR CONWD DEF DTBFR+1 AND EQT5. JMP ERR06 ILLEGAL LU * LDA DTBFR+1 GET EQT5 ALF,ALF AND B77 ISOLATG&E EQUIP-TYPE CODE LDB RQB+#ICR IF DVR05 (CTU SYSTEM), CPA D5 RETURN WITH JMP LUCR,I B = -LU. * LUCR1 EQU * LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND B377 ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB FSTAT GET INFO ON THE CURRENTLY DEF FRTRN MOUNTED CARTRIDGES. DBFAD DEF DTBFR SEND THE INFO TO THE DATA BUFFER UNL IFN * START EXTENDED FILE CODE LST DEF D253 MAX BUFFER LENGTH UNL XIF * END EXTENDED FILE CODE LST * FRTRN EQU * JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 * LDA DBFAD DCB BUFFER ADDR LP84 LDB 0,I GET W1 OF ENTRY CMB,INB CPB RQB+#ICR IS IT OUR LU? JMP FND84 YES SZB,RSS END OF TABLE ? JMP ERR06 YES, ILLEGAL DISC LU ADA D4 PUSH THE ADDR TO THE NEXT ENTRY JMP LP84 CONTINUE * FND84 ADA D2 STEP TO THE CRN LDB 0,I GET IT STB RQB+#ICR SET IT IN REQST BUFR JMP LUCR,I SPC 3 * * ROUTINE TO DELETE AN ENTRY FORM THE RFAMD TABLE AND * TO LINK ITS DCB BACK INTO THE FREE LIST. * WHEN A CALL IS MADE TO THIS ROUTINE, A REGISTER * SHOULD CONTAIN THE POINTER TO THE ENTRY TO BE DELETED. * THE ID SEGMENT ADDRESS ( WORD 6 ) IS SET TO ZERO AS * A PROTECTION AGAINST PROGRAMS WHICH TRY TO ACCESS A * FILE AFTER HAVING CLOSED IT. AFTER THIS PRECAUTION * IS TAKEN, ANY ATEMPT TO ACCESS THIS ENTRY WILL BE * REJECTED AS AN ERROR -26. * DELET NOP STA DELAD SAVE ENTRY ADDRESS ADA D6 STEP TO THE ID SEG @ CLB ZERO THIS WORD STB A,I ADA D2 STEP TO THE DCB POINTER. LDA A,I GET THE ADDRESS SZA,RSS DCB IN CORE NOW ? JMP DELT1 NO, DONT WORRY ABOUT THE DCB * LDB FCORE GET THE POINTER TO THE 1ST FREE DCB STB A,I SET IT AS NEXT TO CURRENT DCB STA FCORE SET CURRENT DCB AS 1ST FREE DCB. * LDA LAST WAS IT THE CPA DELAD LAST DCB IN CORE ? INA,RSS YES JMP DELT1 NO LDA A,I STA LAST RESTORE "LAST" * DELT1 LDA DELAD JSB COUT REMOVE RFAMD ENTRY FROM IS LIST * * NOW INSERT IT IN THE FREE RFAMD LIST. * LDB BFREE GET ADDRESS OF 1ST FREE ENTRY STB DELAD,I SET AS NEXT TO CURRENT LDA DELAD GET ADDRESS OF CURRENT STA BFREE SET AS FIRST IN FREE LIST * JMP DELET,I ALL DONE, RETURN. SPC 3 * * THIS ROUTINE REMOVES AN ENTRY FROM THE RFAMD LIST AND * RESTORES THE LINKS AROUND IT. THE ADDRESS OF THE ENTRY * TO BE REMOVED IS PASSED IN A REG. THIS ROUTINE INCLUDES * PROTECTION FOR REMOVAL OF FIRST OR LAST ENTRY AND * CHANGE OF "FIRST" IF 1ST ENTRY IS REMOVED. * COUT NOP STA DELAD INA STEP TO PREVIOUS LDA A,I GET PREV(DELAD) LDB DELAD,I GET NEXT(DELAD) INB STEP TO PREV(NEXT(DELAD)) STA B,I PREV(NEXT(DELAD)) <= PREV(DELAD) LDB DELAD,I GET NEXT(DELAD) SZA,RSS ANY PREV ? STB FIRST NO, FIRST <= NEXT(DELAD) STB A,I NEXT(PREV(DELAD)) <= NEXT(DELAD) JMP COUT,I RETURN SPC 3 * * THIS ROUTINE WILL INSERT AN RFAMD ENTRY BEFORE THE ENTRY POINTED * AT BY PNTR1, THE ADDRESS OF THE ENTRY TO BE INSERTED IS IN CRFAD. * PNTR1 SHOULD NOT BE = 0. THIS ROUTINE WILL TAKE CARE OF THE * CASE WHERE PNTR1 POINTS TO THE FIRST ENTRY. * INSRT NOP STA PNTR1 SAVE ADDRESS OF ENTRY CPA CRFAD ALREADY IN PLACE ? JMP INSRT,I YES  INA STEP TO PREVIOUS LDA A,I GET ADDRESS OF PREVIOUS. LDB CRFAD INB STA B,I PREV(CRFAD)<=PREV(PNTR1) LDB CRFAD SZA DOES PNTR1 POINT TO THE 1ST ENTRY ? STB A,I NO, NEXT(PREV(PNTR1))<=CRFAD LDA PNTR1 STA B,I NEXT(CRFAD)<=PNTR1 INA STB A,I PREV(PNTR1)<=CRFAD LDA 1 RETURN CRFAD IN A * JMP INSRT,I RETURN SPC 3 * * THIS ROUTINE WILL CALCULATE AN RFAMD ENTRY #. * THE ADDRESS OF THE ENTRY IS PASSED IN THE A REGISTER. * THE RESULT IS RETURNED IN A REGISTER. * IS A TABLE DISCREPENCY IS DETECTED, WE JUMP TO * THE PROPER ERROR ROUTINE (-29) * FNDX NOP STA TMPNX SAVE THE ADDRESS CLB CMA,INA ADA END SSA IS THE ENTRY IN PART 1 ? JMP INDX2 NO LDA START YES (A>0) JMP INDX3 * INDX2 LDA XSTRT GET ADDRESS OF FWA 2ND PART LDB ENT#1 GET # ENTRIES IN 1ST PART INDX3 STB ENTN INITIALIZE THE NUMBER OF ENTRIES CMA,INA ADA TMPNX FIND THE DISTANCE FROM FIRST WORD DIV D9 DIVIDE BY LENGTH OF ENTRY SZB THIS IS TO TEST THE VALIDITY OF CRFAD JMP ERR29 NO GOOD !!! ADA ENTN ADD TO DISPLACEMENT JMP FNDX,I RETURN SPC 3 * * THIS ROUTINE CALCULATES THE DISC ADDRESS OF A DCB * AND STORES IT IN CTRK AND CSCT (RESPECTIVELY TRACK * AND SECTOR). UPON ENTRY TO THIS ROUTINE, A CONTAINS * THE NUMBER OF THE MATCHING RFAMD ENTRY. * CALDS NOP CLB DIV DCBTR DIVIDE BY THE NUMBER OF DCB'S PER TRACK ADA ISTRK ADD THE # OF THE 1ST TRK STA CTRK SAVE THE TRACK NUMBER LDA B MPY D3 STA CSCT SAVE THE SECTOR # * JMP CALDS,I RETURN SPC 3 * * CALLING SEQUNCE : JSB BRN41 * * * BRN41 NOP JSB BRN84 SET UP THE PARAMETERS FOR THE SCAN. BRN4L JSB SERCH SCAN THE LIST. JMP BRN41,I UNSUCCESFUL SEARCH => OK. * JSB US? JMP NOTUS THIS IS NOT OUR ENTRY * * SINCE THIS FILE IS ALREADY OPENED TO US AND WE TRY * TO OPEN IT AGAIN, WE WILL ACT AS THE FMP: DELETE * CURRENT ENTRY AND REOPEN THE FILE (IF POSSIBLE). * LDB PNTR1,I GET NEXT TO CURRENT STB PNTR1 UPDATE THE POINTER FOR THE REST OFTHE SCAN JSB DELET GO DELETE THIS ENTRY JMP BRN4L CONTINUE THE SCAN. * NOTUS SSB SIGN BIT SET ? (I.E. EXCLUSIVE OPEN) JMP ERR41 YES, FORGET ABOUT OPENING THIS ONE. * * THE FILE HAS BEEN FOUND TO BE OPEN, BUT NOT EXCLUSIVELY * ARE WE TRYING TO OPEN IT EXCLUSIVELY ? * LDA RQB+#IOP GET OUR OPEN OPTION SLA,RSS BIT 1 SET ? JMP ERR41 NO, REJECT. LDA PNTR1,I GET NEXT TO CURRENT. STA PNTR1 RESET SEARCH POINTER. JMP BRN4L CONTINUE THE SCAN. * ERR41 ISZ BRN41 SET FOR BAD RETURN JMP BRN41,I SPC 3 * * THIS ROUTINE WILL DO THE SPECIAL SEARCH FOR * THE FLUSH PREPROCESSOR * BRN62 NOP JSB SERCH JMP BRN62,I UNSUCCESSFUL RETURN LDB RQB+#NOD GET THE OWNER'S NODE CPB DM1 FLUSH ALL ? JMP BRN63 YES LDA PNTR1 GET ENTRY ADDRESS ADA D7 STEP TO THE NODE # LDA A,I GET IT ELA,CLE,ERA STRIP THE SIGN BIT CPA RQB+#NOD DESIRED NODE ? JMP BRN63 YES LDA PNTR1 STA FLFLG SET THE FLUSH FLAG FOR "NO CLOSE" LDA PNTR1,I NO, CONTINUE THE SEARCH STA PNTR1 JMP BRN62+1 * BRN63 ISZ BRN62 SET FOR OK RETURN JMP BRN62,I RETURN SPC 3 * * THIS ROUTINE WILL SEARCH THE RFAMD TABLE FOR AN ENTRY * WITH A CERTAIN FILE NAME AND CARTRIDGE NUMBER. * CALL: PNTR1 SHOULD CONTAIN THE ADDRESS OF THE FIRST * ENTRY TO BE LOOKED AT. * FNAME SHOULD CONTAIN THE FILE NAME AND THE * CARTRIDGE NUMBER (TOTAL 4 WORDS) * RETURN: PNTR1=0 => UNSUCCESSFUL SEARCH RETURN AT * JSB + 1 * PNTR1#0 => SUCCESSFUL SEARCH, RETURN AT JSB+2, PNTR1 * CONTAINS THE ADDRESS OF THE MATCHING ENTRY. * SERCH NOP LDB PNTR1 GET ADDRESS OF 1ST ENTRY. JMP SRC1 GO CHECK FOR END OF LIST * SRCLP ADB D2 STEP TO THE 1ST NAME WORD LDA FNAMA JSB .CMW COMPARE DEF D4 NOP JMP SRC3 SUCCESSFUL SEARCH NOP LDB PNTR1,I GET ADDRESS OF NEXT ENTRY STB PNTR1 RESET RUNNING POINTER SRC1 SZB END OF LIST ? JMP SRCLP NO, CONTINUE THE SEARCH JMP SERCH,I YES, UNSUCCESSFUL SEARCH SRC3 ISZ SERCH SET SUCCESSFUL RETURN JMP SERCH,I RETURN SPC 3 * * THIS ROUTINE WILL PICK UP THE RFAMD ENTRY # IN RQB+#DCB+1. * IT WILL CHECK FOR BOUNDS AND FOR THE OWNER ID. * IF ALL IS OK, RETURN AT JSB+1 WITH A REGISTER POINTING * TO THE ENTRY. ELSE RETURN AT ERR26. * ENTCK NOP LDA RQB+#DCB+1 GET ENTRY # SSA POSITIVE ? JMP ERR26 NO, ILLEGAL. CMA ADA ENT#T COMPARE WITH TOTAL # OF ENTRIES SSA JMP ERR26 ENT#>TOTAL # ENTRIES LDB START GET ADDRESS OF 1ST ENTRY IN LINEAR ORDER LDA ENT#1 GET # ENTRIES IN 1ST PART CMA,INA ADA RQB+#DCB+1 ADD ENTRY CURRENT ENTRY NUMBER SSA,RSS IS ENTRY IN 1ST PART ? LDB XSTRT NO, RESET START ADDRESS STB TSTRT SAVE LDA RQB+#DCB+1 MPY D9 * ENTRY # IN ITS PART BY THE ENTRY LENGTH ADA TSTRT ADD TO START. * * NOW, A CONTAINS A POINTER TO THE CURRENT ENTRY * LDB A ADB D6 STEP TO OWNER'S ID LDB B,I GET aIT CPB RQB+#DCB DOES IT MATCH ? SZB,RSS YES, MAKE SURE IT'S NOT ZERO JMP ERR26 NO, THIS IS NOT US LDB A ADB D7 STEP TO THE NODE# LDB B,I GET IT ELB,CLE,ERB STRIP SIGN BIT OFF CPB RQB+#SRC DOES IT MATCH CURRENT REQUESTER'S NODE #? JMP ENTCK,I YES JMP ERR26 NO, INTRUDER SPC 3 * * THIS ROUTINE WILL COMPARE THE OWNER ID PART OF AN * RFAMD ENTRY WITH THE OWNER ID OF THE CURRENT REQUEST. * CALLING SEQUENCE: * JSB US? * "PNTR1" IS IN A * RFAMD "NODE" IS IN B * US? NOP LDA PNTR1 LDB A ADB D6 STEP TO OWNER'S ID LDB B,I GET IT CPB RQB+#ID DOES IT MATCH ? RSS JMP US?NO NO, THIS IS NOT US LDB A ADB D7 STEP TO THE NODE# LDB B,I GET IT ELB,CLE,ERB STRIP SIGN BIT OFF CPB RQB+#SRC DOES IT MATCH CURRENT REQUESTER'S NODE #? ISZ US? YES, SET FOR OK RETURN US?NO LDB 0 ADB D7 ADDR OF RFAMD: 8TH WORD LDB 1,I GET IT (NODE) JMP US?,I RETURN SPC 3 * * THIS ROUTINE FILLS THE END OF THE CALL BUFFER WITH 0'S * THIS ROUTINE IS CALLED WITH B CONTAINING THE * ADDRESS OF THE 1ST WORD TO BE NOPED. * NOPS NOP CLA NOPS1 STA B,I INB CPB RTN END ? JMP NOPS,I YES JMP NOPS1 NO SPC 3 * * THIS IS THE SKELETON OF THE FMP CALL * PARAM DEF PRAM1 * CALL LDA RQB+#SID GET SESSION ID WORD FROM REQST AND B377 ISOLATE DEST. SESSION ID STA TEMP SESSION CONTROL BLOCK * JSB #ATCH DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB CALLI,I CALL FMP ROUTINE RTNAD NOP DEF RTRN LDCB NOP ADDRESS OF DCB IKmF ANY DEF IERR ERROR PRAM1 REP 8 1ST 'CALL' PARAM NOP * DONE JSB DTACH DETACH FROM SESS. CONTROL BLOCK DEF *+1 * LDA IERR GET RETURNED ERROR CODE SSA,RSS DID FMP DETECT AN ERROR? JMP NOERR NO LDA "FM" YES, INDICATE AN FMP-DETECTED ERROR STA #RPB+#EC1 IN THE REPLY. NOERR LDA FCODE GET FCODE ADA PSTBL MAP IN THE POST PROCESSING TABLE JMP A,I * "FM" ASC 1,FM * * CALLI NOP ADR OF FMP CALL RTN DEF DONE * * RSERR LDA "RS" RETURN SPECIAL ASCII STA #RPB+#EC1 REMOTE SESSION MONITOR LDA "01" ERROR CODE "RS01". STA #RPB+#EC2 LDA BIT15 SET SIGN BIT IN IERR TO SIMULATE STA IERR NEG ERROR CODE FOR 'CLOS'. IOR #NODE SET LOCAL NODE # AND ASCII-ERROR STA #RPB+#ENO BIT INTO REPLY. CLA SET DATA LENGTH FOR STA LENGT CALL TO #SLAV. JMP PST1A GO SEND REPLY * * "RS" ASC 1,RS "01" ASC 1,01 HED RFAM: ERROR HANDLING * (C) HEWLETT-PACKARD CO. 1980 ERR06 LDA DM6 JMP FMERR ERR11 LDA DM11 JMP FMERR ERR08 LDA DM8 JMP FMERR ERR25 EQU * INVALID FCODE. SET TO ZERO TO CLA INSURE VALID INDEX INTO REPLY STA FCODE LENGTH TABLE LATER. LDA DM25 JMP ERRXX ERR26 LDA DM26 JMP ERRXX ERR28 LDA DM28 JMP ERRXX DSCER CCA,RSS ERR29 LDA DM29 * ERRXX EQU * LDB "DS" * * HERE WITH = ERROR CODE, = "FM" OR "DS" * ERRYY EQU * STA IERR SET THE ERROR CODE IN THE REPLY STB #RPB+#EC1 SAVE CATEGORY OF ERROR JMP BRN7 GO SHIP THE REPLY * FMERR EQU * HERE TO REPORT "FMP" ERRORS LDB "FM" JMP ERRYY "DS" ASC 1,DS SPC 3 HED RFAM: CONSTANTS * (C) HEWLETT-PACKARD CO. 1980 A EQU 0 B EQU 1 UNL IFN * START EXTENDED FILE CODE +LST B13 OCT 13 MDXLO EQU B13 DXLOC REPLY PARAM MASK UNL XIF * END EXTENDED FILE CODE LST DM29 DEC -29 DM28 DEC -28 DM26 DEC -26 DM25 DEC -25 * UBFCN EQU * -(UPPER BOUND +1) OF FUNCTION CODES UNL IFN * START EXTENDED FILE CODE LST DEC -21 UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST DEC -14 UNL XIF * END NON-EXTENDED FILE CODE LST * DM11 DEC -11 DM9 DEC -9 DM8 DEC -8 DM7 DEC -7 DM6 DEC -6 DM1 DEC -1 D0 DEC 0 D1 DEC 1 D1I OCT 100001 D2 DEC 2 D2I OCT 100002 D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D7 DEC 7 D8 DEC 8 D9 DEC 9 D12 DEC 12 D13I OCT 100015 D14 DEC 14 D99 DEC 99 D125 DEC 125 D144 DEC 144 D512 DEC 512 DPURG EQU D8 FCODE FOR DPURG UNL IFN * START EXTENDED FILE CODE LST D15 DEC 15 D253 DEC 253 * MDXCL EQU D1 DXCLO PARAM MASK MDXAP EQU D3 DXAPO PARAM MASK MDXP0 EQU D1 DXPOS PARAM MASK MDXWR EQU D2 DXWRI PARAM MASK DXCRE EQU D14 DXCRE FUNCTION CODE DXCLO EQU D15 DXCLO FUNCTION CODE UNL XIF * END EXTENDED FILE CODE LST XEQT EQU 1717B BGLWA EQU 1777B SECT2 EQU 1757B B77 OCT 77 B377 OCT 377 MAGLU OCT 177400 1ST DCB ENTRY FOR "M" MAGIC LU'S START NOP ADDRESS OF LINEAR 1ST RFAMD ENTRY FIRST NOP HEAD POINTER OF THE RFAMD LIST LAST NOP POINTER TO THE LAST DCB-IN-CORE RFAMD * ENTRY BFREE NOP HEAD POINTER OF THE RFAMD FREE LIST FCORE NOP HEAD POINTER OF THE DCB FREE LIST XSTRT NOP ENT#1 NOP NUMBER OF RFAMD ENTRIES IN PART 1 ENT#T NOP NUMBER OF RFAMD ENTRIES (TOTAL) ISTRK NOP ADDRESS OF DISC TRACKS  CONTAINING IDISC NOP THE DCB'S DCBTR NOP NUMBER OF DCB'S PER TRACK FCODE NOP FUNCTION CODE LENA DEF LEN FNAMA DEF FNAME CRA DEF RQB+#ICR @ OF THE ICR SECUA DEF RQB+#ISC @ OF ISECU RFMDA DEF RFAMD C#DCB ABS #DCB C#1ST ABS #DCB+3 1ST RQST PARAM OFFSET C#ICR EQU C#1ST C#REC ABS #REC C#IL ABS #IL C#NUM ABS #NUM #DCBA DEF RQB+#DCB NAMA EQU #DCBA #SIZA DEF RQB+#SIZ #TYPA DEF RQB+#TYP UNL IFN * START EXTENDED FILE CODE LST #XTYA DEF RQB+#XTY UNL XIF * END EXTENDED FILE CODE LST HED RFAM: VARIABLES * (C) HEWLETT-PACKARD CO. 1980 PNTR1 NOP CNTR1 NOP TMP1 NOP CTRK NOP CSCT NOP TSTRT NOP FNAME BSS 4 IERR1 NOP LENGT NOP CRFAD NOP ADDRESS OF CURRENT RFAMD ENTRY LEN NOP ENTN NOP OPT03 NOP PRMBL NOP DFLFL NOP IERR NOP TMPAD NOP DELAD NOP RQLN NOP REQUEST LENGTH TMPNX NOP FLFLG NOP SWNX NOP HED RFAM: TABLES * (C) HEWLETT-PACKARD CO. 1980 BRNCH DEF *+1,I DEF BRN1 DAPOS DEF BRN2 DCLOS DEF BRN1 DCONT DEF BRN3 DCRET DEF BRN1 DLOCF DEF BRN8 DNAME DEF BRN4 DOPEN DEF BRN1 DPOSN DEF BRN8 DPURG DEF BRN1 DREAD DEF BRN10 DSTAT DEF BRN1 DWIND DEF BRN1 DWRIT DEF BRN6 FLUSH UNL IFN * START EXTENDED FILE CODE LST DEF BRN3 DXCRE DEF BRN2 DXCLO DEF BRN1 DXREA DEF BRN1 DXWRI DEF BRN1 DXAPO DEF BRN1 DXPOS DEF BRN1 DXLOC UNL XIF * END EXTENDED FILE CODE LST * JSBTB DEF *+1 DEF APOSN DEF CLOSE DEF FCONT DEF CREAT DEF LOCF DEF NAMF DEF OPEN DEF POSNT DEF PURGE DEF READF NOP DEF RWNDF UoDEF WRITF DEF CLOSE FLUSH UNL IFN * START EXTENDED FILE CODE LST DEF ECREA DEF ECLOS DEF EREAD DEF EWRIT DEF EAPOS DEF EPOSN DEF ELOCF UNL XIF * END EXTENDED FILE CODE LST * BLDTB DEF *+1,I CALL BUILDING TABLE DEF BLD0 DAPOS DEF BLD0 DCLOS DEF BLD0 DCONT DEF BLD3 DCRET DEF BLD4 DLOCF DEF BLD5 DNAME DEF BLD6 DOPEN DEF BLD0 DPOSN DEF BLD8 DPURG DEF BLD9 DREAD NOP DEF BLD0 DWIND DEF BLD12 DWRIT DEF BLD0 FLUSH UNL IFN * START EXTENDED FILE CODE LST DEF BLD3 DXCRE DEF BLD15 DXCLO DEF BLD9 DXREA DEF BLD17 DXWRI DEF BLD18 DXAPO DEF BLD19 DXPOS DEF BLD20 DXLOC UNL XIF * END EXTENDED FILE CODE LST * SPC 3 LNTBL DEF *+1 REPLY LENGTH TABLE ABS #REP DAPOS ABS #REP DCLOS ABS #REP DCONT ABS #RFD+1 DCRET ABS #JRC+1 DLOCF ABS #REP DNAME ABS #RFD+1 DOPEN ABS #REP DPOSN ABS #REP DPURG ABS #LOG+1 DREAD ABS #REP DSTAT ABS #REP DWIND ABS #REP DWRIT ABS #REP FLUSH UNL IFN * START EXTENDED FILE CODE LST ABS #JSZ+2 DXCRE ABS #REP DXCLO ABS #LOG+2 DXREA ABS #REP DXWRI ABS #REP DXAPO ABS #REP DXPOS ABS #XJR+1 DXLOC UNL XIF * END EXTENDED FILE CODE LST SPC 3 PSTBL DEF *+1,I POST PROCESSING TABLE DEF BRN7 DAPOS DEF BRN7 DCLOS DEF BRN7 DCONT DEF PST04 DCRET DEF րBRN7 DLOCF DEF PST05 DNAME DEF PST03 DOPEN DEF BRN7 DPOSN DEF PST05 DPURG DEF PST02 DREAD NOP DEF BRN7 DWIND DEF BRN7 DWRIT DEF PST08 FLUSH UNL IFN * START EXTENDED FILE CODE LST DEF PST04 DXCRE DEF BRN7 DXCLO DEF PST02 DXREA DEF BRN7 DXWRI DEF BRN7 DXAPO DEF BRN7 DXPOS DEF BRN7 DXLOC UNL XIF * END EXTENDED FILE CODE LST HED RFAM: BUFFERS * (C) HEWLET-PACKARD CO. 1980 * C#RLW ABS #RLW MAX LEN OF REQ/REPLY BUFFER. * * DTBFR BSS 512 . EQU * ORG DTBFR MS1 ASC 17,RFAM: LIMITED BUFFER SPACE, THE NU ASC 19,MBER OF FILES HAS BEEN LIMITED TO MS1A DEF *-2 MS2 ASC 17,RFAM: LIMITED DISC SPACE, THE NUMB ASC 19,ER OF FILES HAS BEEN LIMITED TO MS2A DEF *-2 BSS 8 FILLER HED RFAM: INITIALIZATION * (C) HEWLETT-PACKARD CO. 1980 * * THIS PART IS THE INITIALIZATION. ALL CODE IN THIS * SECTION MUST LIE WITHIN THE DATA BUFFER AREA 'DTBFR', * AND WILL BE OVERLAYED WITH DATA LATER. IT MUST NOT * EXCEED THE 'DTBFR' AREA SINCE THE RFAMD AND IN-CORE * DCB'S FOLLOW IMMEDIATELY AFTER. IF EXCEEDED, THE * 'EQU' AT 'CHECK' SHOULD GIVE AN ASSEMBLY ERROR. * * THE INITIALIZATION WORKS AS FOLLOWS: * 1) FIND HOW MUCH ROOM WE HAVE IN THE PROGRAM * ITSELF AND AFTER THE PROGRAM, IN ITS PARTITION * 2) LINK THE RFAMD TABLE, RESERVING AS MANY * ENTRIES AS REQUIRED IN THE CALL FROM LSTEN * 3) DEPENDING ON THE ROOM LEFT, REQUIRE DISC TRACKS * FOR THE DISC RESIDENT DCB'S. * 4) LINK THE IN-CORE DCB LIST. * * * * DESCRIPTION OF AN RFAMD ENTRY * * 1) RFAMD ENTRY IN THE ACTIVE LIST (I.E. CURRENTLY USED) * W0 POINTER TO NEXT ENTRY * W1 POINTER TO PREVIOUS ENTRY * W2-W4 FILE NAME. * W5 CARTRIDGE NUMBER * W6 ID SEGMENT ADDRESS ! FILE "OWNER" * W7 NODE NUMBER. BIT 15! IDENTIFICATION * SET INDICATES AN * EXCLUSIVE OPEN * W8 DCB POINTER. THIS WORD IS EQUAL TO 0 IF THE * DCB IS CURRENTLY DISC RESIDENT. IT IS EQUAL * TO THE ADDRESS OF THE DCB IF THE DCB IS IN * CORE. * * 2) RFAMD ENTRY IN THE FREE LIST (I.E. NOT CURRENTLY USED) * W0 POINTER TO THE NEXT ENTRY * W1-W9 DONT CARE * * * DESCRIPTION OF A DCB ENTRY * * * 1) DCB IN THE ACTIVE LIST * W0-W143 144 WORD DCB * * 2) DCB IN THE FREE LIST * W0 POINTER TO THE NEXT FREE DCB SPACE * W1-W143 DONT CARE * * * IN ALL FOUR THREADED LISTS OF THIS PROGRAM, THE END * OF LIST MARKER IS A NULL (0) POINTER TO THE NEXT ENTRY. * * FOR THE DESCRIPTION OF THE HEAD OF LIST POINTERS, REFER * TO THE "CONSTANTS" SECTION IN THE PERMANENT PART OF THIS * PROGRAM. * SPC 3 INIT JSB DTACH (IN CASE 'DINIT' RUN FROM SESSION) DEF *+1 * JSB EXEC SWAP CONTROL DEF *+3 DEF D22 SWAP ALL PARTITION DEF D3 * JSB .DRCT GET & SAVE DIRECT DEF RQB ADDRESS OF EXTERNAL STA RQBA REQ/RPY BUFFER . * * LDA XEQT GET OUR ID SEG ADR ADA D14 POINT TO WORD 15 ('TYPE') LDA A,I GET IT AND B7 ISOLATE 'TYPE' MODULO 8 CLB CPA D1 ARE WE MEMORY RESIDENT? INB YES, SO NO DCB'S IN EXTENSION STB FLG1 SET EXTENSION FLAG * LDA XEQT GET OUR PCURRENT ID SEGMENT ADDRESS ADA D23 POINT TO HI MAIN ADDR + 1 LDA 0,I GET IT STA XSTRT SAVE (XTENTION START) * LDA FLG1 GET EXTENSION FLAG SZA CAN WE HAVE DCB'S IN EXTENSION? JMP INIT4 NO LDA XSTRT YES, SO MAY BE ROOM FOR CMA,INA SOME DCB'S. ADA BGLWA CALCULATE ROOM AVAILABLE IN EXTENSION ADA DM143 FIND IF THERE IS ENOUGH CLB ROOM IN THE EXTENSION FOR AT SSA LEAST ONE DCB. INB NO, CAN'T HAVE DCB'S IN EXTENSION STB FLG1 SET A FLAG TO INDICATE THIS * * LDB #RFSZ GET THE # OF FILES REQUESTED STB RFSZ SZB TEST FOR <=0 SSB "NO SWAP" REQUEST ? JMP NOSWP YES * INIT4 CLA INITIALIZE # RFAMD ENTRIES STA ENT#1 STA ENT#T * * LINK THE FREE RFAMD LIST * THE HEAD POINTERS ARE: * BFREE (FREE LIST) * FIRST (CURRENT LIST) * LAST (LAST ENTRY REFERING TO AN IN-CORE DCB) * START (ADDRESS OF THE FIRST RFAMD ENTRY IN * LINEAR ORDER) * LDA RFSZ GET THE # OF ENTRIES REQUESTED CMA,INA STA CNTR1 USE AS COUNTER * * THE RUNNING POINTER PNTR1 IS ALREADY INITIALIZED * LDA RFMDA GET ADDRESS OF TABLE START STA START STA BFREE STA PNTR1 SET ALL POINTERS * LOOP1 LDB FLG1 GET THE "SMALL EXTENSION" FLAG SZB,RSS SET ? JMP LOP12 NO, NO PROBLEM ADA D153 SEE IF ENOUGH ROOM LEFT IN THE INTERNAL CMA,INA BUFFER FOR ONE MORE DCB & RFAMD ENTRY ADA END SSA,RSS JMP LOP13 YES, ENOUGH ROOM CLA NO, NOT ENOUGH ROOM LDB PNTR1 ADB DM9 STEP BACK TO LAST ENTRY STA B,I SET IT AS LAST ENTRY OF THE LIST LDA ENT#1 STA ENT#T ,E SET THE TOTAL # OF ENTRIES JMP TREQ GO TAKE CARE OF SWAPPING * LOP12 ADA D17 CMA ADA END COMPARE WITH THE END OF THE 1ST PART SSA WILL THERE BE ENOUGH ROOM FOR THE NEXT * ENTRY? JMP INT01 NO LOP13 LDA PNTR1 YES GET CURRENT POINTER AGAIN ADA D9 GET ADDRESS OF NEXT ENTRY STA PNTR1,I SAVE AS "NEXT" TO CURRENT ENTRY STA PNTR1 PUSH CURRENT POINTER TO NEXT ENTRY ISZ ENT#1 INCREMENT # OF ENTRIES IN 1ST PART * ISZ CNTR1 INCREMENT REQUIRED-ENTRIES COUNTER JMP LOOP1 CONTINUE CLA SET THE END OF LIST MARK LDB PNTR1 ADB DM9 STEP BACK TO THE LAST ENTRY STA B,I LDA ENT#1 GET NUMBER OF ENTRIES IN PART #1 STA ENT#T SAVE AS TOTAL NUMBER OF ENTRIES JMP TREQ NOW GO DO THE TRACK REQUEST IF NECESSARY * SPC 3 * * WE COME HERE IF THERE IS NOT ENOUGH ROOM IN THE FIRST * PART (I.E. INSIDE THE PROGRAM) FOR THE ENTIRE RFAMD TABLE. * INT01 ISZ ENT#1 INC # ENTRIES IN 1ST PART LDB ENT#1 STB ENT#T SET CURRENT TOTAL # ENTRIES ISZ CNTR1 ALL DONE BUT ONE ? RSS NO JMP INT04 YES, SPECIAL CASE LDA XSTRT GET ADDRESS OF THE 1ST WORD OF 2ND PART STA PNTR1,I SAVE AS "NEXT" TO CURRENT ENTRY STA PNTR1 UPDATE RUNNING POINTER TO NEXT ENTRY JMP LOP11 CONTINUE * INT04 CLA SET THE END OF LIST MARK STA PNTR1,I LDA XSTRT STA PNTR1 RESET PNTR1 TO THE SECOND PART JMP TREQ GO REQUEST TRACKS IF NECESSARY SPC 3 LOP11 ADA D153 SEE IF WE HAVE ENOUGH SPACE FOR 1 DCB CMA AND ONE RFAMD ENTRY. ADA BGLWA COMPARE WITH FWA SYSTEM MEMORY. SSA,RSS ENOUGH ROOM ? JMP LOP21 YES CLA NO, TERMINATE THE LIST LDB PNTR1 STEP BACK ADB )DM9 TO PREVIOUS ENTRY STA B,I MARK IT AS LAST ENTRY ISZ ENT#T JMP TREQ GO TAKE CARE OF THE SWAPPING. * LOP21 LDA PNTR1 GET ADDRESS OF CURRENT ENTRY AGAIN LDB PNTR1 ADA D9 STEP TO NEXT ENTRY STA PNTR1,I SAVE AS "NEXT" TO CURRENT ENTRY STA PNTR1 UPDATE RUNNING POINTER ISZ ENT#T INC THE TOTAL NUMBER OF ENTRIES ISZ CNTR1 ALL DONE ? JMP LOP11 NO, CONTINUE CLA YES, SET THE END OF LIST MARK STA B,I SPC 3 * * BY THE TIME WE COME HERE, THE COMPLETE RFAMD LIST WILL BE * LINKED AS A FREE LIST. PNTR1 NOW POINTS TO THE NEXT * AVAILABLE WORD, I.E. THE 1ST WORD OF THE IN-CORE DCB SPACE. * WE WILL NOW CALCULATE THE NUMBER OF DCB'S WE CAN KEEP IN CORE * AT A TIME AND REQUEST DISC TRACK(S) IF THIS NUMBER IS LESS * THAN THE NUMBER OF RFAMD ENTRIES WE HAVE. * TREQ LDA PNTR1 GET ADDRESS OF NEXT WORD CMA,INA ADA END FIND # OF WORDS IN 1ST PART SSA,RSS JMP INT02 CLA A<0 => NO ROOM IN PART 1 STA PRT1# => NO DCB IN PART 1 LDA PNTR1 JMP INT03 INT02 CLB SET B FOR DIVISION DIV D144 DIVIDE SPACE BY LENGTH OF 1 ENTRY STA PRT1# SAVE THE INTEGER PART AS # DCB IN 1ST PART LDA XSTRT GET ADDRESS OF 1ST WORD OF SECOND PART * * HERE WE LOOK AT PART 2 IN THE SAME FASHION * INT03 CMA,INA ADA BGLWA GET ROOM IN XTENTION(SIGN ALREADY TESTED) CLB SET B FOR DIVISION DIV D144 LDB FLG1 GET EXTENSION FLAG SZB CAN WE HAVE DCB'S IN EXTENSION? CLA NO, SO SET PRT2# TO ZERO STA PRT2# SAVE # DCB'S IN PART 2 ADA PRT1# FIND TOTAL NUMBER OF IN-CORE DCB'S STA TOT# SAVE SPC 3 * * NOW WE DECIDE IF WE NEED ANY DISC SPACE. * LDA ENT#T GET # OF RFAMD ENTRIES CMA,INA Mk ADA TOT# COMPARE TO # OF IN-CORE DCB'S CLB SET FOR NEXT DIVISION SSA,RSS JMP GREAT A=0 OR A>0 * * A>=0 : * I HAVE GOOD NEWS FOR YOU: WE DONT NEED ANY DISC SPACE * THIS ALSO MEANS THAT THERE WILL BE NO DCB SWAPPING * => FASTER FILE ACCESS. GO LINK THE DCB'S * * HERE WE FIND HOW MANY TRACKS WE NEED, AND WE REQUEST * THEM. WE NEED 3 SECTORS (64 WORDS EACH) PER TRACK. * LDA $OPSY FIRST WE BETTER SEE IF RAR,RAR WE EVEN HAVE A SYSTEM DISC. SLA,RSS DO WE? JMP NOSWP NO, WE ARE IN RTE-M * LDA TRK# SEE IF THE TRACKS ARE ALREADY SZA ASSIGNED (SECOND TIME AROUND) JMP GREAT YES THEY ARE * LDA SECT2 GET THE NUMBER OF SECTORS PER TRACK DIV D3 STA DCBTR SAVE THE NUMBER OF DCB'S/TRACK LDA ENT#T GET # OF RFAMD ENTRIES CLB DIV DCBTR DIVIDE BY THE NUMBER OF DCB'S/TRACK SZB INA ROUND TO NEXT TRACK IOR BIT15 SET THE NO WAIT BIT STA TRK# SAVE * * WE SET THE NO-WAIT BIT SINCE IF WE CANT GET THE TRACKS * WE WANT WE WILL TRY TO COMPROMISE. * JSB EXEC DEF *+6 DEF D4 TRACK REQUEST DEF TRK# DEF ISTRK NUMBER OF 1ST TRACK DEF IDISC LU OF DISK DEF ISEC # SECTORS/TRACK (FORGET IT) * CCA GOOD ALLOCATION ? CPA ISTRK RSS JMP GREAT YES, GO LINK THE DCB'S SPC 3 LOWER ADA TRK# TRY TO SETTLE FOR ONE LESS TRACK STA TRK# SZA,RSS IS THIS NO TRACK AT ALL ? JMP NOSWP YES! GO TO THE OPTIMISATION ROUTINE * JSB EXEC DEF *+6 DEF D4 DEF TRK# DEF ISTRK DEF IDISC DEF ISEC * CCA CPA ISTRK HOW WAS THIS ONE ? JMP LOWER BAD, CONTINUE TO REDUCE OUR REQUEST LDA TRK# OK, NOW FIND HOW MANY DCB'S MPY DCBTR WE ARE ALLOWED TO HAVE STA RFSZ JMP INIT4 TRY AGAIN SPC 3 * * WE WILL FIND HERE THE LARGEST POSSIBLE # OF ENTRIES * NOT REQUIRING DCB SWAPPING. * NOSWP LDA FLG1 GET EXTENSION FLAG SZA ARE DCB'S ALLOWED IN EXTENSION? JMP NSWP2 NO, DEFAULT TO MINIMUM LDA XSTRT YES CMA,INA ADA BGLWA FIND SIZE OF INTERNAL BUFFER STA Y LDB RFMDA CMB,INB ADB END FIND THE SIZE OF THE INTERNAL BUFFER STB X ADA B TOTAL SIZE CLB DIV D153 FIND IDEAL NUMBER STA IDEAL SAVE THE RESULT MPY D9 FIND SIZE OF RFAMD IN THIS CONFIGURATION CMA,INA ADA X FIND ROOM LEFT IN 1ST BUFFER AFTER SSA THE IDEAL RFAMD HAS BEEN BUILD.ANY ROOM ? JMP NSWP1 NO * CLB DIV D144 FIND # OF DCB'S THAT WOUD BE ALLOWED TO STA IERR BE IN INTERNAL BUFFER STB IERR1 CLB LDA Y DIV D144 FIND # OF DCB'S IN EXTENSION ADA IERR TOTAL # NSWP4 SZA,RSS NONE ? JMP NSWP2 GO DEFAULT TO MINIMUM * CPA IDEAL JMP NSWP3 IDEAL, DONE LDB A INB CPB IDEAL JMP NSWP3 LDB IERR1 FIND REMAINDER OF PREVIOUS DIVISION ADB DM10 SSB EASY TO IMPROVE ? INA YES JMP NSWP3 DONE * NSWP1 CLB LDA X DIV D9 GET # RFAMD ENTRIES IN 1ST PART CMA,INA ADA IDEAL # ENTRIES IN EXTENSION STA RQLN SAVE TEMPORARILY MPY D9 RFAMD SPACE IN EXTENSION CMA,INA ADA Y DCB SPACE IN EXTENSION CLB DIV D144 # DCB'S IN EXTENSION STA IERR LDA RQLN SZA,RSS 1ST DCB STARTS AT THE BEGINNING OF XTENTION ? LDB D99 YES STB IERR1 LDA IERR RETRIEVE # DCB'S IN EXTENSION = JMP NSWP4 D23 DEC 23 * NSWP2 LDA D2 GET MINIMUM # DCB'S NSWP3 STA RFSZ JMP INIT4 SPC 3 * * HERE WE LINK THE DCB'S AS A FREE LIST * GREAT LDA PNTR1 ADDRESS OF THE FWA STA FCORE SET THE HEAD-OF-THE-FREE-DCB-LIST-POINTER * CLB CPB PRT1# DID WE FIND ROOM IN 1ST PART ? JMP INIT1 NO, => THERE IS ROOM IN PART 2 (ALREADY * TESTED FOR) * INB CPB PRT1# JMP INIT2 CURRENT IS LAST IN PART 1 LDB PRT1# CMB,INB STB CNTR1 SET COUNTER JMP LOOP4 * * IF PNTR1 IS STILL IN THE 1ST PART, WE HAVE TO UPDATE * FCORE AND PNTR1 TO XSTRT. * INIT1 CMA,INA -PNTR1 INA ADA END FIND IF PNTR1 IS IN THE 1ST PART SSA JMP INIT3 A<0 => PNTR1 IN 2ND PART, OK LDA XSTRT GET ADDRESS OF 2ND PART STA FCORE RESET FREE DCB LIST HEAD POINTER STA PNTR1 RESET RUNNING POINTER JMP INIT3 START LINKING * LOOP2 ADA D144 GET ADDRESS OF NEXT DCB STA PNTR1,I SET "NEXT" TO CURRENT STA PNTR1 UPDATE RUNNING POINTER LOOP4 ISZ CNTR1 JMP LOOP2 * INIT2 LDB PRT2# SZB,RSS IS THERE ROOM IN PART 2 ? JMP INIT6 NO, QUIT LDA XSTRT GET ADDRESS OF FWA IN 2ND PART STA PNTR1,I SAVE AS "NEXT" TO CURRENT STA PNTR1 UPDATE RUNNING POINTER * * HERE WE LINK THE 2ND PART OF THE DCB FREE LIST * INIT3 LDA PNTR1 CLB,INB GET A 1 CPB PRT2# ONLY ONE LEFT ? JMP INIT6 YES, TERMINATE * LOOP3 ADA D144 GET THE ADDRESS OF THE NEXT DCB STA PNTR1,I SAVE AS "NEXT" TO CURRENT STA PNTR1 UPDATE RUNNING POINTER INB INC COUNT CPB PRT2# DONE ? RSS YES JMP LOOP3 NO, CONTINUE * INIT6 CLA SET THE END OF LIST MARK STA PNTR1,I * * WE WILL NOW REPORT TO bTHE OPERATOR THE ACTUAL NUMBER * OF FILES IF THIS NUMBER IS NOT WHAT WAS REQUESTED. * WE WILL ALSO GIVE A REASON FOR THE CHANGE. * LDA ENT#T CCE CPA RFSZ JMP INIT7 JSB $LIBR NOP STA #RFSZ RESET #RFSZ FOR LATER RESCHEDULES JSB $CVT3 JSB $LIBX DEF *+1 DEF *+1 INA DLD A,I SET THE # OF FILES IN THE MESSAGE DST MS1A,I JSB EXEC DEF *+5 DEF D2 DISPLAY THE MESSAGE DEF D1 DEF MS1 DEF MSL1 * JMP GO * INIT7 LDA RFSZ CPA #RFSZ CHANGE DUE TO TRACK ALLOCATION PROBLEM ? JMP GO NO CCE JSB $LIBR NOP STA #RFSZ JSB $CVT3 JSB $LIBX DEF *+1 DEF *+1 INA DLD A,I FORMAT THE MESSAGE DST MS2A,I JSB EXEC DEF *+5 DEF D2 DEF D1 DEF MS2 DEF MSL2 * JMP GO PRT1# NOP PRT2# NOP TOT# NOP TRK# NOP ISEC NOP RFSZ NOP * MSL1 DEC 36 MSL2 EQU MSL1 B7 OCT 7 D17 DEC 17 D22 DEC 22 BIT15 OCT 100000 DM143 DEC -143 DM10 DEC -10 D153 DEC 153 X NOP Y NOP IDEAL NOP FLG1 NOP CHECK EQU .-* WILL GIVE ERROR IF INIT TOO LARGE RFAMD EQU . RFAMD'S START HERE * ORG .+306 LEAVE ROOM FOR 2 RFAMD'S & DCB'S * END DEF * END RFAM s e. 91750-18166 2013 S C0122 &RFMST              H0101 ASMB,C,Q,N IFN * START EXTENDED FILE CODE * HED RFMST: 91750-1X166 REV 2013 (C) HEWLETT-PACKARD CO. 1980 NAM RFMST,7 91750-1X166 REV 2013 800111 * XIF * END EXTENDED FILE CODE * * UNL IFZ * START NON-EXTENDED FILE CODE * HED RFMST: 91750-16ZZZ REV 2013 (C) HEWLETT-PACKARD CO. 1980 NAM RFMST,7 91750-16ZZZ REV 2013 800111 * XIF * END NON-EXTENDED FILE CODE LST SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: RFMST * SOURCE: 91750-18166 * RELOC: 91750-1X166 * PGMR: DAN GIBBONS * *************************************************************** SPC 3 UNL IFN * START EXTENDED FILE CODE LST ENT DXCRE,DXCLO,DXREA,DXWRI ENT DXAPO,DXPOS,DXLOC UNL XIF * END EXTENDED FILE CODE LST ENT DAPOS,DCLOS,DCONT,DCRET,DLOCF ENT DNAME,DOPEN,DPOSN,DPURG,DREAD ENT DSTAT,DWIND,DWRIT EXT .ENTR,#MAST,#NODE,PGMAD EXT .LDX,.LBX,.LAX,.ISX,.MVW,.SBX,.DSX EXT #RQB RQB EQU #RQB * SUP A EQU 0 B EQU 1 SKP * * THIS PROGRAM SUPPORTS ALL REMOTE FILE ACCESS (RFA) MASTER CALLS * IN THE DS/1000 SYSTEM. BELOW ARE THE VALID CALLING SEQUENCES, WITH * OPTIONAL PARAMETERS INDICATED BY PARENTHESES: []. OPTIONAL PARAMETER * "ERLOC" WHEN SPECIFIED WILL CONTAIN THE NODAL ADDRESS AT WHICH AN * ERROR OCCURRED (IF ANY). THE PARAMETER "ICR"# IN THE "DCRET","DNAME", * "DOPEN", AND "DPURG" CALLS IS A 2 WORD ARRAY WITH THE FIRST WORD EQUAL * TO THE REQUIRED CARTRIDGE LABEL AND THE SECOND WORD HAVING THE FILE'S * NODAL ADDRESS (DEFAULT IS 0,-1). ALL OTHER PARAMETERS HAVE THE * CONVENTIONAL FMP MEANINGS. * * * 1. CALL DAPOS(IDCB,IERR,IREC[,IRB,IOFF,ERLOC]) * SETS ABSOLUTE RECORD POSITION OF FILE TO VALUE OF "IREC" * * 2. CALL DCLOS(IDCB,IERR[,ITRUN,ERLOC]) * CLOSES DCB AND OPTIONALLY TRUNCATES BASED ON "ITRUN". * * 3. CALL DCONT(IDCB,IERR,ICON1[,ICON2,ERLOC]) * PERFORMS RTE I/O CONTROL REQUEST FOR TYPE 0 (NON-DISC) FILES. * * 4. CALL DCRET(IDCB,IERR,NAME,ISIZE,ITYPE[,ISECU,ICR,ERLOC]) * CREATES THE NAMED FILE WITH THE SPECIFIED NUMBER OF BLOCKS. * THE FILE IS LEFT OPEN EXCLUSIVELY TO THE CALLER. * * 5. CALL DLOCF(IDCB,IERR,IREC[,IRB,IOFF,JSEC,JLU,JTY,JREC,ERLOC]) * FORMATS AND RETURNS LOCATION AND STATUS INFORMATION FOR * THE DCB. * * 6. CALL DNAME(IDCB,IERR,NAME,NNAME[,ISECU,ICR,ERLOC]) * RENAMES THE SPECIFIED FILE * * 7. CALL DOPEN(IDCB,IERR,NAME[,IOPTN,ISECU,ICR,ERLOC]) * OPENS THE NAMED FILE * * 8. CALL DPOSN(IDCB,IERR,NUR[,IR,ERLOC]) * REPOSITIONS FILE * * 9. CALL DPURG(IDCB,IERR,NAME[,ISECU,ICR,ERLOC]) * CLOSES THE DCB AND PURGES THE FILE AND ALL ITS EXTENTS * * 10. CALL DREAD(IDCB,IERR,IBUF,IL[,LEN,NUM,ERLOC]) * READS THE NEXT RECORD INTO THE USER'S BUFFER * UNL IFN * START EXTENDED FILE CODE LST * 11. CALL DSTAT(ISTAT,IERR,IDEST[,ERLOC,ILEN,IFORM,IOP,IADD]) UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST * 11. CALL DSTAT(ISTAT,IERR,IDEST[,ERLOC]) UNL XIF * END NON-EXTENDED FILE CODE LST * RETURNS INFORMATION ON ALL MOUNTED CARTRIDGE LABELS * AT THE NODE SPECIFIED BY "IDEST" * * 12. CALL DWIND(IDCB,IERR[,ERLOC]) * REWINDS TYPE 0 FILES, OR SETS DISC FILE POSITION TO THE * FIRST RECORD * * 13. CALL DWRIT(IDCB,IERR,IBUF,IL[,NUM,ERLOC]) * WRITES THE SPECIFIED BUFFER TO THE FILE UNL IFN * START EXTENDED FILE CODE LST * * (THE FOLLOWING ARE EXTENDED FILE CALLS. THE FUNCTIONS * ARE THE SAME AS DESCRIBED FOR THE CORRESPONDING NON- * EXTENDED CALLS ABOVE.) * * 14. CALL DXAPO(IDCB,IERR,IREC[,IRB,IOFF,ERLOC]) * * 15. CALL DXCLO(IDCB,IERR[,ITRUN,ERLOC]) * * 16. CALL DXCRE(IDCB,IERR,NAME,ISIZE,ITYPE[,ISECU,ICR,JSIZE,ERLOC]) * * 17. CALL DXLOC(IDCB,IERR,IREC[,IRB,IOFF,JSEC,JLU,JTY,JREC,ERLOC]) * * 18. CALL DXPOS(IDCB,IERR,NUR[,IR,ERLOC]) * * 19. CALL DXREA(IDCB,IERR,IBUF,IL[,LEN,NUM,ERLOC]) * * 20. CALL DXWRI(IDCB,IERR,IBUF,IL[,NUM,ERLOC]) UNL XIF * END EXTENDED FILE CODE LST SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * RFBLK-START * ****************************************************************** * * * R F A B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY: * * * * RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO RFA REQUEST BUFFERS. * #FCN EQU #REQ RFA FUNCTION CODE. #DCB EQU #FCN+1 DCB/FILENAME AREA. #IRC EQU #DCB+3 DAPOS: IREC #IRB EQU #IRC+1 IRB #XIB EQU #IRC+2 kx IRB (DXAPO) #IOF EQU #IRB+1 IOFF #XIO EQU #XIB+2 IOFF (DXAPO) #ITR EQU #DCB+3 DCLOS: ITRUN #IC1 EQU #DCB+3 DCONT: ICON1 #IC2 EQU #IC1+1 ICON2 #ICR EQU #DCB+3 DCRET,DNAME,DOPEN,DPURG: ICR(1) #ID EQU #ICR+1 IDSEG #ISC EQU #ID+1 ISECU #SIZ EQU #ISC+1 DCRET: ISIZE(1) #SZ2 EQU #SIZ+1 ISIZE(2) #XRS EQU #SIZ+2 RECSZ (DXCRE) #TYP EQU #SZ2+1 ITYPE #XTY EQU #XRS+2 ITYPE (DXCRE) #NNM EQU #ISC+1 DNAME: NNAME #IOP EQU #ISC+1 DOPEN: IOPTN #NUR EQU #DCB+3 DPOSN: NUR #IR EQU #NUR+1 IR #XIR EQU #NUR+2 IR (DXPOS) #IL EQU #DCB+3 DREAD,DWRIT: IL #NUM EQU #IL+1 NUM #LEN EQU #FCN+1 DSTAT: ILEN #FOR EQU #LEN+1 IFORM #OPT EQU #FOR+1 IOP #NOD EQU #ICR+1 "FLUSH" REQUEST: NODE NUMBER * * OFFSETS INTO RFA REPLY BUFFERS. * #RFD EQU #REP DCRET,DOPEN: RFAMD ENTRY # #JSZ EQU #RFD+1 DCRET: JSIZE (DXCRE) #LOG EQU #REP DREAD: XLOG #REC EQU #REP DLOCF: IREC #RB EQU #REC+1 IRB #XRB EQU #REC+2 IRB (DXLOC) #OFF EQU #RB+1 IOFF #XOF EQU #XRB+2 IOFF (DXLOC) #JSC EQU #OFF+1 JSECT #XJS EQU #XOF+1 JSECT (DXLOC) #JLU EQU #JSC+1 JLU #XJL EQU #XJS+2 JLU (DXLOC) #JTY EQU #JLU+1 JTY #XJT EQU #XJL+1 JTY (DXLOC) #JRC EQU #JTY+1 JREC #XJR EQU #XJT+1 JREC (DXLOC) #IAD EQU #REP DSTAT: IADD * * MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. * #RLW EQU #MHD+13 M A X I M U M S I Z E ! ! ! * * RFBLK-END SKP * * C A U T I O N * * * IF THERE IS ANY CHANGE TO THE LAST PARAMETER OF A REQUEST * (OR REPLY FOR DSTAT), CHECK CALL TO $MAST AND #MAST FOR * SPECIFIED REQUEST LENGTH. * SPC 10 * * DAPOS PERFORMS A REMOTE FMGR "APOSNfp" CALL * DAPOS NOP JSB $PREP DO REQUEST SET-UP CONWD OCT 100000 FUNCTION CODE = 0 * JSB $VER3 GET & VERIFY 3RD PARAMETER * STB RQB+#IRC SAVE IREC IN THE REQST * LDB PRAMS+3,I GET THE OPTIONAL IRB STB RQB+#IRB AND STORE IN REQUEST. LDB PRAMS+4,I GET OPTIONAL IOFF STB RQB+#IOF AND STORE IN REQUEST. * JSB $MAST DO #MAST CALL ABS #IOF+1 REQUEST LENGTH * * DPURG JOINS US HERE. * DAPUR LDA PRAMS+5 GET 'ERLOC' PARAM ADR JMP $POST DO REQUEST WRAP-UP SKP * * DCLOS PERFORMS A REMOTE FMGR "CLOSE" CALL * DCLOS NOP JSB $PREP PERFORM PRE-PROCESSING OCT 100001 FUNCTION CODE = 1 * LDA PRAMS+2,I GET THE OPTIONAL ITRUN STA RQB+#ITR * JSB $MAST DO #MAST CALL ABS #ITR+1 REQUEST LENGTH * JMP DSX WRAP-UP AND EXIT SKP * * DCONT PERFORMS A REMOTE FMGR "FCONT" CALL * DCONT NOP JSB $PREP DO REQUEST PRE-PROCESSING OCT 100002 FUNCTION CODE= 2 * JSB $VER3 GET & VERIFY 3RD PARAMETER ADDR STB RQB+#IC1 SAVE ICON1 IN REQUEST * LDB PRAMS+3,I GET OPTIONAL ICON2 STB RQB+#IC2 * JSB $MAST DO #MAST CALL ABS #IC2+1 REQUEST LENGTH * LDA PRAMS+4 GET 'ERLOC' PARAM ADR JMP $POST WRAP-UP AND EXIT SKP * * DCRET PERFORMS A REMOTE FMGR "CREAT" CALL * DCRET NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING K3 DEC 3 FUNCTION CODE = 3 * STB RQB+#ID SET THE ID SEGMENT ADDRESS STB PRAMS,I IN THE REQST AND IN THE DCB * CPA PRAMS+4 TYPE ADDRESS PROVIDED? JMP PRERR NO, PARAMETER ERROR LDB PRAMS+4,I GET TYPE STB RQB+#TYP SAVE IN REQST * UNL IFN * START EXTENDED FILE CODE LST JSB MOVEP MOVE REMAINING PARAMS TO REQST UNL XIF * END EXTENDED FILE CODE LST s UNL IFZ * START NON-EXTENDED FILE CODE LST LDA PRAMS+5,I GET OPTIONAL ISECU STA RQB+#ISC * DLD PRAMS+3,I GET ISIZE (2 WORD PARAMETER) DST RQB+#SIZ SAVE IN REQUEST * LDA PRAMS+6 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * LDA PRAMS FINISH ADA K3 BUILDING STB A,I THE DCB (STORE NODE) UNL XIF * END NON-EXTENDED FILE CODE LST * JSB $MAST DO #MAST CALL ABS #TYP+1 REQUEST LENGTH * LDA PRAMS+7 GET 'ERLOC' PARAM ADR JMP DOPNX WRAP-UP AND EXIT UNL IFN * START EXTENDED FILE CODE LST SPC 2 MOVEP NOP SUBR TO MOVE PARAMS TO REQST LDA PRAMS+5,I GET OPTIONAL ISECU STA RQB+#ISC * DLD PRAMS+3,I GET ISIZE (2 WORD PARAMETER) DST RQB+#SIZ SAVE IN REQUEST * LDA PRAMS+6 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * LDA PRAMS FINISH ADA K3 BUILDING STB A,I THE DCB (STORE NODE) JMP MOVEP,I UNL XIF * END EXTENDED FILE CODE LST SKP * * DLOCF PERFORMS A REMOTE FMGR "LOCF" CALL * DLOCF NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100004 FUNCTION CODE = 4 * JSB $VER3 GET & VERIFY 3RD PARAMETER ADDRESS * JSB $MAST DO #MAST CALL ABS #DCB+3 REQUEST LENGTH * JSB .LDX SET A COUNTER DEF N7 LOOP1 JSB .LBX GET A RETURNED VALUE DEF RQB+#JRC+1 JSB .LAX GET RETURN ADDRESS DEF PRAMS+9 STB A,I PASS VALUE BACK JSB .ISX ALL DONE ? JMP LOOP1 NO, CONTINUE. * DLOC1 LDA PRAMS+9 GET 'ERLOC' PARAM ADR JMP $POST WRAP-UP AND EXIT SKP * * DNAME PERFORMS A REMOTE FMGR "NAMF" CALL * DNAME NOP JSB $PREP PERFORM xPRE-PROCESSING DEC 5 FUNCTION CODE = 5 * STB RQB+#ID SET ID SEG ADDR IN REQUEST. * LDB PRAMS+4,I SET OPTIONAL ISECU. STB RQB+#ISC * LDA PRAMS+5 GET ADDR OF ICR. JSB $ICR SET UP CR/NODE & MOVE FILE NAME. * LDA PRAMS+3 GET ADDRESS OF NNAME SZA,RSS JMP PRERR NOT PROVIDED LDB D#NNM JSB .MVW MOVE NEW NAME TO REQST DEF K3 NOP * JSB $MAST DO #MAST CALL ABS #NNM+3 REQUEST LENGTH * JMP DRX WRAP-UP AND EXIT * D#NNM DEF RQB+#NNM SKP * * DOPEN PERFORMS A REMOTE FMGR "OPEN" CALL * DOPEN NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING K6 DEC 6 FUNCTION CODE = 6 * STB PRAMS,I SET ID SEG ADDR IN DCB * STB RQB+#ID SET ID SEG ADDR IN REQUEST * LDB PRAMS+4,I GET OPTIONAL ISECU STB RQB+#ISC SAVE IN REQST * LDB PRAMS+3,I GET OPTIONAL IOPTN STB RQB+#IOP * LDA PRAMS+5 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * LDA PRAMS FINISH ADA K3 BUILDING STB A,I THE DCB. * JSB $MAST DO #MAST CALL ABS #IOP+1 REQUEST LENGTH * LDA PRAMS+6 * * DCRET JOINS US HERE. * DOPNX JSB .LDX X= ADDR OF USERS 4 WORD DCB DEF PRAMS LDB RQB+#RFD GET RFAMD ENTRY # JSB .SBX STORE IN 2ND WORD OF DCB DEF 1 JMP $POST WRAP-UP AND EXIT SKP * * DPOSN PERFORMS A REMOTE FMGR "POSNT" CALL * DPOSN NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100007 FUNCTION CODE = 7 * JSB $VER3 GET AND VERIFY 3RD PARAM ADDR. STB RQB+#NUR SAVE NUR IN REQUEST. * LDB PRAMS+3,I GET OPTIONAL IR STB RQB+#IR * JSB $MAST DO #MAST CALL ABS #IR+1 REQUEST LENGTH. * DPOS1 LDA PRAMS+4 GET 'ERLOC' PARAM ADR JMP $POST WRAP-UP AND EXIT X SKP * * DPURG PERFORMS A REMOTE FMGR "PURGE" CALL * DPURG NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING DEC 8 FUNCTION CODE = 8 * LDA PRAMS+4 GET ADDRESS OF ICR JSB $ICR SET-UP CR/NODE & MOVE FILE NAME * CLA LDB PRAMS+3,I GET OPTIONAL ISECU STB RQB+#ISC JSB PGMAD GET ID SEGMENT ADDRESS DEF *+2 DEF K0 STA RQB+#ID SET IT INTO REQUEST * JSB $MAST DO #MAST CALL ABS #ISC+1 REQUEST LENGTH. * JMP DAPUR REST IS IN COMMON WITH DAPOS SKP * * DREAD PERFORMS A REMOTE FMGR "READF" CALL * DREAD NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100011 FUNCTION CODE = 9 * UNL IFN * START EXTENDED FILE CODE LST JSB DREA1 PROCESS NUM & IL PARAMS UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST LDB PRAMS+5,I GET THE OPTIONAL NUM * LDA PRAMS+3,I GET IL STA RQB+#IL SAVE IT IN THE REQST STA RDLEN AND FOR THE "MS" CALL UNL XIF * END NON-EXTENDED FILE CODE LST * JSB XDATA DO COMMON DREAD/DWRIT LOGIC * DREA2 LDA PRAMS+4 LDB RQB+#LOG PASS OPTIONAL LEN STB A,I IF REQUIRED BY THE USER * * DNAME JOINS US HERE. * DRX LDA PRAMS+6 GET 'ERLOC' PARAM ADR JMP $POST WRAP-UP AND EXIT UNL IFN * START EXTENDED FILE CODE LST SPC 2 DREA1 NOP SUBR TO PROCESS NUM & IL LDB PRAMS+5,I GET THE OPTIONAL NUM * LDA PRAMS+3,I GET IL STA RQB+#IL SAVE IT IN THE REQST STA RDLEN AND FOR THE "MS" CALL JMP DREA1,I UNL XIF * END EXTENDED FILE CODE LST SKP * * DSTAT PERFORMS A REMOTE FMGR "FSTAT" CALL * DSTAT NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING K10 DEC 10 FUNCTION CODE = 10 * JSB $VER3 GET & VERIFY THE 3RD PARAMETER ADDRESS STB RQB+#DST STORE "IDEST" IN REQUEST LDA K125 GET DATA LENGTH UNL IFN * START EXTENDED FILE CODE LST LDA PRAMS+4,I OVERRIDE LENGTH IF ILEN PROVIDED STA RQB+#LEN SET LENGTH INTO REQST UNL XIF * END EXTENDED FILE CODE LST STA RDLEN SET DATA READ LENGTH UNL IFN * START EXTENDED FILE CODE LST CLA (IN CASE PRAMS+5 OR +6 = 0) LDB PRAMS+5,I GET OPTIONAL IFORM PARAM STB RQB+#FOR SET IT INTO REQST LDB PRAMS+6,I GET OPTIONAL IOP PARAM STB RQB+#OPT SET IT INTO REQST UNL XIF * END EXTENDED FILE CODE LST * JSB $MAST DO #MAST CALL ABS #OPT+1 UNL IFN * START EXTENDED FILE CODE LST * LDA PRAMS+7 RETURN IADR TO LDB RQB+#IAD USER IF PARAM STB A,I WAS PROVIDED. UNL XIF * END EXTENDED FILE CODE LST * * DCLOS JOINS US HERE. * DSX LDA PRAMS+3 GET 'ERLOC' PARAM ADR JMP $POST WRAP-UP AND EXIT SKP * * DWIND PERFORMS A REMOTE FMGR "RWNDF" CALL * DWIND NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100013 FUNCTION CODE = 11 * JSB $MAST DO #MAST CALL ABS #DCB+3 * LDA PRAMS+2 GET 'ERLOC' PARAM ADR JMP $POST WRAP-UP AND EXIT SKP * * DWRIT PERFORMS A REMOTE FMGR "WRITF" CALL * DWRIT NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100014 FUNCTION CODE = 12 * UNL IFN * START EXTENDED FILE CODE LST JSB DWRI1 PROCESS PARAMS UNL XIF * END EXTENDED FILE CODE LST UNL IFZ * START NON-EXTENDED FILE CODE LST LDB PRAM9S+4,I GET THE OPTIONAL NUM LDA PRAMS+3,I GET IL STA RQB+#IL STORE IN REQUEST INA,SZA SKIP IF WRITE EOF LDA RQB+#IL STA WRLEN SAVE WRITE LENGTH FOR MS CALL UNL XIF * END NON-EXTENDED FILE CODE LST * JSB XDATA PERFORM COMMON DREAD/DWRIT LOGIC * DWRI2 LDA PRAMS+5 GET 'ERLOC' PARAM ADR UNL IFZ * START NON-EXTENDED FILE CODE LST SKP UNL XIF * END NON-EXTENDED FILE CODE LST UNL IFN * START EXTENDED FILE CODE LST JMP $POST WRAP-UP AND EXIT SPC 2 DWRI1 NOP PROCESS NUM & IL PARAMS LDB PRAMS+4,I GET THE OPTIONAL NUM LDA PRAMS+3,I GET IL STA RQB+#IL STORE IN REQUEST INA,SZA SKIP IF WRITE EOF LDA RQB+#IL STA WRLEN SAVE WRITE LENGTH FOR MS CALL JMP DWRI1,I SKP * * DXAPO PERFORMS A REMOTE FMGR "EAPOS" CALL * DXAPO NOP JSB $PREP DO REQUEST SET-UP OCT 100022 FUNCTION CODE = 18 * JSB XVER3 GET & VERIFY IREC (DBL) DST RQB+#IRC SAVE IT IN REQST * CLA GET DEFAULTS IN CASE CLB PRAMS+3 = 0. DLD PRAMS+3,I GET OPTIONAL IRB (DBL) DST RQB+#XIB SET IRB INTO REQST CLA (IN CASE PRAMS+4 = 0) LDA PRAMS+4,I GET OPTIONAL IOF STA RQB+#XIO SET IT INTO REQST * JSB $MAST DO #MAST CALL ABS #XIO+1 REQST LENGTH * JMP DAPUR GO FINISH UP SKP * * DXCLO PERFORMS A REMOTE FMGR "ECLOS" CALL * DXCLO NOP JSB $PREP PERFORM PRE-PROCESSING OCT 100017 FUNCTION CODE = 15 * CLA GET DEFAULT IN CASE CLB PRAMS+2 = 0. DLD PRAMS+2,I GET OPTIONAL ITRUN (DBL) DST RQB+#ITR SET ITRUN INTO REQST * JSB $MAST DO #MAST CALL ABS #ITR+2 REQST LENGTH * JMP DSX WRAP -UP AND EXIT SKP * * DXCRE PERFORMS A REMOTE FMGR "ECREA" CALL * DXCRE NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING DEC 14 FUNCTION CODE = 14 * STB RQB+#ID SET OUR ID SEG ADR INTO STB PRAMS,I REQUEST AND INTO DCB(1). * CPA PRAMS+4 ITYPE PROVIDED? (A=0) JMP PRERR NO, PARAM ERROR LDB PRAMS+4,I GET ITYPE STB RQB+#XTY SET IT INTO REQST * JSB MOVEP PROCESS REMAINING PARAMS * LDA PRAMS+3 MOVE RECORD SIZE (ISIZE(3)&(4)) ADA K2 INTO REQUEST. DLD A,I DST RQB+#XRS * JSB $MAST DO #MAST CALL ABS #XTY+1 REQST LENGTH * DLD RQB+#JSZ PASS BACK DST PRAMS+7,I 'JSIZE' PARAM. * LDA PRAMS+8 GET 'ERLOC' PARAM ADR JMP DOPNX WRAP-UP AND EXIT SPC 2 K2 DEC 2 SKP * * DXLOC PERFORMS A REMOTE FMGR "ELOCF" CALL * DXLOC NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100024 FUNCTION CODE = 20 * JSB $VER3 GET AND VERIFY 3RD PARAM ADR * JSB $MAST DO #MAST CALL ABS #DCB+3 REQST LENGTH * DLD RQB+#REC PASS RETURN PARAMS DST PRAMS+2,I TO USER. DLD RQB+#XRB DST PRAMS+3,I LDA RQB+#XOF STA PRAMS+4,I DLD RQB+#XJS DST PRAMS+5,I LDA RQB+#XJL STA PRAMS+6,I LDA RQB+#XJT STA PRAMS+7,I LDA RQB+#XJR STA PRAMS+8,I * JMP DLOC1 GO FINISH UP SKP * * DXPOS PERFORMS A REMOTE FMGR "EPOSN" CALL * DXPOS NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100023 FUNCTION CODE = 19 * JSB XVER3 GET & VERIFY NUR (DBL) DST RQB+#NUR SET INTO REQST * CLA (IN CASE PRAMS+3 = 0) LDA PRAMS+3,I GET OPTIONAL IR PARAM STA RQB+#XIR SET IR INTO REQST * JSB $MAST DO #MAST CALL ABS #XIR+1 REQST LENGTH * JMP DPOS1 GO FINISH UPd SKP * * DXREA PERFORMS A REMOTE FMGR "EREAD" CALL * DXREA NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100020 FUNCTION CODE = 16 * JSB DREA1 PROCESS NUM(1), IL, JSB XDAT1 AND IBUF PARAMS. LDA PRAMS+5 GET ADR OF 'NUM' PARAM JSB DXRE1 PROCESS NUM(2) PARAM * JSB $MAST DO #MAST CALL ABS #NUM+2 REQST LENGTH * JMP DREA2 GO FINISH UP SPC 2 DXRE1 NOP PROCESS NUM(2) PARAM. =NUM(1) ADR. SZA PARAM SPECIFIED? INA YES, STEP TO NUM(2) LDA A,I GET NUM(2), OR 0 IF NOT SPECIFIED, STA RQB+#NUM+1 AND SET IT INTO REQST. JMP DXRE1,I SKP * * DXWRI PERFORMS A REMOTE FMGR "EWRIT" CALL * DXWRI NOP JSB $PREP PERFORM REQUEST PRE-PROCESSING OCT 100021 FUNCTION CODE = 17 * JSB DWRI1 PROCESS NUM(1), IL, JSB XDAT1 AND IBUF PARAMS. LDA PRAMS+4 GET ADR OF 'NUM' PARAM JSB DXRE1 PROCESS NUM(2) PARAM * JSB $MAST DO #MAST CALL ABS #NUM+2 REQST LENGTH * JMP DWRI2 GO FINISH UP SKP UNL XIF * END EXTENDED FILE CODE LST * * * COMMON REQUEST POST-PROCESSING LOGIC. (='ERLOC' PARAM ADR) * $POST LDB RQB+#ENO GET THE ERROR LOCATION ELB,CLE,ERB STRIP SIGN BIT IF SET STB A,I RETURN IT (OPTIONALLY) LDA RQB+#EC2 ERROR CODE LDB RQB+#ENO GET ERROR LOCATION AGAIN SSB ASCII ERROR CODE? LDA ERCNV YES, RETURN CONVERTED ERROR CODE * $PST2 STA PRAMS+1,I RETURN ERROR CODE JMP CALL,I RETURN FROM MASTER RFA CALL SPC 4 * * THIS SUBROUTINE IS COMMON TO DREAD AND DWRIT * XDATA NOP UNL IFN * START EXTENDED FILE CODE LST JSB XDAT1 DO PART COMMON TO XTND & NON-XTND CALLS UNL XIF * END EXTENDED FILE CODE LST LUNL IFZ * START NON-EXTENDED FILE CODE LST STB RQB+#NUM SAVE THE OPTIONAL NUM SSA LENGTH NEGATIVE ? JMP PRERR YES, ILLEGAL ADA N513 IL > 512 ? SSA,RSS JMP PRERR YES, TOO MUCH * CLA CPA PRAMS+3 WAS "IL" SPECIFIED? JMP PRERR NO, PARAMETER ERROR * LDA PRAMS+2 GET BUFFER ADDRESS STA PRAMS SAVE FOR MS CALL SUBROUTINE UNL XIF * END NON-EXTENDED FILE CODE LST * JSB $MAST CALL #MAST ABS #NUM+1 * JMP XDATA,I RETURN UNL IFN * START EXTENDED FILE CODE LST SPC 2 XDAT1 NOP PROCESS DREAD,DWRIT,DXREA,DXWRI PARAMS STB RQB+#NUM SAVE THE OPTIONAL NUM SSA LENGTH NEGATIVE ? JMP PRERR YES, ILLEGAL ADA N513 IL > 512 ? SSA,RSS JMP PRERR YES, TOO MUCH * CLA CPA PRAMS+3 WAS "IL" SPECIFIED? JMP PRERR NO, PARAMETER ERROR * LDA PRAMS+2 GET BUFFER ADDRESS STA PRAMS SAVE FOR MS CALL SUBROUTINE JMP XDAT1,I UNL XIF * END EXTENDED FILE CODE LST SKP * * COMMON REQUEST PRE-PROCESSING ROUTINE FOR ALL MASTER RFA CALLS * $PREP NOP LDB "DS" PRIME ERROR CODE WORDS STB RQB+#EC1 IN CASE WE DETECT AN LDB #NODE BEFORE CALL TO #MAST. STB RQB+#ENO CLB STB RQB+#ECQ * JSB .LDX CLEAN OUT PARAMETER AREA DEF K10 LOOP JSB .SBX DEF PRAMS-1 JSB .DSX JMP LOOP * LDB $PREP ADB N2 LDB B,I GET RETURN POINT STB CALL SAVE JMP CALL+1 * PRAMS REP 10 NOP CALL NOP JSB .ENTR GET ADDRESSES OF PARAMETERS DEF PRAMS LDA K6 STA RQB+#STR SET RFA STREAM LDA PRAMS+1 SZA,RSS AT LEAST 2 PARAMETERS SPECIFIED? JM$P CALL,I NO, RETURN NOW! LDA $PREP,I GET FUNCTION CODE/ MOVE DCB FLAG ISZ $PREP RAL,CLE,ERA CLEAR SIGN BIT STA RQB+#FCN SET FUNCTION CODE IN REQUEST SEZ,RSS DCB MOVE REQUIRED? JMP $PREX NO * * MOVE DCB TO THE REQUEST BUFFER * LDA PRAMS GET ADDR OF DCB LDB D#DCB ADDR OF NAME FIELD IN REQUEST JSB .MVW MOVE IT DEF K3 NOP LDA A,I GET DESTINATION FROM 4TH DCB WORD STA RQB+#DST SET INTO REQUEST * $PREX JSB PGMAD GET OUR IDSEG ADR DEF *+2 DEF NAME STA B SET IT INTO CLA STA WRLEN INITIALIZE DATA STA RDLEN BUFFER LENGTHS FOR MS CALL JMP $PREP,I RETURN WITH =0, =IDSEG ADR SPC 2 NAME REP 3 NOP SKP * * SUBROUTINE TO PERFORM #MAST CALL * $MAST NOP * JSB #MAST DEF *+7 DEF CONWD DEF $MAST,I REQUEST BUFFER LENGTH DEF PRAMS,I DATA ADDRESS (IF ANY) DEF WRLEN DEF RDLEN DEF C#RLW MAX ALLOWED REPLY LENGTH * JMP COMER ERROR RETURN * $MSEX ISZ $MAST JMP $MAST,I RETURN * * SUBROUTINE TO SET-UP CARTRIDGE REFERENCE AND NODAL ADDRESS * TO EITHER THE PASSED VALUES OR DEFAULTS * $ICR NOP STA $MAST USE $MAST LOC AS TEMP STORAGE JSB $VER3 GET & VERIFY THE 3RD PARAMETER ADDRESS LDA PRAMS+2 GET ADDRESS OF NAME FIELD LDB D#DCB GET ADDRESS OF NAME FIELD IN REQUEST JSB .MVW MOVE IT DEF K3 NOP LDA $MAST RELOAD ICR ADDRESS CCB LOCAL NODE DESIGNATOR (DEFAULT) DLD A,I GET ICR & NODE STA RQB+#ICR SAVE THE CARTRIDGE # STB RQB+#DST SAVE THE DESTINATION NODE JMP $ICR,I RETURN SKP * * COME HERE IF SIGN BIT OF RQB+#ENO WORD OF REPLY WAS SET * UPON RETURN FROM #MAST CALL (INDICATING ASCII ERROR CODE). * COMER LDA RQB+#EC1 !`^ZGET ALPHABETIC PART OF THE ERROR CPA "DS" IS IT "DS"? JMP DSERR YES LDA N999 NO, REPORT IT AS A -999 ERROR JMP NOTDS * DSERR LDA RQB+#EC2 GET THE NUMERICAL PART OF THE ERROR AND B17 CODE AND DECODE IT CMA,INA NEGATE IT ADA N50 NOTDS STA ERCNV SAVE CONVERTED ERROR CODE JMP $MSEX RETURN * ERCNV NOP CONVERTED ERROR CODE SPC 3 * * SUBROUTINE TO GET & VERIFY THE 3RD PARAMETER ADDRESS * $VER3 NOP CLA ALWAYS RETURN A=0 CPA PRAMS+2 3RD PARAMETER ADDRESS JMP PRERR NOT SPECIFIED, GIVE ERROR LDB PRAMS+2,I GET 3RD PARAMETER JMP $VER3,I & RETURN UNL IFN * START EXTENDED FILE CODE LST * * SUBROUTINE TO VERIFY & TO SET THE 3RD DOUBLE WORD * PARAMETER INTO A & B REGISTERS. * XVER3 NOP LDA PRAMS+2 GET ADR OF 3RD PARAM SZA,RSS WAS PARAM SPECIFIED? JMP PRERR NO, GIVE ERROR DLD A,I GET 3RD PARAM INTO A & B JMP XVER3,I RETURN UNL XIF * END EXTENDED FILE CODE LST SPC 2 * PRERR LDA N10 INSUFFICIENT PARAMETERS, GIVE -10 ERROR STA RQB+#EC2 SET ERROR INTO REQUEST BUFFER JMP $PST2 SKP * * CONSTANTS & VARIABLES * * "DS" ASC 1,DS WRLEN NOP RDLEN NOP K0 DEC 0 B17 OCT 17 K125 DEC 125 N2 DEC -2 N7 DEC -7 N10 DEC -10 N50 DEC -50 N999 DEC -999 N513 DEC -513 D#DCB DEF RQB+#DCB * C#RLW ABS #RLW MAXIMUM REQ/REPLY LENGTH. SPC 3 END ?` f{ 91750-18167 2013 S C0122 &RMOTE              H0101 ASMB,Q,C,N HED OPERATOR ACCESS TO 3000 * (C) HEWLETT-PACKARD CO. IFN ***** NAM RMOTE,19,80 91750-16167 REV.2013 800324 MEF XIF ***** IFZ ***** NAM RMOTE,19,80 91750-16168 REV.2013 800324 MEF XIF ***** SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: *SOURCE: 91750-18167 * RELOC: 91750-16167 (N OPTION) 91750-16168 (Z OPTION) * PGMR: DMT LST ************************** RMOTE ************************* * * * SOURCE: 91750-18167 * * * * BINARY: 91750-16167 N OPTION * * 91750-16168 Z OPTION (INCLUDES FILE MOVE) * * * * PROGRAMMER: JIM HARTSELL * * * * DATE: OCTOBER 21, 1975 * * * * * **** MODIFIED BY DMT BEGINNING AUGUST 1, 1978 **** * FOR DS/1000 ENHANCEMENTS PROJECT * * * ************************************************************** SPC 1 * * DS/1000 PROGRAM TO PROVIDE OPERATOR ACCESS * TO A REMOTE HP3000 COMPUTER. * &d EXT NAMR,IFTTY,IFBRK,.ENTR,.MVW EXT EXEC,KCVT,MESSS,REIO,LURQ EXT OPEN,READF,POSNT,CLOSE EXT #PKUP,#LU3K,HELLO,BYE EXT D3KMS,D$RQB,D$3BF,D$ERR,D$INP,D$LOG,D$SMP IFZ ***** EXT POPEN,PCONT,PREAD,PWRIT,PCLOS EXT WRITF,LOCF,CREAT EXT COR.A,SPOPN,LUTRU,CNUMD,$SPCR EXT D$BRK,D$CTY XEQT EQU 1717B ID SEGMENT ADDRESS BGLWA EQU 1777B LAST WORD IN PARTITION XIF ***** * A EQU 0 A-REGISTER B EQU 1 B-REGISTER SUP SKP * RMOTE JSB #PKUP PICK UP PARAMETERS. DEF *+4 DEF PMASK DEF NAME DEF DEFLU * CLA STA D$SMP FOR RTE-M, CLEAR SMP NUMBER. IFZ ***** STA SLFLG SLAVE-OPEN FLAG := 0. STA SPFLG SPOOL FLAG := 0. * * SET UP P-TO-P BUFFER. LDA XEQT FIND FIRST WORD JSB COR.A OF AVAILABLE MEM. STA BUFER BUFFER STARTS THERE. CMA,INA LDB BGLWA FIND LAST WORD. ADA B CALCULATE LENGTH. AND ML256 MAKE IT MULTIPLE OF 256. STA MAXBF LDB D4096 INSURE MAX CMA,INA BUFFER IS ADA D4096 <= 4096. SSA STB MAXBF * LDA #LU3K SET NODE NUMBER CMA,INA TO NEGATIVE STA NOD3K HP 3000 LU. XIF ***** * LDA LPRMP INITIALIZE FOR STA PROMP LOCAL PROMPT CHAR. * LDA MD6 SET ZERO-LENGTH RECORD STA ZLCNT COUNTER TO -6. SPC 1 * * PROCESS FIRST PARAMETER--INPUT LU OR NAMR * LDA NAME CHECK IF P1=ASCII PARAM AND HB377 (A=0 IF NUMERIC). SZA JMP STYPE * LDA NAME IF FIRST PARAMETER AND B77 (MINUS CONTROL BITS) SZA,RSS IS ZERO, LDA DEFLU USE DEFAULT LU STA NAME JSB EQTYP CHECK TYPE OF INPUT LU. * STYPE STA LUTYP SAVE EQUIPMENT TYPE. n` SPC 1 * * PROCESS SECOND PARAMETER--LOG DEVICE * LDB P1 ASSUME PARAMETER WAS SUPPLIED. LDA P1 IF IT IS AND HB377 ALPHABETIC SZA,RSS SZB,RSS OR ZERO, LDB DEFLU USE DEFAULT LU. LDA B CLEAR CONTROL AND B77 BITS FOR D$LOG. STA D$LOG ADD "PRINT IOR B600 COLUMN-1" BIT STA LULOG FOR LULOG. JSB LOKLU LOCK LIST LU. SPC 1 * * PROCESS THIRD PARAMETER--SEVERITY CODE * LDA SEVER MAKE SURE CPA D2 SEVERITY JMP DOELU IS 2, CPA D1 1, OR JMP DOELU ZERO. CLA STA SEVER SPC 1 * * FIGURE OUT ERROR LU. * DOELU LDA NAME IF INPUT LDB LUTYP IS SZB,RSS INTERACTIVE, JMP IOR USE IT. LDA LULOG IF LOG JSB EQTYP LU IS SZA INTERACTIVE, JMP LDDEF LDA LULOG USE IT. JMP IOR LDDEF LDA DEFLU OTHERWISE USE DEFAULT. IOR IOR B600 SET "ECHO INPUT" BIT. STA ERRLU SAVE ERROR LU. SPC 1 LDA STKHD INITIALIZE TRANSFER STACK TO JMP M1221 CONTAIN INPUT LU/NAMR. SPC 1 B77 OCT 77 B600 OCT 600 PMASK BYT 3,3 #PKUP HAS 3 PARAMS, FIRST 2 NAMR. IFZ ***** ML256 OCT 177600 D4096 DEC 4096 XIF ***** SKP * * DISPLAY PROMPT CHARACTER (IF INTERACTIVE DEVICE). * CONTROL RETURNS HERE WHEN REQUEST PROCESSING COMPLETES. * QUERY LDA P.STK,I READ FROM JSB READ CURRENT INPUT. DEF POPTS (ERROR RETURN) DEF TRANS (EOF RETURN) * LDA P.STK ADA D3 ISZ A,I BUMP RECORD COUNT. * * ECHO THE REQUEST IF NOT INPUT FROM INTERACTIVE DEVICE. * ECHO LDA LUTYP SZA,RSS JMP CKCNT IT IS AN INTERACTIVE DEVICE. * CLA IF SEVERITY = 0, " JSB ECHPR ECHO. * JSB IFBRK IF BREAK DEF *+1 FLAG IS SZA SET, JMP POPTS POP TO TOP OF STACK. * LDA INBUF FIRST CHARACTER MUST XOR PROMP BE CURRENT AND HB377 PROMPT CHARACTER. SZA JMP INVAL * LDA INBUF BLANK AND B377 OUT THE IOR BLANK PROMPT STA INBUF CHARACTER. * CKCNT LDB IOLEN NULL INPUT? SZB JMP PRSCM NO--GO PARSE COMMAND. ISZ ZLCNT BUMP ZERO-LENGTH INPUT COUNTER. JMP QUERY IGNORE UNTIL 6TH... JMP M0501 THEN TERMINATE. * ZLCNT NOP ZERO-LENTGH INPUT COUNTER * * PARSE THE OPERATOR REQUEST. * PRSCM LDA MD6 SET ZERO-LENGTH STA ZLCNT COUNTER TO -6. CLA,INA SET CHARACTER STA PNTR POINTER TO 1. JSB PNAMR PARSE COMMAND DEF P1 TO P1 ARRAY. * JMP M0000 TRY FOR COMMAND FIRST. SPC 2 TRANS DLD A.TR AT EOF, GENERATE DST INBUF TRANSFER. LDB D4 STB IOLEN LDB LUTYP IF NON-INTERACTIVE, SZB JMP ECHO GO ECHO. * AND B377 CHANGE FIRST IOR BLANK CHARACTER TO BLANK. STA INBUF JMP PRSCM PARSE COMMAND. SKP * LOCAL RTE OR REMOTE HP3000 COMMAND. * OTHER LDA PROMP IF SWITCHED LOCAL, SEND CPA LPRMP COMMAND TO RTE. JMP LCRTE * * SEND REMOTE HP3000 COMMANDS. LDA D$SMP HAS "HELLO" BEEN ENTERED? SZA,RSS JMP NHLLO NO. REPORT ERROR. IFZ ***** JSB CLSLV MAKE SURE SLAVE IS CLOSED. XIF ***** JSB BLKIL KILL LEADING BLANKS IN COMMAND. JSB CMNDS SEND COMMAND TO HP3000. DEF *+3 DINBF DEF INBUF DEF IOLEN * JMP QUERY * * PASS COMMAND TO LOCAL RTE. LCRTE JSB MESSS PROCESS COMMAND. DEF *+4 ֏ (RU & ON COME THRU HERE IF DEF INBUF "NOW" WAS SPECIFIED IN COMMAND.) DEF IOLEN DEF D$LOG PASS LOG LU. * SZA,RSS IF REPLY CHAR COUNT NON-ZERO: JMP QUERY * STA TEMP NEGATE CHARACTER COUNT. * LDA D$LOG SET "ECHO INPUT" & IOR B600 "PRINT COL 1" BITS. STA CNWRD JSB REIO DISPLAY REPLY MESSAGE. DEF *+5 DEF SD2 DEF CNWRD DEF INBUF DEF TEMP OTERR JSB EROUT ERROR RETURN. JMP QUERY SKP * CHECK THE OPERATOR REQUEST CODE AGAINST THE LEGAL * REQUEST CODES AND JUMP 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. * M0000 LDA P1 FETCH OPERATION CODE. XOR STAR IF "*" IN AND HB377 COLUMN 1, SZA,RSS JUST A JMP QUERY COMMENT. LDA P1 FETCH OPERATION CODE. AND UMASK UPSHIFT. STA OPP SET STOP FLAG. LDB LDOPC SET OPERATION TABLE POINTER. STB TEMP1 LDB LDJMP SET PROCESSOR JUMP ADDRESS. STB TEMP2 * M0030 CPA TEMP1,I COMPARE WITH TABLE VALUE. JMP TEMP2,I COMPARES. GO DO IT. * ISZ TEMP1 KEEP LOOKING. ISZ TEMP2 JMP M0030 * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS. ASC 10,SWHEBYTREXRUONRWLLSV IFZ ***** ASC 1,MO XIF ***** OPP NOP OP CODE FOR CURRENT REQ. "RW" EQU LDOPC+8 "LL" EQU LDOPC+9 * LDJMP DEF *+1,I JMP ADDRESS FOR EACH OP CODE. DEF M0100 SWITCH. DEF M0200 HELLO. DEF M0300 BYE. DEF M0400 TRANSFER. DEF M0500 EXIT. DEF M0600 "RU" COMMAND TRAP. DEF M0600 "ON" COMMAND TRAP. DEF M0600 RW COMMAND # DEF M0700 LL COMMAND. DEF M0800 SEVERITY CODE. IFZ ***** DEF M0900 MOVE FILE. XIF ***** DEF OTHER ASSUME RTE OR HP3000 COMMAND. * NHLLO JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT DISPLAY "NEED HELLO" DEF NHMSG D6 DEC 6 JMP POPTS * NHMSG ASC 6,NEED "HELLO" * UMASK OCT 157737 UPSHIFT MASK. STAR BYT 52,0 CNWRD NOP BLNKS ASC 1, SPC 3 * SUBROUTINE TO CHECK FOR POSSIBLE NON-RMOTE COMMAND (EG: UDC FILE) * CALLING SEQUENCE: JSB CKUDC * RETURNS TO P+1 IF RMOTE COMMAND * GOES TO IF NOT * CKUDC NOP ENTRY. LDA P1+1 GET CHARS 3 & 4. CPA BLNKS IF BLANKS, JMP CKUDC,I IT'S AN RMOTE COMMAND. JMP OTHER OTHERWISE PASS TO OP SYSTEM. SKP * * SW[,N] * * CHANGE OR TOGGLE DESTINATION OF OPERATOR COMMANDS. * M0100 JSB CKUDC CHECK FOR NON-RMOTE COMMAND. JSB PNAMR PARSE NODE NUMBER DEF P1 INTO P1 ARRAY. LDA STAT1 CHECK IF FIRST PARAM SPECIFIED. AND D3 SZA JMP M0105 PARAM SPECIFIED. * LDB PROMP NO PARAM. TREAT AS A TOGGLE. CPB RPRMP IS CURRENT PROMPT = REMOTE PROMPT? JMP M0110 YES. SWITCH TO LOCAL PROMPT. LDA #LU3K NO. GET LU OF 3000. SZA JMP M0110 GO CHANGE CURRENT PROMPT. JMP NLSTN TELL USER HE NEEDS TO RUN "DINIT". * M0105 LDA P1 PARAM GIVEN. AND UMASK UPSHIFT. CPA "LO" "LO" MEANS LOCAL. JMP M0109 LDA P1 SZA,RSS 0=LOCAL RTE, N=HP3000 LU. JMP M0110 LDB #LU3K IF NON-ZERO, MUST BE IN #LU3K. SZB,RSS JMP NLSTN TELL USER HE NEEDS TO RUN "DINIT". CPB A CHECK FOR VALID REMOTE LU. JMP M0110 VALID. JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT DISPLAY "INVALID REMOTE LU". DEF ILLU DEC 9 JMP POPTS * ' M0109 CLA M0110 LDB LPRMP CHANGE THE PROMPT CHARACTER: SZA LOCAL IF NEW LU = 0, LDB RPRMP REMOTE IF NEW LU NON-ZERO. STB PROMP * LDA A.TR CHANGE CANNED XOR PROMP TR COMMAND AND B377 PROMPT. XOR PROMP STA A.TR JMP QUERY * NLSTN JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT DISPLAY "NEED TO RUN DINIT". DEF NLSN DEC 10 JMP POPTS NLSN ASC 10,NEED TO RUN "DINIT" ILLU ASC 9,INVALID REMOTE LU "LO" ASC 1,LO SKP * * PROCESSOR FOR "HELLO" COMMAND. * M0200 LDA P1+1 MAKE SURE AND UMASK SECOND TWO CPA "LL" CHARACTERS RSS ARE "LL". JMP OTHER NO--MUST BE ANOTHER COMMAND. LDA PROMP IF LOCAL PROMPT, CPA LPRMP JMP NDREM COMMAND IS AN ERROR. JSB BLKIL KILL LEADING BLANKS. IFZ ***** JSB CLSLV MAKE SURE SLAVE IS CLOSED. XIF ***** * LDA P.STK,I IF CURRENT INPUT IS A LOGICAL UNIT, STA B USE IT. IF NOT, USE DEFAULT LU. AND HB377 SZA LDB DEFLU LDA B REMOVE ANY AND B77 CONTROL BITS. STA D$INP * JSB HELLO SEND "HELLO" TO HP3000. DEF *+7 DEF ERROR DEF #LU3K LU OF HP3000. DEF D$LOG LU OF LOG DEVICE. DEF SMPNM RETURNED PROCESS NUMBER. @INBF DEF INBUF ADDR OF HELLO MESSAGE. @REC DEF IOLEN POS. # BYTES. * LDA ERROR CHECK FOR ERRORS. SZA,RSS JMP QUERY OK. CPA D1 ERROR CODE = 1? RSS JMP RFAIL NO. * JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT DISPLAY MESSAGE. DEF HFAIL D13 DEC 13 * JMP POPTS * HFAIL ASC 13,HELLO FAILED OR LINE DOWN SKP * * PROCESSOR FOR "BYE" COMMAND. * M0300 LDA P1+1 IF CHARACTERS AND UMSK2 3 AND 4 AREN'T CPA "E" "E ", IT'S RSS NOT A BYE COMMAND. JMP OTHER LDA PROMP IF LOCAL PROMPT, CPA LPRMP JMP NDREM COMMAND IS AN ERROR. LDA D$SMP IF NO HELLO ISSUED, SZA,RSS JMP NHLLO COMMAND IS AN ERROR. * JSB LOGOF SEND "BYE" TO HP3000. SZA JMP RFAIL FAILED. * JMP QUERY * "E" ASC 1,E UMSK2 OCT 157777 SPC 3 * SUBROUTINE TO LOG OFF FROM 3000. USED FOR "BYE" AND "EXIT" * CALLING SEQUENCE: JSB LOGOF * * LOGOF NOP ENTRY. IFZ ***** JSB CLSLV CLOSE SLAVE (IF OPEN). XIF ***** * JSB BYE SEND "BYE" DEF *+5 DEF ERROR DEF #LU3K DEF D$LOG DEF SMPNM * LDA ERROR LOAD ERROR CODE. JMP LOGOF,I RETURN. SKP RFAIL CPA D5 JMP TMOUT CPA "IO" JMP OTERR CPB "05" JMP TMOUT CPA D1 JMP DSCNT CPB "01" JMP DSCNT * JSB PRINT DISPLAY "REQUEST FAILED". DEF RQFL DEC 7 * JMP POPTS * JSB ECHP2 ECHO IF SEVERITY=2. DSCNT JSB PRINT DISPLAY "LINK IS DISCONNECTED". DEF DISCN DEC 10 JMP POPTS * RQFL ASC 7,REQUEST FAILED * TMOUT JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT "TIMEOUT" DEF TOMSG DEC 15 * JMP POPTS * TOMSG ASC 15,TIMEOUT: NO REPLY FROM REMOTE * NDREM JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT NOT LOCAL COMMAND. DEF NTLOC DEC 9 * JMP POPTS * NTLOC ASC 9,NOT LOCAL COMMAND DISCN ASC 10,LINK IS DISCONNECTED "IO" ASC 1,IO "01" ASC 1,01 "05" ASC 5,05 SKP * TR PROCESSOR. * * TRANSFER CONTROL TO LU OR DISK FILE. * M0400 JSB CKUDC CHECK FOR NON-RMOTE COMMAND. JSB CLSFL CLOSE DISC FILE, IF OPEN. * JS$B PNAMR PARSE NAMR. DEF NAME LDA STATS ISOLATE STATUS AND D3 BITS. SZA,RSS IF NOT SPECIFIED, CCA,RSS SIMULATE "TR,-1". LDA NAME SZA,RSS IS PARAMETER ZERO? JMP INVAL YES...INVALID! SSA,RSS NEGATIVE INTEGER? JMP M1220 NO. * * BACK UP THROUGH TRANSFER STACK. * LDB P.STK TOP OF STACK? BKUP CPB STKHD JMP M0501 YES. SIMULATE "EX" REQUEST. ADB MD6 NO. BACK UP 1 ENTRY. INA,SZA JMP BKUP LOOP TILL DONE. STB P.STK SET NEW STACK ADDRESS. JMP M1250 GO CHECK FOR FILE. * * ADD NEW CONTROL TO THE TRANSFER STACK. * M1220 LDA P.STK BUMP TO NEXT ENTRY. ADA D6 M1221 STA P.STK CHECK FOR CPA STKEN END OF STACK. RSS JMP M1230 JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT STACK OVERFLOW. DEF STKOV DEC 9 * JMP POPTS POP TO TOP OF STACK. * M1230 LDB NAME STORE LU OR FILE NAME. STB A,I INA LDB NAME+1 STB A,I INA LDB NAME+2 STB A,I INA CLB,INB SET RECORD NUMBER TO 1. STB A,I INA LDB SECU STORE SECURITY. STB A,I INA LDB CRN STORE CART NO. STB A,I * * IF DISK FILE, OPEN AND OPTIONALLY POSITION. * M1250 LDA P.STK,I AND HB377 SZA,RSS JMP QUERY LU. GO GET NEXT REQUEST. * STA LUTYP SET INPUT TYPE NON-INTERACTIVE. LDA P.STK PICK UP ADA D4 SECURITY LDB A,I AND STB SECU CARTRIDGE INA NUMBER. LDB A,I STB CRN * JSB OPEN OPEN THE FILE. DEF *+7 DEF DCB DEF ERROR DEF P.STK,I DEF D0 DEF SECU DEF CRN * JSB CKRTE CHECK FILE ERROR. JMP POPTS (ERROR RETURN) * d LDA P.STK POSITIONING REQUIRED? ADA D3 LDB A,I CPB D1 (REC. CNT MORE THAN 1?) JMP QUERY NO. STB TEMP YES. * JSB POSNT POSITION TO NEXT RECORD. DEF *+5 DEF DCB DEF ERROR DEF TEMP NUR GREATER THAN ZERO. DEF TEMP ABSOLUTE RECORD NUMBER. * JSB CKRTE CHECK FOR ERRORS. JMP POPTS (ERROR FOUND) JMP QUERY * SPC 5 * * TRANSFER STACK: * FOR EACH ENTRY, WORD 1 = INTEGER LU OR * FIRST 2 FNAME CHAR. * WORD 2,3 = REST OF FNAME. * WORD 4 = NEXT RECORD NUMBER. * WORD 5 = SECURITY CODE * WORD 6 = CARTRIDGE NUMBER * P.STK NOP STACK POINTER. STKHD DEF *+1 * BSS 48 8 ENTRIES. * STKEN DEF * STACK LWA+1. * STKOV ASC 9,TR STACK OVERFLOW SKP * * EX PROCESSOR * * TERMINATE THE OPERATOR INTERFACE PROGRAM. * M0500 JSB CKUDC CHECK FOR NON-RMOTE COMMAND. M0501 LDA D$SMP CHECK IF A "HELLO" IS OUTSTANDING. SZA,RSS JMP M0510 NO. * JSB LOGOF YES. ISSUE AN AUTO BYE. SZA,RSS CHECK FOR ERRORS. JMP M0510 NONE. JSB PRINT ERROR FROM "BYE". DEF BYMSG D9 DEC 9 * M0510 JSB PRINT DISPLAY TERMINATION MESSAGE DEF TRMSG ON LOG DEVICE. DEC 5 * JSB CLSFL CLOSE OPEN FILES. * JSB EXEC EXIT. DEF *+2 DEF D6 * BYMSG ASC 9, AUTO "BYE" FAILED TRMSG ASC 5,END RMOTE SKP * * PROCESSOR FOR "RU" COMMAND TRAP. IF ENTERED UNDER THE LOCAL * PROMPT, AND 5TH PARAM IS NOT SPECIFIED, PASS SESSION NUMBER * AS 5TH SCHEDULE PARAMETER. * M0600 LDA RPRMP IF REMOTE PROMPT, CPA PROMP JMP OTHER LET IT GO BY. JSB PNAMR PARSE PROGRAM DEF NAME NAME. JSB PNM1 PARSE FIRST PARAMETER. LDA OPP IF "RW" COMMAND, CPA "RW" SKIP THE JMP CKST "NOW" CHECK. CPB "NO" IF "NOW", JMP OTHER LET IT GO. CKST LDA STAT1 IF NOT PROVIDED, AND D3 SZA,RSS LDB DEFLU USE DEFAULT LU. STB TEMP1 JSB PNM1 PARSE SECOND PARAMETER. STB TEMP2 JSB PNM1 PARSE THIRD PARAMETER. STB TEMP3 JSB PNM1 PARSE FOURTH PARAMETER. STB TEMP4 JSB PNAMR PARSE FIFTH PARAMETER. DEF P1 LDB D$SMP CMB,INB LDA STAT1 IF NOT PROVIDED, AND D3 SZA,RSS STB P1 USE NEGATIVE SMP NUMBER. * LDA IOLEN MAKE # OF CMA,INA BYTES STA IOLEN NEGATIVE. * LDA SD9 CHECK WHETHER LDB OPP ICODE SHOULD BE CPB "RW" QUEUE WITH WAIT LDA SD23 ("RW" COMMAND) OR STA TEMP SCHEDULE WITH WAIT. * JSB EXEC SCHEDULE THE PROGRAM WITH WAIT. DEF *+10 DEF TEMP ICODE: 9 (SCHEDULE) OR 23 (QUEUE) DEF NAME PROGRAM NAME. DEF TEMP1 SCHEDULE PARAMETERS. DEF TEMP2 DEF TEMP3 DEF TEMP4 DEF P1 DEF INBUF DEF IOLEN JMP SCERR ERROR RETURN. * SZA,RSS NORMAL RETURN. JMP QUERY LDA PGBZY PROGRAM WAS BUSY. JMP SCMSG * SCERR CPA "SC" RSS JMP SCM1 NOT A SCHEDULING ERROR. LDA DSC03 CPB "03" JMP SCMSG "ILLEGAL STATUS" LDA DSC05 CPB "05" JMP SCMSG "NO SUCH PROG" LDA DSC10 CPB "10" JMP SCMSG "NOT ENOUGH SAM" SCM1 LDA @RQFL "REQUEST FAILED" SCMSG STA SCM2 JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT SCM2 NOP DEC 7 JMP POPTS * DSC03 DEF *+1 ASC 7,ILLEGAL STATUS * DSC05 DEF *+1 ASC 7,NO SUCH PROGRM * PGBZY DEF *+1 ASC 7,PROGRAM VBUSY * DSC10 DEF *+1 ASC 7,NOT ENOUGH SAM * @RQFL DEF RQFL SD9 DEF 9,I SD23 DEF 23,I "SC" ASC 1,SC "03" ASC 1,03 "10" ASC 1,10 "NO" ASC 1,NO SKP * * PROCESSOR FOR LL COMMAND. CHANGE $STDLIST DESTINATION (D$LOG). * M0700 JSB CHKP1 MAKE SURE P1 IS NUMERIC. LDA P1 LOAD LU. AND B77 REMOVE CONTROL BITS. STA D$LOG CHANGE $STDLIST DESTINATION. JSB LOKLU LOCK $STDLIST LU. LDA D$LOG ADD "PRINT IOR B600 COLUMN 1" BIT STA LULOG AND STORE LULOG. JMP QUERY SPC 3 * * PROCESSOR TO CHANGE SEVERITY CODE. * M0800 JSB CHKP1 MAKE SURE P1 IS NUMERIC. LDA P1 MAKE SURE ADA MD3 IT'S BETWEEN SSA,RSS 0 AND 2. JMP INVAL LDA P1 SET SEVERITY STA SEVER CODE. JMP QUERY SPC 3 * * COMMON CODE FOR LL AND SV PROCESSORS. CHECKS P1. * CHKP1 NOP ENTRY JSB CKUDC CHECK FOR NON-RMOTE COMMAND. JSB PNAMR PARSE PARAMETER. DEF P1 LDA P1 NEGATIVE? SSA JMP INVAL INVALID! LDA STAT1 WAS AND D3 IT CPA D1 NUMERIC? JMP CHKP1,I YES--RETURN. * INVAL JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT DISPLAY "INVALID INPUT". DEF INVLM DEC 7 JMP POPTS POP THE TRANSFER STACK. * INVLM ASC 7, INVALID INPUT SKP * * STORAGE AND CONSTANTS * SPC 1 ************************************* WARNING: DO NOT CHANGE ORDER OF * * "NAME" THROUGH "SEVER". * RTE FILE NAMR PARAMETERS * NAME BSS 3 * STATS BSS 1 * SECU BSS 1 * CRN BSS 1 * TYPE BSS 1 * SIZE BSS 1 * RLENG BSS 2 * * * * ALTERNATE PARSE BUFFER * P1  BSS 3 * STAT1 BSS 1 * P2 BSS 6 * * * * SEVERITY CODE * SEVER NOP * ************************************* END OF #PKUP PARAMETER BLOCK SPC 1 B20 OCT 20 B377 OCT 377 HB377 BYT 377,0 MD2 DEC -2 MD3 DEC -3 MD6 DEC -6 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D8 DEC 8 SD1 DEF 1,I SD2 DEF 2,I "00" ASC 1,00 SMPNM NOP ERROR NOP TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP IOLU NOP LUTYP NOP EQ. TYPE OF INPUT DEVICE. LULOG NOP LU OF LOG DEVICE. A.TR ASC 2,$TR TR COMMAND WITH CURRENT PROMPT CHAR. LPRMP ASC 1,$_ "$" PROMPT FOR LOCAL RTE. RPRMP ASC 1,#_ "#" PROMPT FOR REMOTE 3000. PROMP ASC 1, CURRENT OPERATOR PROMPT. BLANK BYT 40,0 DEFLU BSS 1 DEFAULT LU. ERRLU BSS 1 ERROR LU. SKP *** SUBROUTINES *** SPC 2 * SUBROUTINE TO CHECK FOR RTE FILE ERROR * CALLING SEQUENCE: JSB CKRTE * * * CKRTE NOP ENTRY POINT. ISZ CKRTE SET NORMAL RETURN. LDA ERROR IF ERROR SSA,RSS >= 0, JMP CKRTE,I RETURN. CMA,INA USE ABSOLUTE STA ERROR VALUE OF ERROR. JSB ECHP2 ECHO IF SEVERITY=2. * JSB KCVT CONVERT TO ASCII. DEF *+2 DEF ERROR IOR "00" STA RTERR JSB PRINT PRINT DEF RERMS ERROR DEC 9 MESSAGE. CCA TAKE ADA CKRTE ERROR JMP A,I RETURN. * RERMS ASC 8,RTE FILE ERROR - RTERR BSS 1 SPC 3 * SUBROUTINE TO ECHO LAST INPUT IF SEVERITY IS 2 * CALLING SEQUENCE: JSB ECHP2 * ECHP2 NOP ENTRY. LDA D2 JSB ECHPR JMP ECHP2,I RETURN. SKP * * SUBROUTINE TO READ A RECORD. * CALLING SEQUENCE: * L(DA * JSB READ * DEF * DEF * ERRTN NOP EFRTN NOP READ NOP ENTRY. STA IOLU SAVE INPUT INDICATOR. LDB READ,I PICK UP STB ERRTN RETURN ISZ READ ADDRESSES. LDB READ,I STB EFRTN ISZ READ AND HB377 NON ZERO IF FILE NAME, ELSE LU. SZA JMP FLRD DISK FILE. * LDA IOLU JSB EQTYP CHECK TYPE. STA LUTYP LDB MD768 ASSUME 768 MAX CHAR READ. SZA JMP LURD LU NOT INTERACTIVE. * JSB REIO DISPLAY PROMPT ON INTERACTIVE DEVICE. DEF *+5 DEF D2 DEF IOLU DEF PROMP DEF D1 * LDA IOLU SET ECHO BIT. IOR B600 STA IOLU LDB MD80 USE 80 CHARACTER READ. * * READ OPERATOR REQUEST FROM CURRENT DEVICE OR FILE. * LURD STB RDLEN STORE NUMBER OF CHARACTERS. JSB REIO LU READ. DEF *+5 DEF SD1 DEF IOLU DEF INBUF DEF RDLEN RSS JMP RDOK IF ERROR ON INPUT LU, JSB EROUT PRINT MESSAGE. JMP ERRTN,I TAKE ERROR RETURN. * RDOK STA TEMP SAVE STATUS WORD. STB IOLEN SAVE BYTE COUNT. JSB EOFCK CHECK FOR END OF FILE. JMP EFRTN,I GOT IT. JMP READ,I NORMAL RETURN. * FLRD JSB READF DISK FILE. DEF *+6 (OPENED WHEN FIRST TRANSFER DEF DCB WAS PERFORMED) DEF ERROR DEF INBUF DEF D384 DEF IOLEN ACTUAL WORD COUNT. * JSB CKRTE CHECK FOR ERRORS. JMP ERRTN,I ERROR RETURN. * LDA IOLEN IF EOF, INA,SZA,RSS JMP EFRTN,I TAKE EOF RETURN. LDA IOLEN SET IOLEN TO CLE,ELA NUMBER OF STA IOLEN BYTES. JMP READ,I NORMAL RETURN. SPC 1 D384 DEC 384 MD768 DEC -768 MD80 DEC -80 RDLEN NOP SKP * * SEND OPERATOR COMMAND (ASCII STRING) TO HP3000. * * CALLING SEQUENCE: * * JSB CMNDS * DEF *+3 * DEF BUFA ADDR OF ASCII STRING. * DEF BUFL POS. # BYTES IN STRING. * PARMS NOP ADDR OF ASCII COMMAND STRING. NOP LENGTH OF ASCII STRING (+BYTES). * CMNDS NOP JSB .ENTR GET PARAM ADDRESSES. DEF PARMS CLA CLEAR ERROR CODE STORAGE. STA D$ERR STA D$ERR+1 * * BEGIN CONSTRUCTION OF REQUEST BUFFER WITH * CLASS, STREAM, AND BYTE LENGTH. * LDA D3 STORE MESSAGE CLASS = 3. STA D$3BF LDA B20 STORE STREAM TYPE = 20 OCTAL. STA D$3BF+2 LDA PARMS+1,I SET BYTE COUNT IN REQUEST. STA D$3BF+7 * * MOVE ASCII MESSAGE TO REQUEST BUFFER. * INA ROUND UP NUMBER OF BYTES. CLE,ERA MAKE WORDS. STA TEMP LDA PARMS SOURCE ADDRESS OF COMMAND. LDB D$RQB DESTINATION ADDRESS. ADB D8 * JSB .MVW DEF TEMP NOP * * SET UP INPUT LU FOR $STDIN REQUESTS. * LDA P.STK,I IF CURRENT INPUT IS A LOGICAL UNIT, STA B USE IT. IF NOT, USE DEFAULT LU. AND HB377 SZA LDB DEFLU LDA B REMOVE ANY AND B77 CONTROL BITS. STA D$INP * * SEND REQUEST TO THE 3000 BY WRITING TO * QUEX'S CLASS, AND WAIT FOR THE REPLY. * JSB D3KMS SHIP THE REQUEST BUFFER TO QUEX. DEF *+2 NO ABORT IF ERROR. DEF CONWD LONG TIMEOUT. JMP RFAIL REQUEST FAILED. * JMP CMNDS,I RETURN. * CONWD OCT 140000 SPC 4 * * SUBROUTINE TO RELEASE ANY LOCKED LUS, THEN LOCK D$LOG. * CALLING SEQUENCE: JSB LOKLU * LOKLU NOP ENTRY. JSB LURQ UNLOCK DEF *+4 ANY DEF UNLOK LUS DEF D$LOG HELD. DEF D1 NOP * LDA D$LOG IF INTERACTIVE, c JSB EQTYP SZA,RSS JMP LOKLU,I RETURN. * JSB LURQ LOCK DEF *+4 D$LOG. DEF LOCK DEF D$LOG DEF D1 D0 NOP JMP LOKLU,I RETURN. * UNLOK OCT 140000 LOCK OCT 40001 SKP * * SUBROUTINE TO TEST FOR END OF FILE ON VARIOUS DEVICES. * CALLING SEQUENCE: * * * JSB EOFCK * * * EOFCK NOP ENTRY. CLE LDA LUTYP EOF DEPENDS ON DEVICE. SZA,RSS JMP EOF5 INTERACTIVE. (NO EOF.) CPA D1 JMP EOF1 PHOTOREADER. CPA D9 JMP EOF4 CARD READER. CPA D13 JMP EOF4 MARK SENSE. CCE DEFAULT TO MAG TAPE. * EOF1 LDA TEMP GET STATUS WORD. ALF,ALF SEZ,RSS IF E=1, CHECK BIT 7. JMP EOF2 SSA JMP EOF6 EOF2 RAL,RAL CHECK BIT 5. SSA,RSS JMP EOF5 NO EOF. * EOF4 LDA IOLEN CHECK FOR BLANK CARD. SZA EOF5 ISZ EOFCK EOF6 JMP EOFCK,I SKP * * KILL LEADING BLANKS IN COMMAND. * BLKIL NOP ENTRY POINT. LBLNK LDA INBUF CHECK FOR LEADING BLANK AND HB377 (OK FOR RTE, BUT NG FOR 3000). CPA BLANK RSS JMP BLKIL,I NONE. RETURN. * LDA DINBF ADDRESS OF ASCII COMMAND. STA TEMP1 SOURCE POINTER. STA TEMP2 DESTINATION POINTER. LDA IOLEN CMA,INA STA TEMP3 NEGATIVE # BYTES. LDB TEMP1,I PRIME THE PUMP. ISZ TEMP1 * LOOP1 LDA TEMP1,I MOVE STRING LEFT ONE BYTE. RRL 8 STB TEMP2,I ISZ TEMP2 RRL 8 ISZ TEMP1 ISZ TEMP3 JMP LOOP1 LOOP TILL DONE. * CCA SUBTRACT 1 FROM ADA IOLEN CHARACTER COUNT. STA [HIOLEN SZA CHECK FOR ZERO LENGTH. JMP LBLNK GO LOOK FOR ANOTHER LEADING BLANK. * JMP QUERY ALL BLANKS. GET NEXT COMMAND. SKP * * SUBROUTINE TO FIND EQUIPMENT TYPE OF AN LU. * RETURN DRIVER TYPE, OR 0 FOR INTERACTIVE LU. * CALLING SEQUENCE: LDA * JSB EQTYP * EQTYP NOP ENTRY. STA TEMP1 * JSB IFTTY CALL SYSTEM DEF *+2 ROUTINE TO DEF TEMP1 CHECK LU. SZA JMP TTY NON-INTERACTIVE-- LDA B PLACE DEVICE ALF,ALF TYPE IN AND B377 A-REG. JMP EQTYP,I RETURN. TTY CLA INTERACTIVE. TYPE=0. JMP EQTYP,I SPC 3 * * SUBROUTINE TO PRINT A RECORD ON LULOG. * CALLING SEQUENCE: JSB PRINT * DEF * DEC * PRINT NOP ENTRY POINT LDA PRINT,I PICK STA MSG UP ISZ PRINT PARAMETERS. LDA PRINT STA MSLEN ISZ PRINT SET RETURN ADDR. DOPRT JSB REIO CALL REIO FOR WRITE. DEF *+5 DEF SD2 DEF LULOG MSG NOP MSLEN NOP RSS JMP PRINT,I RETURN. * LDA ERRLU PRINT ERROR: IF ERROR CPA LULOG LU IS DIFFERENT FROM JMP PRINT,I LOG LU, STORE ERROR STA LULOG LU AS LOG LU AND JMP DOPRT DO THE PRINT AGAIN. SKP * RESULT OF BAD INPUT LU/FILE: * CLOSE COMMAND FILE (IF OPEN) * TERMINATE IF INPUT IS NON-INTERACTIVE. * POPTS LDA LUTYP IF CURRENT INPUT SZA,RSS IS INTERACTIVE, JMP QUERY EVERYTHING IS OK. JSB CLSFL CLOSE COMMAND FILE (IF ONE IS OPEN). * LDA STKHD STA P.STK RESET STACK POINTER. * LDA P.STK,I IF INPUT AND HB377 IS FROM SZA A FILE, JMP M0501 TERMINATE. LDA P.STK,I IF INPUT LU JSxB EQTYP IS NOT SZA INTERACTIVE, JMP M0501 TERMINATE. JMP QUERY TRY TO READ AGAIN. SPC 3 * SUBROUTINE TO PRINT ERROR MESSAGE. * CALLING SEQUENCE: * JSB EROUT * EROUT NOP ENTRY. DST EMSG+3 SET UP MESSAGE. JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT PRINT ON LULOG. DEF EMSG D5 DEC 5 JMP EROUT,I RETURN. * EMSG ASC 5,RMOTE SPC 3 * SUBROUTINE TO ECHO LAST INPUT. * CALLING SEQUENCE: LDA * JSB ECHPR * * ECHPR NOP ENTRY. CPA SEVER IF SEVERITY CODE RSS NOT = A-REGISTER, JMP ECHPR,I DON'T ECHO. LDA IOLEN CMA,INA STA TEMP4 JSB PRINT PRINT ON LULOG. DEF INBUF TEMP4 NOP JMP ECHPR,I RETURN SPC 3 * SUBROUTINE TO CLOSE THE FILE OPEN TO DCB, IF OPEN. * CALLING SEQUENCE: JSB CLSFL * CLSFL NOP JSB CLOSE CLOSE THE FILE. DEF *+2 DEF DCB JMP CLSFL,I RETURN. SPC 3 * SUBROUTINE TO CALL PNAMR WITH P1 BUFFER PNM1 NOP ENTRY. JSB PNAMR DEF P1 LDB P1 LOAD PARAMETER. JMP PNM1,I RETURN. SPC 2 * SUBROUTINE TO CALL NAMR PARSE ROUTINE * CALLING SEQUENCE: * JSB PNAMR * DEF * IPBUF NOP PNAMR NOP ENTRY POINT LDA PNAMR,I PICK UP STA IPBUF BUFFER ADDRESS. ISZ PNAMR SET RETURN. JSB NAMR CALL DEF *+5 NAMR DEF IPBUF,I ROUTINE. DEF INBUF DEF IOLEN DEF PNTR JMP PNAMR,I RETURN. SPC 2 PNTR NOP COLUMN POINTER SPC 1 DCB BSS 144 SPC 1 *** DO NOT CHANGE ORDER OF "IOLEN" AND "INBUF" *********** IOLEN NOP INPUT LENGTH (BYTES) * INBUF BSS 384 INPUT BUFFER * ********************************************************** SKP UNL IFZ ***** LST * * PROCESSOR FOR MOVE COMMAND * M0900 JSB CKUDC CHECK FOR NON-RMOTE COMMAND. LDA D$SMP IF NO HELLO SZA,RSS ISSUED, JMP NHLLO REPORT ERROR. CLA SET RECORD STA COUNT COUNT TO ZERO. LDA SLFLG IF SLAVE IS THERE, SZA SKIP POPEN. JMP CLOSF * LDA MAXBF IF MAX BUFFER SZA,RSS SIZE IS ZERO, JMP NOSPC ERROR! STA TAG10 SET MAX LENGTH. JSB POPEN OPEN SLAVE. DEF *+6 DEF PCB DEF ERROR DEF SNAME DEF NOD3K DEF TAG JSB CHKDS CHECK FOR DS ERROR. ISZ SLFLG SET SLAVE-OPEN FLAG. * CLOSF JSB CLSFL CLOSE COMMAND FILE SO DCB CAN BE USED. CLA DISABLE "BREAK" STA D$BRK AND "CONTROL-Y" STA D$CTY CHECKS. * LDA PROMP IF PROMPT CPA RPRMP IS REMOTE, JMP FRRMO GO MOVE FROM 3000. SPC 1 ** MOVE FILE FROM LOCAL TO REMOTE SYSTEM * * OPEN RTE SOURCE FILE LDA IPRMP CHANGE PROMPT TO "/" IN CASE STA PROMP INPUT IS FROM AN LU. JSB PNAMR GET NAMR DEF NAME PARAMETERS. LDA STATS IF FILE AND D3 WAS SPECIFIED CPA D3 SPECIFIED, JMP OP1KF DO THE OPEN. LDA NAME IF LU IS SSA NEGATIVE, JMP BADLU REPORT BAD LU. JMP CRMPE * OP1KF LDA HB377 STA LUTYP SET LU TYPE = FILE. *+ CALL OPEN(DCB,ERROR,NAME,B610,SECU,CRN) JSB OPEN + DEF *+07 + DEF DCB + DEF ERROR + DEF NAME + DEF B610 + DEF SECU + DEF CRN + JSB CKRTE FILE ERROR? JMP ABEND YES. * * CREATE MPE FILE CRMPE JSB GMPNM GET MPE FORMALDESIGNATOR. JSB PNAMR PICK UP MOVE MODE. DEF P1 * LDA P1 IF USER SPECIFIED CPA "UN" UNNUMBERED FORMAT, RSS JMP TEST2 LDB D4 FOPTN := 4 JMP STFOP (FIXED LEN, ASCII). TEST2 LDB B100 ELSE, IF RTE SOURCE LDA ERROR FILE IS ASCII CPA D4 (TYPE = 4), LDB B104 FOPTN := OCTAL 104 STFOP STB TAG (VARIABLE LEN, ASCII). * (OTHERWISE FOPTN := OCT 100, VAR. LEN, BINARY) * LDA P2 DID USER CPA "SP" SPECIFY RTE SPOOL FILE JMP SETCC CPA "CC" OR CARRIAGE CONTROL? JMP SETCC JMP STRLN NO--GO SET RECORD LENGTH. SETCC LDA TAG YES--SET CCTL BIT IN FOPTIONS. IOR B404 STA TAG * STRLN CLB IF "UNNUMBERED" LDA P1 FORMAT SPECIFIED, CPA "UN" SET RECORD LENGTH LDB D40 TO 40. OTHERWISE USE 0. * * SEND TAG FIELDS AND NAME TO SLAVE. LDA D3 TAG(1) = 3 (FOR WRITE). JSB SNDWR * CLA SET TOTAL LENGTH STA TOTLN TO ZERO. * * IF TAG9 = 0, FILE ALREADY EXISTED. OK TO DESTROY DATA? LDA TAG9 SZA JMP LLOOP JSB OVER? ASK: "OVERWRITE?" CPA "Y" IF YES, JMP LLOOP GO TRANSFER FILE. JMP ABEND OTHERWISE, CLOSE BOTH FILES. * * MAIN TRANSFER LOOP... LLOOP LDA NAME READ A JSB READ RECORD. DEF ABEND (ERROR RETURN) DEF I0000 (EOF RETURN) LDA LUTYP SPECIAL CHECK: IF IOR IOLEN INTERACTIVE AND SZA,RSS LEN = 0, TAKE THE JMP I0000 EOF RETURN. ISZ COUNT BUMP RECORD COUNT. NOP JSB CONT CONTINUE? LDA TAG11 IF RTE FILE IS CPA "SP" SUPPOSED TO BE JSB CKSPL SPOOLED, CHECK IT. *  LDB IOLEN CALCULATE WORD LENGTH := ADB D3 (BYTE LENGTH + 3)/2 CLE,ERB (ALLOW FOR ODD BYTE & STB WRDLN COUNT WORD). * IF WRDLN + TOTLN > TAG10 ADB TOTLN LDA TAG10 CMA,INA ADA B SZA SSA JMP I0001 *+ CALL PWRIT(PCB,ERROR,BUFER,TOTLN,TAG) JSB PWRIT + DEF *+06 + DEF PCB + DEF ERROR + DEF BUFER,I DEF TOTLN + DEF TAG + JSB CHKDS CHECK FOR DS ERROR. CLA RESET TOTAL STA TOTLN LENGTH. *+ END I0001 EQU * LDA @REC MOVE RECORD LDB BUFER TO BUFFER. ADB TOTLN JSB .MVW DEF WRDLN NOP *+ TOTLN := TOTLN + WRDLN LDA TOTLN + ADA WRDLN + STA TOTLN + *+ ELSE JMP LLOOP * * IOLEN < 0--END OF FILE. WRITE LAST XFER BUFFER. *+ TAG3 := -1 I0000 CCA STA TAG3 + *+ CALL PWRIT(PCB,ERROR,BUFER,TOTLN,TAG) JSB PWRIT + DEF *+06 + DEF PCB + DEF ERROR + DEF BUFER,I DEF TOTLN + DEF TAG + JSB CHKDS CHECK FOR DS ERROR. *+ END JMP EOF SPC 3 *** CODE TO INTERPRET FIRST COLUMN OF MPE RECORD AS CARRIAGE CONTROL *** SPC 1 CCTL LDA BUFAD,I ISOLATE FIRST AND HB377 CHARACTER. ALF,ALF MOVE TO RIGHT BYTE. STA CNTRL CPA PLUS "+"? JMP HPLUS YES. * ADA MB200 IF LESS THAN SSA OCTAL 201, JMP SCHTB TRY TABLE SEARCH. ADA MB67 IF LESS THAN SSA OCTAL 270, JMP SKIPN SKIP N LINES. ADA MB10 IF LESS THAN SSA OCTAL 300, JMP SKIPM SKIP TWO TIMES. * * SEARCH TABLE SCHTB LDB STTBL POINT TO BEGINNING OF TABLE. LOOP3 LDA B,I GET ENTRY. XOR CNTRL IS IT WHAT AND B377 WE'RE LOOKING FOR? | SZA,RSS JMP FOUND INB NO--BUMP POINTER JMP LOOP3 AND STAY IN LOOP. * FOUND CPB ENTBL END OF TABLE? JMP GOWRT YES--GO WRITE. LDA B,I GET RTE CONTROL AND HB377 WORD. ALF,ALF DCNTR JSB DOCTL PERFORM I/O CONTROL. LDA IOLEN IF RECORD ONLY CPA D1 CONTAINED CONTROL, JMP BMPCT SKIP THE WRITE. JMP GOWRT GO WRITE. SPC 1 * CHANGE MPE "+" CONTROL TO RTE "*" HPLUS LDA BUFAD,I GET WORD. AND B377 MASK OUT LEFT BYTE. IOR STAR AND "*". STA BUFAD,I STORE. JMP GOWRT GO WRITE. SPC 1 *** LINE SKIPPING *** * * SKIP 56-63 LINES... SKIPM LDA D55 SKIP 55 JSB DOCTL LINES. LDA CNTRL SUBTRACT 55 ADA MD55 FROM MPE CONTROL. RSS CONTINUE IN "SKIPN" * * SKIP 1-55 LINES... SKIPN LDA CNTRL SUBTRACT OCTAL 200 ADA MB200 FROM MPE CCNTL. JMP DCNTR GO PERFORM CONTROL. SPC 1 * SUBROUTINE TO PERFORM LINE SPACING I/O CONTROL FUNCTION. * CALLING SEQUENCE: LDA * JSB DOCTL * DOCTL NOP ENTRY. STA CNTRL SAVE CONTROL WORD. LDA NAME SET CONTROL AND B77 BITS TO PERFORM IOR B1100 CONTROL FUNCTION. STA TEMP JSB EXEC CALL EXEC DEF *+4 FOR CONTROL. DEF SD3 DEF TEMP DEF CNTRL NOP IGNORE ERROR. JMP DOCTL,I RETURN. SKP * MOVE FILE FROM REMOTE TO LOCAL SYSTEM * FRRMO JSB GMPNM GET MPE FORMALDESIGNATOR JSB PNAMR GET NAMR DEF NAME PARAMETERS. JSB PNAMR PICK UP DEF P1 MOVE MODE. LDA NAME IF USER SPECIFIED AND HB377 RTE FILE AND LDB P2 ALSO CARRIAGE SZA CONTROL, SZB,RSS JMP OK JSB WARN WARN HIM AND CLA CLEAR OPTION. STA P2 * * SEND TAG FIELDS AND NAME TO SLAVE. OK CLB TAG(6) := 0 (RECLEN). LDA D2 TAG(1) := 2 (FOR READ). JSB SNDWR * (SLAVE SETS UP TAG WORDS 0 AND 8 TO BE FOPTIONS AND RECLEN.) * LDA STATS IF RTE AND D3 FILE WAS CPA D3 SPECIFIED, JMP OPN1K GO OPEN IT. * LDA NAME IF LU IS SSA NEGATIVE, JMP BADLU REPORT BAD LU. LDA SECU IF SPOOLING OPTION CPA "SP" FOR LU WAS SPECIFIED, JMP SETSP SET IT UP. * TYP0 CLA PRETEND IT'S TYPE 0 FILE. JMP SETYP SET TYPE AND GO MOVE. * * SPOOLING REQUESTED. SET UP SPOOLING FILE: RM SETSP JSB LUTRU GET "REAL" DEF *+2 LU NUMBER DEF D$LOG (IN CASE STA TEMP OF SESSION). JSB KCVT SET UP DEF *+2 DEF TEMP PORTION OF IOR "00" NAME. STA SPFIL+1 LDA D24 SET FILE STA SIZE LENGTH TO CLA 24 BLOCKS AND STA RLENG CLEAR RECORD LEN. LDA D100 SET UP STA TEMP3 SETNN JSB KCVT PORTION DEF *+2 OF NAME. DEF TEMP3 STA SPFIL+2 * LDA $SPCR SET CARTRIDGE NUMBER STA SPCRN IN SPOOL BUFFER. * JSB CREAT CREATE SPOOLING FILE DEF *+8 (TYPE = 3). DEF DCB DEF ERROR DEF SPFIL DEF SIZE DEF D3 DEF D0 DEF $SPCR LDA ERROR IF ERROR = -2, CPA MD2 (FILE EXISTS), JMP TRY2 TRY DIFFERENT . JSB CKRTE ERROR CREATING FILE? JMP ABEND YES! * * FILE CREATED... DLD SPFIL REPORT THE DST SPFLN SPOOL FILE LDA SPFIL+2 NAME TO STA SPFLN+2 THE USER. JSB PRINT DEF SPMSG  DEC 9 * JSB CLSFL CLOSE IT SO SMP CAN USE IT. LDA NAME SAVE LU AND NOT77 CONTROL STA MASK BITS. XOR NAME SAVE LU STA OUTLU NUMBER. JSB EQTYP SET DEVICE STA SPTYP TYPE. JSB SPOPN OPEN FILE DEF *+3 TO SMP. DEF SPBUF DEF ERROR JSB CKRTE ERROR? JMP ABEND YES. STA SPFLG SET SPOOL FLAG. IOR MASK ADD CONTROL BITS. STA NAME SET I/O LU TO SPOOL LU. JMP TYP0 SET TYPE & GO MOVE. * * DUPLICATE NAME. TRY AGAIN. TRY2 ISZ TEMP3 BUMP PART OF NAME. LDA TEMP3 IF UP TO CPA D200 200, RSS JMP SETNN JSB CKRTE ERROR! NOP JMP ABEND * * SEE IF RTE FILE ALREADY EXISTS BY TRYING TO OPEN IT. * CALL OPEN(DCB,ERROR,NAME,B610,SECU,CRN) OPN1K JSB OPEN DEF *+7 DEF DCB DEF ERROR DEF NAME DEF B610 DEF SECU DEF CRN LDA ERROR IF ERROR < 0, SSA TRY TO CREATE IT. JMP CRT1K STA TYPE SAVE TYPE. SZA,RSS IF TYPE 0 FILE, JMP SETYP GO MOVE. * FILE EXISTS. IS IT OK TO DESTROY EXISTING DATA? JSB OVER? ASK: "OVERWRITE?" CPA "Y" IF YES, JMP SETYP GO MOVE JMP ABEND OTHERWISE, CLOSE FILES. * CRT1K LDA TYPE IF TYPE SZA IS NOT JMP CKSIZ SPECIFIED, LDB D3 SET TYPE TO 3 LDA TAG UNLESS ASCII BIT AND D4 IS SET IN THE MPE SZA FOPTIONS. (THEN LDB D4 SET TYPE TO 4.) STB TYPE STB TAG2 * CKSIZ CCB IF SIZE WAS NOT LDA SIZE SPECIFIED, USE SZA,RSS NEGATIVE ONE. STB SIZE * LDB TAG6 IF RECORD LENGTH LDA RLENG WAS NOT SPECIFIED, SZA,RSS i USE MPE FILE'S. STB RLENG * * CALL CREAT(DCB,ERR1,NAME,SIZE,TYPE,SECU,CRN) JSB CREAT + DEF *+08 + DEF DCB + DEF ERR1 + DEF NAME + DEF SIZE + DEF TYPE + DEF SECU + DEF CRN + * LDA ERR1 IF CREATE ERROR IS -2, CPA MD2 IT'S MASKING THE TRUE RSS ERROR. OTHERWISE STORE STA ERROR IT AS THE FILE ERROR. * JSB CKRTE ERROR? JMP ABEND YES. * SETYP LDA TYPE SET TAG(2) TO STA TAG2 RTE FILE TYPE. * * MAIN TRANSFER LOOP. * CALL PREAD(PCB,ERROR,BUFER,TAG10,TAG) RLOOP JSB PREAD DEF *+6 DEF PCB DEF ERROR DEF BUFER,I DEF TAG10 DEF TAG JSB CHKDS CHECK FOR DS ERROR. LDA TAG7 SET TOTLN TO STA TOTLN LENGTH OF PREAD BUFFER. CLA STA I RESET INDEX (I := 0). * LOOP TO UNPACK THE PREAD BUFFER. LOOP2 LDA TOTLN IF TOTLN CMA,INA >= I, ADA I SSA,RSS DONE WITH JMP EOD? THIS BUFFER. LDA BUFER CALCULATE ADDRESS ADA I OF RECORD IN STA BUFAD PREAD BUFFER. ISZ BUFAD LDB A,I GET RECORD LENGTH STB IOLEN (BYTES). ADB D3 UPDATE INDEX CLE,ERB (WORD POINTER): ADB I STB I I := (IOLEN+3)/2 + I. * LDA TAG11 IF USER SPECIFIED CPA "CC" CARRIAGE CONTROL MAPPING, JMP CCTL GO DO IT. * GOWRT LDA NAME WRITE A JSB WRITE RECORD. DEF ABEND (ERROR RETURN) * BMPCT ISZ COUNT BUMP RECORD COUNT. NOP JSB CONT CONTINUE? JMP LOOP2 STAY IN LOOP UNTIL EOR. * * END OF DATA? EOD? LDA TAG3 IF TAG3 >= 0, SSA,RSS JMP RLOOP CONTINUE READING. * * END OF FILE. EOF LDA NAME IF RTE FILE AND HB377 NAME WAS SZA SPECIFIED, JMP CLS1K GO CLOSE IT. * LDA TAG1 IF OPERATION WAS CPA D3 WRITE, SKIP EOF JMP WTSLV AND SPOOL CHECK. * * WRITE END OF FILE IF DEVICE IS MAG TAPE OR LINE PRINTER. LDA NAME GET DRIVER JSB EQTYP TYPE. CPA B23 MAG TAPE? JMP MAGTP YES. CPA B12 LINE PRINTER? JMP LINEP YES. JMP CKSP1 NEITHER. * MAGTP LDB B100 FUNCTION CODE := 1. JMP CEXEC CALL EXEC. * LINEP LDB B1100 FUNCTION CODE := OCTAL 11. * CEXEC LDA NAME ADD LU (MINUS ANY CONTROL BITS) AND B77 TO FUNCTION CODE. IOR B STA TEMP3 JSB EXEC CALL EXEC FOR I/O CONTROL. DEF *+4 DEF SD3 DEF TEMP3 DEF MD1 NOP IGNORE ERRORS. * CKSP1 LDA SPFLG SPOOLING SET UP? SZA,RSS JMP WTSLV NO--WAIT ON SLAVE. * JSB EXEC YES--RELEASE SPOOL FILE. DEF *+5 DEF D23 DEF "SMP" DEF D4 DEF SPFLG * CLA CLEAR SPOOLING STA SPFLG FLAG. JMP WTSLV WAIT FOR SLAVE. * * DETERMINE RTE TRUNCATION FOR FILE CLOSE. CLS1K CLA ITRUN := 0. STA ITRUN LDA SIZE IF SIZE WAS SSA,RSS NOT NEGATIVE, JMP CLFIL DON'T TRUNCATE. JSB LOCF DEF *+7 DEF DCB DEF ERROR DEF P1+1 DEF P1+2 IRB DEF P1+3 DEF P1+4 JSEC * ITRUN := JSEC/2 - IRB - 1 LDA P1+4 CLE,ERA LDB P1+2 CMB ADA B STA ITRUN * * CLOSE RTE FILE AND MPE SLAVE. *+ CALL CLOSE(DCB,ERROR,ITRUN) CLFIL JSB CLOSE + DEF *+04 + DEF DCB + DEF ERROR + DEF ITRUN + * * WAIT FOR SLAVE TO CLOSE FILE. WTSLV JSB PCONT DEF *+4 DEF PCB DEF ERROR DEF TAG JSB CHKDS * EOTR LDA PROMJP IF PROMPT WAS CPA IPRMP CHANGED TO "/", LDA LPRMP CHANGE BACK TO "$". STA PROMP CPA LPRMP IF SOURCE WAS REMOTE, JMP LDLCL LDA TAG12 READ COUNT = TAG12 LDB COUNT WRITE COUNT = COUNT JMP DONOR LDLCL LDA COUNT OTHERWISE READ=COUNT LDB TAG12 AND WRITE = TAG12. DONOR JSB PRNOR PRINT NUMBER OF RECORDS. CCA STA D$BRK RE-ENABLE "BREAK" STA D$CTY AND "CONTROL-Y". JMP M1250 REOPEN XFER FILE & GET COMMAND. SKP * ABNORMAL END. ABEND JSB PCONT SEND PCONTROL DEF *+4 TO TELL SLAVE DEF PCB TO SHUT DOWN. DEF ERROR DEF TAG CLA GET RID OF STA TAG4 ERROR THE STA TAG8 SLAVE SENDS. JMP EOF GO CLOSE FILE & SLAVE. SPC 3 * SUBROUTINE TO CHECK FOR DS/1000 OR MPE ERROR * CALLING SEQUENCE: JSB CHKDS * CHKDS NOP ENTRY POINT. LDA ERROR IF ERROR = 0, SZA,RSS JMP CHKDS,I RETURN. * WHAT KIND OF ERROR IS IT? CPA D1 IF ERROR = 1, JMP RERR SLAVE REJECTED. CPA MD41 IF ERROR = -41, JMP NOSLV SLAVE ISN'T THERE. CPA MD55 ID ERROR = -55, JMP PTMOT IT'S A TIMEOUT. * * PRINT THE DS/1000 ERROR MESSAGE. CMA,INA SINCE ERROR IS NEGATIVE, STA ERROR MAKE IT POSITIVE. * JSB KCVT DEF *+2 DEF ERROR IOR "00" STA DERR1 * JSB PRINT PRINT THE DEF DERMS ERROR MESSAGE. DEC 9 CKP LDA CHKDS IF CALL WAS MADE IN CPA @EOTR LAST PCONTROL, JMP EOTR GO PRINT # OF RECORDS. JMP ABEND CLOSE FILES. * @EOTR DEF EOTR DERMS ASC 8,DS/1000 ERROR - DERR1 BSS 1 * NOSLV JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT PRINT "NO DEF NSERR SLAVE" MESSAGE. DEC 8 JMP POPTS PO>P TO TOP OF STACK. * NSERR ASC 8,NO SLAVE AT 3000 SPC 1 NOSPC JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT PRINT "NO BUFFER DEF SPERR SPACE" MESSAGE. DEC 8 JMP POPTS POP TO TOP OF STACK. * SPERR ASC 8,NO BUFFER SPACE * PTMOT JSB PRINT PRINT DEF TOMSG "TIMEOUT" DEC 15 MESSAGE. JMP CKP GO CLEAN UP. * BADLU JSB ECHP2 ECHO IF SEVERITY=2. JSB PRINT PRINT DEF BLMSG "BAD LU" DEC 4 MESSAGE. JMP ABEND CLOSE SLAVE. * BLMSG ASC 4, BAD LU SKP * "REJECT" ERROR FROM SLAVE. TAG4 TELLS THE REASON: * 1 => SLAVE WAS EXPECTING DIFFERENT CALL. * 2 => DS/3000 ERROR. PCHECK CODE IN TAG8. * 3 => FILE SYSTEM ERROR. FCHECK CODE IN TAG8. * RERR LDA TAG4 WHY DID SLAVE REJECT? CPA D3 JMP FERR FILE ERROR. CPA D2 JMP D3KER DS/3000 ERROR. * OTHERWISE MASTER-SLAVE COMMUNICATIONS ERROR. JMP ENDCK CLOSE FILES. * *** DS/3000 ERROR D3KER JSB CNUMD CONVERT DEF *+3 FCHECK DEF TAG8 CODE. DEF DERR2 JSB PRINT PRINT DEF D3ERM MESSAGE. DEC 10 JMP ENDCK CLOSE FILES. D3ERM ASC 7,DS/3000 ERROR DERR2 BSS 3 * *** MPE FILE ERROR FERR JSB CNUMD DEF *+3 DEF TAG8 DEF MERR JSB PRINT PRINT DEF MERMS ERROR B12 DEC 10 MESSAGE. * ENDCK CLA RESET STA TAG4 ERROR STA TAG8 CODES. LDA CHKDS IF CALL WAS MADE IN CPA @EOTR LAST PCONTROL, JMP EOTR GO PRINT # OF RECORDS. JMP EOF CLOSE FILES. MERMS ASC 7,MPE FILE ERROR MERR BSS 3 SPC 3 * SUBROUTINE TO CHECK IF RECORD IS FROM SPOOL FILE. * CALLING SEQUENCE: JSB CKSPL * (IF RECORD IS NOT IN SPOOLING FORMAT, TAG11 IS SET TO 0) * CKSPL NOP ENTRY POINT. LDA IOLEN CALCULATE LENGTH CLE,ERA OF RECORD STA WRDLN IN WORDS. ADA MD2 INSURE LENGTH IS SSA >= 2. JMP BAD * LDA INBUF GET REQUEST TYPE AND B77 FROM FIRST WORD. CPA D3 = 3? JMP CTRQ YES--CONTROL REQUEST. CPA D2 = 2? JMP WRRQ YES--WRITE REQUEST. JMP BAD NEITHER. BAD REQUEST. * * CONTROL REQUEST CTRQ LDA WRDLN IS LENGTH CPA D2 = 2? JMP CKSPL,I YES. RETURN. * BAD CLA BAD RECORD: STA TAG11 CLEAR TAG 11. JSB WARN WARN USER. JMP CKSPL,I RETURN. * * WRITE REQUEST WRRQ LDA INBUF+1 CHECK DATA LENGTH. SSA,RSS JMP POSLN CMA,INA FOR NEGATIVE DATA LENGTH, INA MAKE POSITIVE # OF WORDS. CLE,ERA POSLN ADA D2 CPA WRDLN IF DATA LENGTH = RECORD LENGTH + 2, JMP CKSPL,I GOOD RECORD. JMP BAD (ELSE BAD.) SPC 3 * SUBROUTINE TO PRINT WARNING MESSAGE IF USER SPECIFIED AN ILLEGAL * OPTION. (ONLY PRINTS IF SEVERITY = 0.) * CALLING SEQUENCE: JSB WARN * WARN NOP ENTRY. LDA SEVER IF SEVERITY SZA IS NOT 0, JMP WARN,I RETURN. JSB PRINT PRINT MESSAGE. DEF WNMSG DEC 12 JMP WARN,I RETURN. * WNMSG ASC 12,WARNING--ILLEGAL OPTION. SKP * SUBROUTINE TO GET MPE FORMALDESIGNATOR * CALLING SEQUENCE: JSB GMPNM * @MPFN DBL MPFN NMLEN NOP NAME LENGTH. MPFN BSS 29 FORMALDESIGNATOR. OFSET NOP OFFSET INTO INBUF. * GMPNM NOP ENTRY POINT. LDA PNTR STORE NEGATIVE CMA,INA OF STARTING COLUMN STA NMLEN IN NMLEN. CMA STA OFSET SAVE # OF BYTES OFFSET. JSB PNAMR PARSE MPE NAME DEF P1 (DETERMINE # OF CHARS). CCA LDB IOLEN IF PNTR IS INB PzAST THE CPB PNTR LAST COLUMN, INA ADD ONE. ADA PNTR ENDING COLUMN ADA NMLEN MINUS FIRST COLUMN STA NMLEN IS NAME LENGTH. ADA MD28 SSA IF LENGTH IF > 28, JMP LENOK LDA D28 SET LENGTH TO STA NMLEN 28. * LENOK LDA @INBF MOVE THE CLE,ELA MPE ADA OFSET FILE'S LDB @MPFN FORMALDESIGNATOR. MBT NMLEN CLA STORE 0 AT SBT END OF STRING. JMP GMPNM,I RETURN. SKP * SUBROUTINE TO PRINT NUMBER OF RECORDS COPIED IF SEVERITY CODE=0. * CALLING SEQUENCE: LDA "READ" COUNT * LDB "WRITE" COUNT * JSB PRNOR * PRNOR NOP ENTRY POINT. STA TEMP1 SAVE READ STB TEMP2 AND WRITE COUNTS. LDA SEVER IF SEVERITY CODE SZA IS NOT ZERO, JMP PRNOR,I RETURN. JSB CNUMD CALL RTE DEF *+3 FOR NUMBER DEF TEMP1 CONVERSION. DEF RCNT JSB CNUMD CALL RTE DEF *+3 FOR NUMBER DEF TEMP2 CONVERSION. DEF WCNT JSB PRINT PRINT IT. DEF RCNT ABS CNTLN JMP PRNOR,I RETURN. * COUNT NOP NUMBER OF RECORDS. RCNT ASC 3, ASC 7, RECORDS READ, WCNT ASC 3, ASC 9, RECORDS WRITTEN. CNTLN EQU *-RCNT SPC 3 * SUBROUTINE TO CHECK BREAK FLAG AND ABEND DURING MOVE. * CALLING SEQUENCE: JSB CONT * CONT NOP ENTRY POINT. JSB IFBRK IF BREAK DEF *+1 FLAG NOT SZA,RSS SET, JMP CONT,I CONTINUE. LDA TAG3 IF EOF FLAG SZA SET, JMP CONT,I IGNORE BREAK. JMP ABEND OTHERWISE, CLOSE FILES. SKP * SUBROUTINE TO SEND CONTROL INFORMATION AND FILE NAME TO SLAVE. * CALLING SEQUENCE: LDA <2=READ, 3=WRITE> * LDB * JSB SNDWR * SNDWR NOP ENTRY POINT. STA TAG1 TAG(1) = OPERATION (READ OR WRITE). STB TAG6 TAG(6) = RECORD LENGTH. LDA TYPE TAG(2) = RTE FILE TYPE. STA TAG2 LDA P1 TAG(5) = UNNUMBERED FORMAT INDICATOR. STA TAG5 LDA P2 TAG(11) = SPOOL/CCTL INDICATOR STA TAG11 * REST ARE SET TO ZERO. CLA STA TAG3 STA TAG4 STA TAG7 STA TAG8 STA TAG9 STA TAG12 * SEND CONTROL VIA PWRIT(PCB,ERROR,MPFN,D29,TAG). JSB PWRIT DEF *+6 DEF PCB DEF ERROR DEF MPFN DEF D29 DEF TAG JSB CHKDS CHECK FOR DS ERROR. * PICK UP RESULT VIA PCONT(PCB,ERROR,TAG) JSB PCONT DEF *+4 DEF PCB DEF ERROR DEF TAG JSB CHKDS CHECK FOR DS ERROR. JMP SNDWR,I RETURN. SKP * * SUBROUTINE TO ASK "OVERWRITE?" AND READ RESPONSE. * CALLING SEQUENCE: JSB OVER? * * OVER? NOP ENTRY. JSB REIO ASK QUESTION. DEF *+5 DEF SD2 DEF ERRLU DEF OVRW? DEF D6 NOP IGNORE ERRORS. * JSB REIO READ RESPONSE. DEF *+5 DEF SD1 DEF ERRLU DEF INBUF DEF D1 NOP IGNORE ERRORS. * LDA INBUF LOAD RESPONSE. AND UMSK1 UPSHIFT LEFT BYTE & CLEAR RIGHT. JMP OVER?,I RETURN. * OVRW? ASC 6,OVERWRITE? _* UMSK1 OCT 157400 SKP * SUBROUTINE TO WRITE A RECORD. * CALLING SEQUENCE: * * * LDA * JSB WRITE * DEF * EWRTN NOP WRITE NOP ENTRY. STA IOLU SAVE OUTPUT INDICATOR LDB WRITE,I PICK UP ERnROR STB EWRTN RETURN ADDRESS. ISZ WRITE SET RETURN ADDRESS. AND HB377 NON-ZERO IF FILE NAME, ELSE LU. SZA JMP FLWR DISC FILE. * LDA IOLEN CONVERT LENGTH CMA,INA TO NEGATIVE. STA IOLEN JSB REIO WRITE ON LU. DEF *+5 DEF SD2 DEF IOLU DEF BUFAD,I DEF IOLEN RSS IF ERROR ON OUTPUT LU, JMP WRITE,I JSB EROUT PRINT MESSAGE AND JMP EWRTN,I TAKE ERROR RETURN. * FLWR LDA IOLEN CONVERT LENGTH INA TO WORDS. CLE,ERA STA IOLEN JSB WRITF WRITE ON FILE. DEF *+5 DEF DCB DEF ERROR BUFAD DEF *-* DEF IOLEN JSB CKRTE ERROR? JMP EWRTN,I YES. JMP WRITE,I NO. SKP SPC 3 *** STORAGE *** SPC 2 ERR1 NOP RTE FILE CREATE ERROR CODE. ITRUN NOP RTE TRUNCATION INDICATOR. TOTLN NOP TOTAL LENGTH OF BUFFERS READ. NOD3K NOP NEGATIVE LU OF 3000. I NOP INDEX INTO BUFER MASK NOP I/O CONTROL BITS WRDLN NOP RECORD LENGTH (WORDS) SPC 2 B404 OCT 404 "UN" ASC 1,UN "Y" BYT 131,0 "Y" IN LEFT BYTE * SNAME ASC 7,COPY3K.PUB.SYS 3000 SLAVE PROGRAM. NOP * SPC 1 PCB BSS 4 PROGRAM CONTROL BLOCK FOR SLAVE. SPC 1 * SLAVE TAG FIELD: TAG NOP MPE FOPTIONS TAG1 NOP OPERATION: 2=READ, 3=WRITE TAG2 NOP RTE FILE TYPE TAG3 NOP 0 UNTIL END OF FILE TAG4 NOP 0 UNTIL ERROR OCCURS TAG5 NOP "UN" FOR UNNUMBERED FORMAT TAG6 NOP MPE RECSIZE TAG7 NOP LENGTH OF DATA IN PREAD TAG8 NOP SPECIFIC ERROR CODE (USED WITH 4) TAG9 NOP OLD(0)/NEW(-1) FILE INDICATOR TAG10 NOP MAXIMUM P-TO-P BUFFER SIZE TAG11 NOP "SP" FORT RTE SPOOL FILE, "CC" FOR CCNTL TAG12 NOP NUMBER OF RECORDS COPIED BY MPE BSS 7 REST OF TAGS ARE NOT USED. SPC 1 STTBL DEF TABLE START OF TABLE. ENTBL DEF CNTRL END OF TABLE. * * RTE CONTROL ON LEFT, MPE CONTROL ON RIGHT TABLE BYT 100,102 BYT 101,103 BYT 77,300 BYT 76,301 BYT 70,302 BYT 71,303 BYT 72,304 BYT 73,305 BYT 74,306 BYT 75,307 BYT 76,310 BYT 103,311 BYT 104,312 BYT 105,313 CNTRL NOP * PLUS OCT 53 SPC 1 MAXBF NOP MAXIMUM P-TO-P BUFFER SIZE. BUFER NOP ADDRESS OF P-TO-P BUFFER. SPC 3 * SUBROUTINE TO CLOSE SLAVE PROGRAM, IF OPEN. * CALLING SEQUENCE: JSB CLSLV * CLSLV NOP ENTRY. LDA SLFLG IF SLAVE IS SZA,RSS NOT OPEN, JMP CLSLV,I RETURN. JSB PCLOS CLOSE SLAVE. DEF *+3 DEF PCB DEF ERROR CLA CLEAR SLAVE STA SLFLG FLAG. JMP CLSLV,I RETURN. SPC 4 * * THESE CONSTANTS ARE USED ONLY FOR MOVE COMMAND. * MB10 OCT -10 MB67 OCT -67 MB200 OCT -200 B23 OCT 23 B100 OCT 100 B104 OCT 104 B610 OCT 610 B1100 OCT 1100 NOT77 OCT 177700 MD1 DEC -1 MD28 DEC -28 MD41 DEC -41 MD55 DEC -55 D23 DEC 23 D24 DEC 24 D28 DEC 28 D29 DEC 29 D40 DEC 40 D55 DEC 55 D100 DEC 100 D200 DEC 200 SD3 DEF 3,I "SMP" ASC 3,SMP "SP" ASC 1,SP "CC" ASC 1,CC SLFLG NOP SLAVE-OPEN FLAG SPFLG NOP SPOOL FLAG IPRMP ASC 1,/_ "/" PROMPT FOR FILE MOVE INPUT. SPC 1 SPMSG ASC 6,SPOOL FILE: SPFLN ASC 3,RM SPC 1 ***** SPOOL BUFFER ***** SPBUF DEC 0 NO BATCH INPUT CHECKING NOP SPFIL ASC 3,RM SPOOLING FILE NAME DEC 0 SECURITY CODE SPCRN DEC 0 CARTRIDGE SPTYP NOP DEVICE TYPE OCT 402 DISPOSITION: WRITE-ONLY, HOLD OUTPUT. DEC m99 SPOOL PRIORITY NOP NOP NOP NOP NOP OUTLU NOP OUTPUT LU. UNL XIF ***** LST * BSS 0 **** SIZE OF RMOTE **** * END RMOTE  g& 91750-18169 2013 S C0122 &RMTIO              H0101 ASMB,R,L,C,Z ** ASSEMBLE FOR DS/1000 USAGE ** IFN HED FMTIO NAM FMTIO,7 24998-16002 REV.1926 790417 XIF IFZ HED DS/1000 I/O AND CONTROL FOR FRMTR *(C) HEWLETT-PACKARD CO. 1980* NAM RMTIO,7 91750-16169 REV 2013 800122 XIF UNL IFZ LST * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME: FMTIO ('N' ASSEMBLY OPTION) RMTIO ('Z' ASSEMBLY OPTION) * SOURCE: 24998-18002 91750-18169 * RELOC: 24998-16002 91750-16169 * PGMR: D.L.B./E.A.S./B.G. C.C.H./J.D.H. * * ** SEE ENTRY POINT 'DNODE' FOR DS/1000 MODIFICATIONS ** UNL XIF LST SPC 2 IFZ ENT DNODE EXT DEXEC,#NODE XIF SPC 2 ENT .IOI.,.IOJ.,.IOR. ENT .IIO.,.JIO.,.RIO.,.XIO.,.TIO. ENT .IAR.,.JAR.,.RAR.,.XAR.,.TAR. ENT .IAY.,.JAY.,.RAY.,.XAY.,.TAY. ENT .DIO.,.BIO.,.DTA. ENT NEWIO,OLDIO,CODE,ACODE,ITLOG,ISTAT,LGBUF EXT .FRMN,.LS2F,.INPN,.DTAN,FMT.E EXT PNAME,.SBT IFN EXT REIO,EXEC XIF * A EQU 0 B EQU 1 SPC 2 * SPECIAL ENTRY POINTS: * ************************************************************************ * ASSEMBLY FORTRAN (IV) * * JSB CODE CALL CODE(ICHRS) * DEF *+2 READ (IBUF,*) A,B,C * DEF ICHRS * LDA IBUFR(,I) * CLB(,INB) * JSB .DIO. * DEF FORMT * DEF ENDLS * * WHERE: * IBUFR = THE IN MEMORY BUFFER TO CONVERT TO BINARYA * ICHRS = THE NUMBER OF ASCII CHARACTERS IN " IBUFR " * * NOTES: * THE ENTRY POINT " CODE " IS NOW IN THE FORMATTER WHICH * ALLOWS THE OPTIONAL PARAMETTER " ICHRS " TO BE PASSED * TO LIMIT THE SIZE OF THE BUFFER THAT THE FORMATTER WILL * READ. IF " IBUFR " IS NOT PASSED, THEN THE FORMATTER WILL * SEARCH ALL OF MEMORY, IF NECESSARY, TO SATISFY THE VARIABLE * LIST. (A,B,C) SKP * JSB ITLOG ICHRS = ITLOG(IXXXX) * DEF *+1 * STA ICHRS * WHERE: * ICHRS = THE NUMBER OF CHARACTORS READ OR WRITTEN BY THE FORMATTER * BY ITS LAST INPUT/OUTPUT REQUEST TO THE SYSTEM. " ICHRS " VALUE * WILL BE 0 TO 134 (120 OF BINARY) REGARDLESS OF THE SPECIFIED * BUFFER SIZE IN THE READ OR WRITE STATEMENT. * IXXXX = THE SAME AS " ICHRS " *********************************************************************** * JSB ISTAT ISTUS = ISTAT(IXXXX) * DEF *+1 * STA ISTUS * WHERE: * ISTUS = THE STATUS WORD RETURNED FROM THE EXEC IN THE LAST * INPUT/OUTPUT CALL THE FORMATTER DID. * IXXXX = SAME AS " ISTUS " ************************************************************************ * JSB LGBUF CALL LGBUF(IBUFF,LENTH) * DEF *+3 * DEF IBUFF * DEF LENTH * WHERE: * IBUFF = ADDRESS OF A USER BUFFER. * LENTH = LENGTH OF BUFFER, IN WORDS. THIS BECOMES THE NEW MAXIMUM * RECORD LENGTH. *********************************************************************** * FORTRAN EXAMPLES. *** * CALL EXEC (1,401B,IBUFR,-80) * CALL ABREG(IA,ICHRS) * CALL CODE(ICHRS) * READ(IBUFR,*) A,B,C,D *** * 5 READ (1,10) (IBUF(I),I=1,36) * 10 FORMAT (36A2) * IF (ITLOG(ICHRS)) 20,5,20 * 20 ISTRC = 1 * CALL NAMR(IPBUF,IBUF,ICHRS,ISTRC) * * NOTE: ICHRS CAN BE AS LARGE AS 134 IF 134 CHARACTERS ARE INPUT. *** * READ (8,10) (IBUF(I),I=1,80) * d+ 10 FORMAT (40A2) * IF (IAND(ISTAT(ISTUS),240B)) 99,20,99 * 20 CONTINUE * --- * 99 CONTINUE (END OF FILE OR END TAPE DETECTED) *** * DIMENSION IBUFF(1000) * --- * CALL LGBUF(IBUFF,1000) * READ(8,10) (ARRAY(I),I=1,2000) * 10 FORMAT(2000A1) HED COMMUNICATION WITH FRMTR. * FOLLOWING LOCATIONS REFERENCED IN FRMTR: * ADX BSS 1 ADDRESS VARIABLE. TYPE BSS 1 TYPE LENTH BSS 1 LENGTH (IN WORDS) SKIP BSS 1 FLAG TO SKIP STORE IN .IOI./.IOJ./.IOR. FCR BSS 1 POINTS TO CHARACTER IN FORMAT CCNT BSS 1 COUNTS WORDS/CHARS IN BUFFER CMAX BSS 1 MAX VALUE OF CCNT AT TAB LEFT. BCR BSS 1 IO BSS 1 FLAG...=0 FOR OUTPUT, 1 FOR IN SKIPL BSS 1 FLAG TO AVOID SPURIOUS RTN TO LIST. TSCAL BSS 1 SCALE BSS 1 SCALE FACTOR NEST BSS 1 PAREN LVLS. INIT -6, -5 IN FMT, * -4 TO -1 FOR NESTING. CFLAG BSS 1 BCRS BSS 1 USED FOR REMEMBERING BCR F2LSI BSS 1 SWITH BSS 1 RNEST BSS 1 NEST VALUE OF UNLIMITED GROUPS. ADRFD DEF RFSV USED FOR INDEXING IN RFLD. RF BSS 1 FORMAT REPEAT FIELD COUNTER WSAVE BSS 1 HOLDS INITIAL W FOR REPEATS DSAVE BSS 1 HOLDS INITIAL D FOR REPEATS GFLAG BSS 1 = -1 IF G FIELD, +1 OTHERWISE. .OBUF DEF BUFO EORD BSS 1 ALSO DTAI & ATMP. OFLAG DEC 0 =0,-1 FOR ASA/OLD FORMATS. HED CONSTANTS & LOCALS. * CONSTANTS. * CNTRL BSS 1 MIN6 DEC -6 MIN2 DEC -2 MIN1 DEC -1 ....1 DEC 1 ....2 DEC 2 ....3 DEC 3 ....7 DEC 7 ...13 DEC 13 PAPER OCT 34000 TEST FOR PAPER TAPE. O76K OCT 76000 O2000 OCT 2000 PBIT OCT 200 SET BIT FOR IOC. BASIC OCT 400 .4000 OCT 4000 CHECK FOR TYPE CODE = 1X ASC2B OCT 500 SPCOL ABS 72B-40B ":" - " " "B" OCT 102 "^0" BYT 40,60 " 0" "0" OCT 60 BLANK OCT 40 MXPS OCT 77777 MAX POS # DMXPS DEF MXPS * - * LOCALS. * FMTAD BSS 1 ADDR FORMAT TEMP1 BSS 2 TEMPORARY TEMP2 BSS 1 STORAGE RFLD BSS 5 REPEAT FIELD FOR GROUPS. RFSV BSS 5 INITIAL VALUE OF R-FIELD. LPRN BSS 5 ADDRESS OF LEFT PAREN'S IN GROUP UNIT OCT 1 INPUT/OUTPUT UNIT ENDLS BSS 1 POINTS TO ENDOF CALLING SEQUENCE ALNTH BSS 1 AND .IAR. BFLAG BSS 1 =1 FOR BINARY I/O, 0 FOR DECIMAL STXXX NOP BUFBN EQU 60 BUFLN EQU 67 BUFI BSS BUFLN BUFO EQU BUFI BINRY ABS -BUFBN-BUFBN BINARY RECORD LENGTH ASCRY ABS -BUFLN-BUFLN FORMATTED RECORD LENGTH CLEN ABS -BUFLN-BUFLN HED ROUTINES TO PASS LIST ITEMS. ******************************************************************** * THIS SET OF ROUTINES IS USED TO PASS THE ADDRESS, TYPE AND * * LENGTH (IF ARRAY). FOR EACH VARIABLE OR ARRAY OF TYPE: * * INTEGER (I), DOUBLE INTEGER (J), REAL/2-WD FLOATING (R), * * EXTENDED PRECISION/3-WD FLOATING (X) OR DOUBLE PRECISION/4-WD * * FLOATING (T), THERE IS A SINGLE CALL TO ONE OF THE FOLLOWING: * * .IOZ., Z=I,J,R; .ZIO./.ZAR./.ZAY., Z=I,J,R,X,T. * * THERE IS INITIALLY A SINGLE CALL TO EITHER .DIO. OR .BIO. . * ******************************************************************** SPC 3 IOCHK NOP A SWITCH ON THE VALUE OF IO. RE- STB TEMP2 SAVE B LDB IO TURN TO P+1 FOR OUTPUT, P+2 FOR SZB INPUT. ISZ IOCHK LDB TEMP2 RESTORE B JMP IOCHK,I SPC 3 BCHEK NOP RETURNS TO P+1 IF BINARY, ELSE 2 STB TEMP2 LDB BFLAG SZB,RSS ISZ BCHEK LDB TEMP2 JMP BCHEK,I SPC 2 * ROUTINE TO INITIALIZE .ZIO. / .ZAR. / .ZAY. * CTYPE NOP ADB MIN2 ACTUAL ENTRY POINT ADDR. LDA B,I COPY ENTRY POINT. STA .TIO. CMB COMPUTE OFFSET FROM FIRST ONE. ADB CTYPE,I CMB .u BRS TYPE = OFFSET / 2 STB TYPE SZB TYPE = 0 CPB ....1 OR 1 ? INB YES, LENTH IS ONE LARGER (ELSE EQUAL) STB LENTH ISZ CTYPE EXIT JMP CTYPE,I SKP * .IOI. / .IOJ. / .IOR. * * CALLING SEQUENCE: * * * JSB ROUTINE * SPC 2 .IOI. NOP STORE ARG & CALL .IIO. STA TEMP1 JSB .IIO. DEF TEMP1 LDA TEMP1 LDB SKIP IF FREE-FIELD & NULL, SKIP STORE. SZB ISZ .IOI. JMP .IOI.,I * .IOJ. NOP STORE ARG & CALL .JIO. STA TEMP1 STB TEMP1+1 JSB .JIO. DEF TEMP1 LDA .IOJ. SAVE A LITTLE SPACE HERE. STA .IOR. JMP IOR1 * .IOR. NOP STORE ARG & CALL .RIO. STA TEMP1 STB TEMP1+1 JSB .RIO. DEF TEMP1 IOR1 LDA SKIP FREE-FIELD & NULL ? SZA ISZ .IOR. YES. SKIP. SZA ISZ .IOR. LDA TEMP1 LOAD UP RESULT. LDB TEMP1+1 JMP .IOR.,I EXIT. SKP * .IIO. / .JIO. / .RIO. / .XIO. / .TIO. * * CALLING SEQUENCE: * * JSB ROUTINE * DEF SPC 2 .IIO. NOP JSB TIO .JIO. NOP JSB TIO .RIO. NOP JSB TIO .XIO. NOP JSB TIO .TIO. NOP JSB TIO SPC 1 TIO NOP LDB TIO COMPUTE TYPE, LENTH. JSB CTYPE DEF .IIO. LDB A,I B = BASE ADDR. ISZ .TIO. CLA,INA A = # ELEMENTS = 1. JMP TAY1 SKP * .IAR./.JAR./.RAR./.XAR./.TAR. .IAY./.JAY./.RAY./.XAY./.TAY. * * CALLING SEQUENCES: * * LDA <# ELEMENTS> JSB ROUTINE * LDB DEF * JSB ROUTINE DEC <# ELEMENTS> ?* * INDIRECTION IS ALLOWED ON BOTH VALUES (THE # OF ELEMENTS * IS TREATED AS AN ADDRESS). SPC 3 .IAR. NOP JSB TAR .JAR. NOP JSB TAR .RAR. NOP JSB TAR .XAR. NOP JSB TAR .TAR. NOP JSB TAR * TAR NOP STB ADX SAVE A,B. STA ALNTH LDB TAR SET TYPE, LENTH. JSB CTYPE DEF .IAR. LDB ADX B = BASE ADDR. LDA ALNTH A = # ELEMENTS. JMP TAY1 SPC 2 .IAY. NOP JSB TAY .JAY. NOP JSB TAY .RAY. NOP JSB TAY .XAY. NOP JSB TAY .TAY. NOP JSB TAY * TAY NOP LDB TAY SET TYPE, LENTH. JSB CTYPE DEF .IAY. LDB A,I B = BASE ADDR. ISZ .TIO. LDA .TIO.,I A = # ELEMENTS. ISZ .TIO. JMP TAY1 SKP * AT THIS POINT: TYPE, LENTH & RETURN ADDR ARE * SET UP, AND: B=BASE ADDR, A=# ELEMENTS. SPC 2 LDB B,I REMOVE INDIRECTS FROM BASE ADDR. TAY1 RBL,CLE,SLB,ERB JMP *-2 STB ADX JMP *+2 REMOVE "INDIRECTS" ON LENGTH LDA A,I RAL,CLE,SLA,ERA JMP *-2 JSB BCHEK BINARY ? JMP TAY3 YES. CMA,INA,SZA,RSS - # ELEMENTS. JMP .TIO.,I IF NONE. STA ALNTH TAY2 JSB LST2J GO CONVERT. LDA ADX BUMP TO NEXT ELEMENT. ADA LENTH STA ADX ISZ ALNTH DONE ? JMP TAY2 NO, DO ANOTHER. JMP .TIO.,I YES, EXIT. * * BINARY ARRAY I/O. * TAY3 MPY LENTH A = TOTAL LENGTH. CMA,INA,SZA,RSS SET UP COUNT. JMP .TIO.,I IF ZERO. STA ALNTH TAY4 ISZ CCNT TEST FOR END OF BUFFER. JMP TAY5 NO. JSB DTA YES, DO I/O. JMP TAY4 AND TRY AGAIN. TAY5 ISZ BCR BUMP BUFFER POINTER. LDA ADX,I FOR OUTPUT. JSB IOCHK WHICH ? STA BCR,I OUTPUT. LDA BCR,I INPUT. JSB IOCHK WHICH ? JMP *+2 OUTPUT - DONE. STA ADX,I INPUT - STORE IN VARIABLE. ISZ ADX TO NEXT ELEMENT. ISZ ALNTH DONE ? JMP TAY4 NO, DO AGAIN. JMP .TIO.,I EXIT. HED CODE - ENCODE/DECODE. * THE FOLLOWING CODE WAS ADDED FOR THE "CALL CODE" PROBLEM * CALLING: * JSB CODE JSB CODE * DEF *+1 DEF *+2 * LDA IBUFR(,I) DEF TLOG +CHARS * CLB(,INB) - OR - LDA IBUFR(,I) * JSB .DIO. CLB(,INB) * DEF FORMT JSB .DIO. * DEF ENDLS DEF FORMT * ETC. DEF ENDLS * ETC. ****************************************** CODE NOP SPECIAL ENTRY FOR INTERNAL CONVERSION ACODE EQU CODE DO THE ALGOL THING ******************************************* LDB CODE,I GET RETURN ADDRESS + LDA BUFFR(,I) ISZ CODE BUMP TO FIND OUT IF TLOG LDA CODE,I GET POSSIBLE PRAM ADDRESS CPB CODE CHECK IF PASSED PARM LDA DMXPS NO, GET DEF MAX POS #. LDA A,I GET TLOG IN CHARS OR MAX POS #. CMA MAKE -TLOG-1 OR MAX NEG #. STA CCNT SAVE AS BUFFER LEN STA CMAX STB BFLAG SAVE RETURN ADDRESS LDA B,I LOAD: "LDA IBUFR(,I)". AND O2000 MASK TO FIND IF CLE,SZA CURRENT OF BASE PAGE? LDA B CURRENT, GET PAGE BITS XOR B,I LOAD IF BASE, MIRGE IF CURRENT AND O76K MASK OFF PAGE IF BASE, XOR B,I MIRGE IN IF CURRENT RSS NOW TRACK DOWN ANY LDA A,I INDIRECT ADDRESSES RAL,CLE,SLA,ERA INDIRECT? JMP *-2 YES, DO IT AGAIN RAL DOUBLE IT AND ADA MIN1 SUBTRACT ONE STA BCR SAVE THE BUFFER ADDRESS ADB ....3 P POINT TO THE P+1 OF JSB .DIO. STB CODE SAVE IN CONVENENT PLACE JMP BFLAG,I RETURN TO EXECUTE LDA IBUFF,CLB,JSB .DIO. HED .DIO. & .BIO. - INITIALIZATION. *************************** .DIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR FORMATTED INPUT/ *************************** OUTPUT. STA UNIT STB IO LDA .DIO. CHECK IF CALL CODE BEFORE CPA CODE MUST BE SAME JMP INTCN YES, CALL CODE CONVERSION LDA UNIT SET FUNCTION BITS JSB SETLU STA CNTRL LDA UNIT NO, PROCESS AS BEFORE CCE,SZA CHECK FOR UNIT=0. (E=1) JMP DIO1 NO-IO TRANSFER. ERA INTERNAL CONVERSION. (A=MAX NEG #) STA CCNT SET CCNT = MAX NEG #. STA CMAX LDB .DIO.,I B = BUFFER ADDR. LDA B,I VERIFY ABOVE FENCE. STA B,I RBL FORM BYTE ADDR - 1: BCR. ADB MIN1 STB BCR ISZ .DIO. INTCN CLA,RSS CALL CODE INTERNAL CONVERSION DIO1 CLA,RSS STA UNIT STA BFLAG STA SKIP STA SKIPL STA TSCAL INITIAL SCALE FACTOR = 0 STA SCALE CLEAR SCALE FACTOR FOR FREE INPT STA SWITH LDA ASCRY STA CLEN RECORD SIZE LDA MIN6 STA NEST OUTSIDE LEVEL 0 PARENS. CCA STA CFLAG FREE-FIELD COMMAS. SKP * COPY FORMAT AND END-OF-LIST ADDRESSES. * LDA .DIO. GET FORMAT ADDRESS LDA A,I GET DOWN TO NEXT LEVEL RAL,CLE,SLA,ERA TEST FOR INDIRECT (1 LEVEL) JMP *-2 SEARCH FOR EVER IF NEED BE STA FMTAD SAVE FORMAT ADDRESS LDB A,I VERIFY ABOVE FENCE. STB A,I RAL CONVERT TO A CHARACTER CMA,INA,SZA ADDRESS CMA STA FCR ISZ .DIO. GET THE END-OF LIST LDA .DIO.,I ADDRESS STA ENDLS {g LDB A,I VERIFY ABOVE FENCE. STB A,I * * IF FORMATTED OUTPUT, WAIT FOR PREV. OUTPUT & GO. * IF INPUT, READ RECORD. IF FORMATTED, GO. * ISZ .DIO. SET UP LDA .DIO. THE RETURN STA LST2J ADDRESS JSB IOCHK IF OUTPUT, JSB WAITO WAIT. JSB IOCHK JMP FORMT GO. JSB DTA INPUT. READ A RECORD. LDA FCR FORMATTED ? SZA JMP FORMT YES, GO. * * FREE-FIELD INPUT. * NXTON JSB F2LST LIST DEFINITION IOTST LDB UNIT CHECK IF INTERNAL CONVERSION LDA CCNT IF CCNT = 0, SZA CHECK IF SLASH WAS ENCOUNTERED JMP NSLSH NO SZB,RSS SLASH, BUT INTERNAL CONVERSION? JMP ENDLS,I YES RETURN, UNSATISFYING LIST JSB DTA SO READ NEXT RECORD NSLSH JSB .INPN ENTER FRMTR TO CONVERT DATA DEF ADX LDA SWITH CPA ....7 IF SWITH = 7, GO TO END OF LIST JMP ENDLS,I SZA JMP NXTON STORE ELEMENT JMP IOTST MUST BE SLASH SKP *************************** .BIO. NOP * THE INITIAL CALL TO THE I/O ROU- * * TINES FOR NON-FORMATTED *************************** INPUT/OUTPUT STA UNIT STB IO JSB SETLU CONFIGURE THE LU CONTROL WORD XOR ASC2B MAKE IT BINARY STA CNTRL AND PUT IT AWAY CLA,INA BFLAG = 1. STA BFLAG CLA SKIP = 0. STA SKIP LDA BINRY STA CLEN RECORD SIZE LDB IO TEST FOR I/O DIRECTION SZB JMP BIO1 IF INPUT. JSB WAITO OUTPUT, WAIT. JMP .BIO.,I BIO1 JSB DTA INPUT, READ. JMP .BIO.,I SPC 3 *************************** SET NEW FORMAT DEFS. NEWIO NOP * CALLING SEQUENCE: * JSB NEWIO *************************** DEF *+1 CLA STA OFLAG ISZ NEWIO JMP NEWIO,I SPC 3 *************************** SET OLD FORMAT DEFS. OLDIO NOP * CALLING SEQUENCE: * JSB OLDIO *************************** DEF *+1 CCA STA OFLAG ISZ OLDIO JMP OLDIO,I HED LINKAGE TO "FRMTR". * MAIN LOOP. CALL FRMTR & ACCEPT REQUESTS: * SWITH<6: PRODUCE ERROR MSG & QUIT. * SWITH=6: GET A LIST ITEM. * SWITH=8: DO I/O. * FORMT JSB .FRMN ENTER FRMTR TO PROCESS LIST DEF ADX TSTSW LDA MIN6 ADA SWITH SSA JMP ERROR SWITCH < 6 = ERROR. SZA,RSS JMP NRML SWITCH=6=F2LST JSB DTA SWITCH=8 JSB .DTAN ENTER FRMTR AFTER DATA I/O DEF ADX JMP TSTSW NRML JSB F2LST JSB .LS2F CONTINUE LIST PROCESS DEF ADX JMP TSTSW SPC 3 * COROUTINE MECHANISM FOR LIST ITEMS: * THE CONVERSION ROUTINES IN FRMTR AND THE LIST-ITEM * HANDLERS IN FMTIO ACT AS COROUTINES. THE LINKAGE IS * PERFORMED BY LST2J AND F2LST. WHEN FRMTR IS READY * FOR A LIST ITEM, IT RETURNS TO THE FREE-FIELD OR * FORMATTED LOOP IN FMTIO, WHICH CALLS F2LST. * F2LST RETURNS THRU LST2J TO THE PREVIOUSLY CALLED * ITEM HANDLER, WHICH RETURNS TO THE CALLER. THE * CALLER CALLS ANOTHER ITEM HANDLER, WHICH CALLS LST2J * (SAVING ITS RETURN POINT). LST2J RETURNS THRU F2LST * TO THE CONVERSION LOOP, WHICH "RETURNS" TO FRMTR BY * CALLING THE APPROPRIATE ENTRY POINT. * SINCE FORMATTED I/O CALLS FRMTR FIRST, FORMATTED * I/O IS DRIVEN BY THE FORMAT. SINCE FREE-FIELD *  I/O RETURNS FOR A LIST ITEM FIRST, FREE-FIELD * INPUT IS DRIVEN THE THE LIST. SPC 1 LST2J NOP LDA ADX,I VERIFY DATA ABOVE FENCE. STA ADX,I JMP F2LST,I SPC 1 F2LST NOP LDA BCR STA BCRS ISZ SKIPL PROCESSING FINAL RIGHT PAREN ? JMP LST2J,I NO, RETURN TO .IOI. & FRIENDS. JMP F2LST,I YES, RETURN TO FORMAT PROCESSOR. HED I/O ROUTINES. DTA NOP PERFORMS A COMPLETE I/O OPERA- JSB .DTA. TION. JSB IOCHK JMP *+3 JSB WAITI INPUT WAIT JMP DTA,I JSB WAITO OUTPUT WAIT JMP DTA,I SPC 2 .DTA. NOP LDA UNIT SET UP STATUS CONTROL SZA,RSS IF UNIT=0, JMP .DTA.,I IGNORE CALL. JSB IOCHK NOW TEST FOR INPUT OR OUTPUT. JMP DTAO * INPUT SECTION * JSB IOCIN PERFORM IOC CALL. JMP .DTA.,I RETURN * OUTPUT SECTION * DTAO LDB CCNT GET NUMBER OF CHARACTERS/WORDS. JSB BCHEK BINARY ? JMP DTAO2 YES. CMB,CLE,INB -CCNT ADB CMAX CMAX-CCNT (E=0 IFF B<0) LDB CCNT NORMALLY USE CCNT. SEZ CMAX > CCNT ? LDB CMAX YES, USE IT. CMB # CHARS UNUSED. ADB CLEN CHAR COUNT. STB OUTBL STORE AS # OF CHARS. OUTPUT. CMB,SLB,INB B=# CHARS. EVEN ? JMP DTAO1 YES, IS O.K. ADB BUFOA NO. FORM ADDR CHAR AFTER LAST. ADB BUFOA LDA BLANK STORE A BLANK AFTER LAST CHAR. JSB .SBT DTAO1 JSB IOCOU PERFORM IOC CALL JMP .DTA.,I RETURN DTAO2 SZB BINARY RECORD CONTINUATION ? CMB NO. B = # WORDS NOT USED. BLS B = # CHARS NOT USED. ADB CLEN B = -(# CHARS USED) STB OUTBL CMB,INB B = REC LENGTH BLF,BLF POSITION AS HIGH CHARACTER RBR IN WORDS. LDA CNTRL ALF,ALF  ROTATE P-BIT TO SIGN SSA IF NOT ZERO, STORE AS STB .IBUF,I FIRST CHARACTER IN BUFFER. JMP DTAO1 SKP WAITI NOP WAITS FOR INPUT LDB UNIT IGNORE SZB,RSS CALL IF JMP WAITI,I UNIT=0. JSB BCHEK BINARY OR ASCII? ARS BINARY--CONVERT TO WORD COUNT. CMA STORE AS NEGATIVE IN STA CCNT COUNTER. STA CMAX LDB .IBUF GET BUFFER ADDRESS JSB BCHEK BINARY ? JMP WTI3 YES RBL FOR ASCII SET BCR TO POINT TO WTI2 ADB MIN1 THE FIRST CHARACTER PRECEDING WTI4 STB BCR THE BUFFER. JMP WAITI,I WTI3 LDA CNTRL ALF,ALF SSA,RSS PAPER TAPE ? JMP WTI2 NO ISZ CCNT YES JMP WTI4 * INPUT ERROR * * WAITO NOP WAITS FOR OUTPUT TO BE COMPLETED LDA UNIT IGNORE CALL IF SZA,RSS UNIT=0. JMP WAITO,I LDA .OBUF SET UP BUFFER ADDRESS AND CCB LENGTH. ADB CLEN JSB BCHEK BINARY. JMP WTO6 RAL ADJUST BUFFER ADDRESS FOR ADA MIN1 CHARACTERS STA BCR STB CCNT STB CMAX JMP WAITO,I WTO6 BRS ADJUST LENGTH FOR WORDS. ADA MIN1 STA BCR STB CCNT (DON'T NEED CMAX FOR BINARY) LDA CNTRL ALF,ALF SSA,RSS TEST FOR PAPER TAPE. JMP WAITO,I NOT PAPER TAPE. ISZ CCNT IF PAPER TAPE, BUMP BUFFER ISZ BCR ADDRESS AND COUNTER. JMP WAITO,I RETURN SKP SETLU BSS 1 SZA,RSS IF LU = 0 THEN JMP SETLU,I RETURN IFZ JSB DEXEC DEF *+5 DEF DESTN XIF IFN JSB EXEC ELSE DEF *+3+1 TEST FOR PAPER TAPE AND CONFIGURE XIF DEF ...13 THE CONTROL WORD DEF UNIT DEF STXXX LDA STXXX AND PAPER wv CPA .4000 CLA SZA CLA,RSS LDA PBIT IOR UNIT IOR BASIC JMP SETLU,I SKP IOCIN NOP INPUT CALL TO IOC INAGN EQU * IFZ JSB DEXEC DEF *+6 DEF DESTN XIF IFN JSB REIO DEF *+5 XIF DEF ....1 DEF CNTRL .IBUF DEF BUFI DEF CLEN STA STATS SAVE STATUS FOR LATER STB TLOG SAVE TRANSMISSION LOG FOR LATER RAL TEST DOWN BIT SSA ARE WE OK? JMP INAGN NO GO TRY AGAIN AND O500 IS EOT OR EOF BITS SET? SZA,RSS JMP IOCI1 NO, CONTINUE JSB BCHEK CHECK IF BINARY OR ASCII RSS BINARY JMP ENDLS,I ASCII, EXIT LDB CLEN YES, DUMMY THE TLOG SSB -? CMB,INB YES, MAKE POSITIVE IOCI1 LDA B JMP IOCIN,I SKP IOCOU NOP OUTPUT CALL TO IOC LDA CNTRL CLEAR BIT 7 AND =B177577 FOR OUTPUT REQUESTS STA CNTRO IFZ JSB DEXEC DEF *+6 DEF DESTN XIF IFN JSB REIO DEF *+5 XIF DEF ....2 DEF CNTRO BUFOA DEF BUFO DEF OUTBL STA STATS STB TLOG SAVE STATUS AND TLOG JMP IOCOU,I OUTBL BSS 1 CNTRO BSS 1 SKP * ITLOG - GET LAST TRANSMISSION LOG. * ITLOG NOP ENTRY TO GET LAST TRANSMISSION LOG LDA TLOG GET LAST TRANSMITTION LOG LDB ITLOG GET RETURN ADDRESS STB ISTAT DUMMY UP ENTRY JMP ISTAT+2 SPC 4 * ISTAT - GET LAST STATUS WORD. * ISTAT NOP ENTRY TO GET LAST STATUS WORD LDA STATS GET LAST STATUS LDB ISTAT,I GET RETURN ADDRESS STB ITLOG SAVE TEMP ISZ ISTAT CHECK IF PARAMETER PASSED CPB ISTAT CLB,RSS SET DUMMY ADDRESS IN B-REG LDB ISTAT,I GET PARAMETER ADDRESS STA B,I RETURN PARAMETER JMP ITLOG,I RETURN SPC 1 STATS NOP LAST I/O STATUS WORD TLOG NOP LAST I/O TRANSMITION LOG O500 EQU ASC2B SPC 4 * LGBUF - SUBSTITUTE USER BUFFER FOR FMTIO BUFFER. * LGBUF BSS 1 ISZ LGBUF LDA LGBUF FETCH THE BUFFER ADDRESS LGLP1 LDA A,I RAL,CLE,SLA,ERA TEST AND CLEAR INDIRECT BIT JMP LGLP1 TRY AGAIN STA BUFOA FIX THE ADDRESS POINTERS STA .IBUF STA .OBUF ISZ LGBUF LDA LGBUF,I FETCH THE BUFFER LENGTH LDA A,I ALS MAKE IT INTO A BYTE COUNT CMA,INA STA ASCRY STA BINRY ISZ LGBUF JMP LGBUF,I HED ERROR PROCESSING. * PRINT ON LU "FMT.E" THE FORMAT ERROR IN THE FORM: UNL IFN LST * " /PROGM: FMT ERR 3 @12345B" UNL XIF IFZ LST * " /PROGM: FMT ERR# 4 @12345B" UNL XIF * (WITHOUT QUOTES) THIS EXAMPLE HAS ERROR #3 FROM THE FORMAT AT * ADDRESS 12345 OCTAL, AND THE CALLING PROGRAM IS NAMED "PROGM". UNL IFZ LST * * DS/1000 ERRORS WILL BE PRINTED ON LU#1, USING THE SAME FORMAT. UNL XIF LST SPC 1 ERROR LDA UNIT INHIBIT ERRORS WHEN SZA,RSS INTERNAL CONVERSION JMP ENDLS,I IFZ LDA BLNS INITIALIZE PART OF STA MESSS+10 THE MESSAGE WITH BLANKS. XIF LDA SWITH GET ERROR NUMBER ADA "^0" CONVERT TO ASCII " 0" IFN STA MESSS+8 FIRST WORD OF ERROR CODE XIF IFZ STA MESSS+9 OR 1RST WORD OF REMOTE ERROR CODE. LDA FMT.E INITIALIZE FOR MESSAGE REPORTING RMTER STA ERLU VIA "FMT.E" OR CONSOLE LOGICAL UNIT. XIF LDA FMTAD GET FORMAT ADDRESS LDB DFADS GET ADDRESS OF MEM BUFFER RAL,CLE,SLA POSITIONQ MEM ADDRESS & SKIP AGAIN LDA IOCOU GET NEXT OCT DIGIT ALF,RAR ROTATE LEFT 3 STA IOCOU SAVE FOR NEXT PASS AND ....7 MASK DOWN TO DIGIT IOR "0" MIRGE IN TO ASCII SEZ,RSS SKIP IF LO-CHAR IN WORD ALF,SLA,ALF POSITION TO HI-HALF IOR B,I MIRGE IN HI-HALF STA B,I AND PUT IN WORD SEZ,CME BUMP WORD TO NEXT WORD? INB YES, DONE WITH BOTH CHARS CPB DFEND DONE WITH 5 CHARS? SEZ,RSS YES JMP AGAIN NO, FINISH CONVERSION IOR "B" LAST CHAR IS "B" STA B,I AND PUT IN LAST WORD JSB PNAME COPY PROGRAM NAME DEF *+2 DEF MESSS+1 LDA MESSS+3 CHANGE 6TH CHAR TO ":" ADA SPCOL STA MESSS+3 3RD WORD OF NAME IFZ JSB DEXEC DEF *+6 DEF DESTN DEF ....2 DEF ERLU DEF MESSS DEF D15 XIF IFN JSB REIO DEF *+5 DEF ....2 DEF FMT.E DEF MESSS DEF ...13 XIF JMP ENDLS,I SPC 1 SUP IFN DFADS DEF MESSS+10 DFEND DEF MESSS+12 MESSS ASC 13, /PROGS: FMT ERR 4 @12345B XIF IFZ MESSS ASC 15, /PROGM: FMT ERR# 4 @12345B * DFADS DEF MESSS+12 DFEND DEF MESSS+14 BLNS ASC 1, D15 DEC 15 ERLU NOP XIF IFN SKP XIF IFZ HED DS/1000 REMOTE SECTION * (C) HEWLETT-PACKARD CO. 1979 * * REMOTE-PROCESSING INVOCATION REQUEST: * * CALL DNODE (NODAD) -OR- REG = DNODE (NODAD) * * WHERE: 'NODAD' IS THE NODAL ADDRESS OF THE REMOTE CPU * * IF 'NODAD' = -1, THEN THE LOCAL NODE IS SPECIFIED (DEFAULT). * * WITH = OLD DESTINATION NODE, = NEW DESTINATION NODE. * * NEED ONLY BE CALLED, ONCE, BEFORE EXECUTION OF THE * FIRST READ/WRITE OPERATION. IT WILL REMAIN SET FOR THE * SPECIFIED NODE, DURING THE REFX`^ZMAINDER OF THE PROGRAM'S EXECUTION. * THE USER MAY RESET THE NODAL ADDRESS, AT ANY TIME. * DNODE NOP LDA DNODE,I GET THE RETURN ADDRESS. ISZ DNODE ADVANCE TO PARAMETER ADDRESS. LDB DNODE GET ADDRESS OF PARAMETER POINTER. STA DNODE SAVE THE RETURN ADDRESS. * LDB B,I GET THE PARAMETER ADDRESS. RBL,CLE,SLB,ERB TRACK DOWN JMP *-2 INDIRECTS. LDB B,I GET THE DESTINATION NODAL ADDRESS. CPB #NODE IF CALLER HAS SPECIFIED THE LOCAL NODE, CCB THEN SET DESTINATION ADDRESS = -1. LDA DESTN = OLD DESTINATION NODE. STB DESTN ESTABLISH NODAL ADDRESS OF REMOTE CPU. JMP DNODE,I RETURN. * DESTN DEC -1 DESTINATION NODAL ADDRESS. XIF * UNS LITERALS, IF ANY: END m` h} 91750-18170 2013 S C0122 &RPCNV              H0101 ASMB,Q,C HED 3000 REPLY CONVERTER (C) HEWLETT-PACKARD CO. NAM RPCNV,19,25 91750-16170 REV.2013 800319 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC,DTACH,$LIBR,$LIBX,$OPSY EXT #RPCV,#QXCL,#TST,#GET EXT D$TST,D$MAX,D$BSZ,D$MXR EXT .CAX,.MVW SPC 1 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: RPCNV *SOURCE: 91750-18170 * RELOC: 91750-16170 * PGMR: DMT LST **************************** RPCNV ******************************* * * * SOURCE: 91750-18170 * * * * BINARY: 91750-16170 * * * * PROGRAMMER: JIM HARTSELL * * * * FEBRUARY 28, 1977 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 7, 1978 * * FOR DS/1000 ENHANCEMENTS. * * MODIFIED BY JDH [790222] FOR DS REQUEST * * EQUATED OFFSETS. * * * ****************************************************************** SPC 1 * * RPCNV IS THE INTERFACE TO THE DS/1000 SLAVE MONITORS FOR REPLIES * DESTINED FOR THE HP 3000. ALL OUTGOING REPLIES ARE CONVERTED * TO DS/3000 FORMATS. * SUP A EQU 0 B EQU 1 SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791119 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU ^K#SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * RFBLK-START * ****************************************************************** * * * R F A B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY: * * * * RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO RFA REQUEST BUFFERS. * #FCN EQU #REQ RFA FUNCTION CODE. #DCB EQU #FCN+1 DCB/FILENAME AREA. #IRC EQU #DCB+3 DAPOS: IREC #IRB EQU #IRC+1 IRB #XIB EQU #IRC+2 IRB (DXAPO) #IOF EQU #IRB+1 IOFF #XIO EQU #XIB+2 IOFF (DXAPO) #ITR EQU #DCB+3 DCLOS: ITRUN #IC1 EQU #DCB+3 DCONT: ICON1 #IC2 EQU #IC1+1 ICON2 #ICR EQU #DCB+3 DCRET,DNAME,DOPEN,DPURG: ICR(1) #ID EQU #ICR+1 IDSEG #ISC EQU #ID+1 ISECU #SIZ EQU #ISC+1 DCRET: ISIZE(1) #SZ2 EQU #SIZ+1 ISIZE(2) #XRS EQU #SIZ+2 RECSZ (DXCRE) #TYP EQU #SZ2+1 ITYPE #XTY EQU #XRS+2 ITYPE (DXCRE) #NNM EQU #ISC+1 DNAME: NNAME #IOP EQU #ISC+1 DOPEN: IOPTN #NUR EQU #DCB+3 DPOSN: NUR #IR EQU #NUR+1 IR #XIR EQU #NUR+2 IR (DXPOS) #IL EQU #DCB+3 DREAD,DWRIT: IL #NUM EQU #IL+1 i NUM #LEN EQU #FCN+1 DSTAT: ILEN #FOR EQU #LEN+1 IFORM #OPT EQU #FOR+1 IOP #NOD EQU #ICR+1 "FLUSH" REQUEST: NODE NUMBER * * OFFSETS INTO RFA REPLY BUFFERS. * #RFD EQU #REP DCRET,DOPEN: RFAMD ENTRY # #JSZ EQU #RFD+1 DCRET: JSIZE (DXCRE) #LOG EQU #REP DREAD: XLOG #REC EQU #REP DLOCF: IREC #RB EQU #REC+1 IRB #XRB EQU #REC+2 IRB (DXLOC) #OFF EQU #RB+1 IOFF #XOF EQU #XRB+2 IOFF (DXLOC) #JSC EQU #OFF+1 JSECT #XJS EQU #XOF+1 JSECT (DXLOC) #JLU EQU #JSC+1 JLU #XJL EQU #XJS+2 JLU (DXLOC) #JTY EQU #JLU+1 JTY #XJT EQU #XJL+1 JTY (DXLOC) #JRC EQU #JTY+1 JREC #XJR EQU #XJT+1 JREC (DXLOC) #IAD EQU #REP DSTAT: IADD * * MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. * #RLW EQU #MHD+13 M A X I M U M S I Z E ! ! ! * * RFBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * DSTIO, LUMAP, #SCSM, RMTIO * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24) (5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E ! ! ! * * DXBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * Pq * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SPC 3 * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP RPCNV LDA $OPSY RAR,SLA IS THIS AN RTE-III OR IV? RSSI RSS YES. JMP SETCL NO. LDB RSSI GET "RSS" INSTRUCTION. STB MODI2 MODIFY TO DO CROSS-MAP LOAD. STB MODI3 MODIFY TO DO CROSS-MAP STORE. DLD MWFI MODIFY TO DO "MWF" DST DMS3 CROSS-MAP MOVE. * R& JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * SETCL LDA #RPCV SET BIT IOR B60K TO SAVE STA CLASS BUFFER. * ************************************************************ * * * MAIN PROCESSING SECTION FOR ALL REPLIES FOR THE 3000. * * * ************************************************************ * GET EQU * JSB EXEC LOOK AT THE CLASS. DEF *+7 DEF D21 DEF CLASS DEF T+CLS3 DEF D8 DEF PARM1 DEF PARM2 * LDA PARM1 CHECK FIRST OPTIONAL PARAMETER. CPA D8 8? JMP DOCLR INTERMEDIATE CONTINUATION. CPA D1 1? RSS SLAVE TIMEOUT FROM UPLIN. JMP DO#GT NEITHER--PICK UP VIA #GET. * DOCLR LDA CLASS CLEAR "SAVE BUFFER" ALR,RAR FLAG IN CLASS. STA TEMP JSB EXEC DO DUMMY "GET" DEF *+5 TO RELEASE DEF D21 BUFFER. DEF TEMP DEF T+AP25 DEF D0 * LDA PARM1 TAKE FURTHER ACTION CPA D8 DEPENDING UPON PARM1. JMP INTCO * * SLAVE TCB TIMED OUT AND UPLIN SENT THE SEQUENCE NUMBER. * LDA T+CLS3 GET SEQUENCE NUMBER. STA RQB+#SEQ PUT IT IN DS/1000 HEADER WORD. JMP SRTST GO SEARCH TST. * * INTERMEDIATE CONTINUATION REQUEST PASSED VIA RQCNV. * INTCO LDB PARM2 GET TST ADDRESS. STB TSTAD ADB D2 GET HOLDING CLASS JSB LODWD FROM S.A.M. STA T+HCLS ADB D9 GET ORIGINAL SEQUENCE JSB LODWD NUMBER FROM S.A.M. STA T+SEQ3 * LDA T+STR3 IF 3000 AND BIT14 REJECTED, SZA JMP RLTST RELEASE TST. * JMP PSTUP DO PRELIMINARY SET-UP. SPC 1 * BUFFER CAME FROM DS/1000 MONITOR. DO#GT JSB #GET PICK UP BUFFER $LDEF *+6 FROM DS/1000 SLAVE MONITORS. DEF #RPCV RPCNV'S I/O CLASS. DEF RQB 1000 REPLY BUFFER. DEF C#MXR MAXIMUM LENGTH. DBUFA DEF T+AP25 DEF D$MAX JMP GET ERROR RETURN. * STA RQLOG SAVE REPLY LENGTH. STB TCNT SAVE LENGTH OF DATA RECEIVED. * * SEARCH TRANSACTION STATUS TABLE (TST) FOR MATCHING SEQUENCE # * IN 8-WORD FIXED-FORMAT HEADER. * SRTST DLD #TST GET TST ADDR AND # OF ENTRIES. STA TEMP CMB,INB STB TEMP1 SZA SZB,RSS JMP GET FORGET IT IF NO TST. * TSTLP LDB TEMP CHECK NEXT ENTRY. JSB LODWD VALID ENTRY? SZA,RSS JMP NXTST NO. GO CHECK NEXT ENTRY. INB YES. JSB LODWD (CROSS) LOAD LOCAL SEQ. #. CPA RQB+#SEQ JMP CONV MATCH. GO PROCESS REPLY. * NXTST LDB TEMP BUMP TO NEXT ENTRY. ADB TSTLN STB TEMP ISZ TEMP1 JMP TSTLP JMP GET NOT FOUND. * * MOVE TST ENTRY FROM S.A.M. TO LOCAL STORAGE AREA. * (THIS IS 8-WORD HEADER BELONGING TO THIS REPLY.) * CONV LDA TEMP SAVE ADDR OF TST ENTRY IN S.A.M. STA TSTAD LDA TSTLN MOVE TST ENTRY TO LOCAL STORAGE. JSB .CAX LDA TSTAD LDB LTSTA DMS3 JSB .MVW MOVE: [DMS: "MWF"]. DEF TSTLN NOP * * PERFORM PRELIMINARY SET-UP OF FIXED FORMAT HEADER. * PSTUP LDA T+STR3 AND NOT13 CLEAR CONTINUATION BIT. IOR BIT15 SET REPLY BIT. STA T+STR3 LDA RQB+#SID REVERSE PROCESS NUMBERS. ALF,ALF * LDB PARM1 DS/3000 CONTINUATION REQUEST? CPB D8 JMP CONRQ YES. GET DATA OFF BUFFER. CPB D1 IF UPLIN DETECTED A TIMEOUT JMP TOREJ REJECT IT. * STA T+PRC3 STORE REVERSED PROCESS NUMBERS. * * IF OPERATOR COMMAND REPLY, PROCESS INTERVENING $STDLIST MESSAGE. * LDA RQB+#STR AND B17 CPA D7 oM RSS JMP CONV1 NOT A COMMAND REPLY. * DLD RQB+#EC1 GET ERROR CODE. SZA,RSS IF ZERO, JMP CKRPL CHECK FOR ASCII REPLY * DST T+APN2 STORE ASCII ERROR CODE. LDA D2 LENGTH IS 2 WORDS. JMP DO$SD DO $STDLIST. * CKRPL LDA T+CLS3 IF ORIGINAL 3000 CLASS AND B377 WAS 6 (HELLO/BYE/KILL), CPA D6 THERE IS NO MESSAGE. JMP CONV1 * LDA RQB+#RLN IF NO ASCII SZA,RSS REPLY MESSAGE, JMP CONV1 DON'T DO THE $STDLIST. * LDA D#PCB MOVE ASCII REPLY MESSAGE. LDB ARQ10 JSB .MVW DEF RQB+#RLN NOP * LDA RQB+#RLN GET LENGTH OF ASCII REPLY MSG. * DO$SD ADA D2 ADD # CONTROL WORDS. ALS STA T+BYT3 STORE BYTE COUNT. ARS ADA D8 STA RQLEN SAVE LENGTH OF REQUEST. * LDA T+PRC3 SAVE 3000 PROCESS NUMBERS. STA SVFTO AND B377 SET "FROM PROCESS NO." STA T+PRC3 ZERO. (NO 3000 REPLY) LDA T+CLS3 SAVE 3000 MESSAGE CLASS. STA SVMCL LDA T+STR3 SAVE 3000 STREAM TYPE. STA SVSTR (REPLY BIT IS SET) LDA D5 BUILD $STDLIST REQUEST. STA T+CLS3 MESSAGE CLASS = 5. LDA B20 STA T+STR3 STREAM = 20. CLA CLEAR CONTROL WORDS. STA T+APNG STA T+APN1 LDA RQLEN GET LENGTH OF REQUEST. ALF,ALF STA B LDA T+CLS3 STORE WORD COUNT. AND B377 IOR B STA T+CLS3 * JSB SEND WRITE $STDLIST TO QUEX. JMP RLTST ERROR RTN: LINE DISCONNECTED. * LDA SVMCL RESTORE 3000 MESSAGE CLASS. STA T+CLS3 LDA SVSTR RESTORE 3000 STREAM. STA T+STR3 LDA SVFTO RESTORE 3000 PROCESS NUMBERS. STA T+PRC3 * * CONVERT DS/1000 REPLY TO DS/3000 FORMAT. * CONV1 CLA CLEAR "DATA IN STA INPLC PLACE" FLAG. JS?B D1000 MAKE CONVERSION. * STA T+BYT3 STORE BYTE LENGTH. INA STORE WORD COUNT BYTE. ARS ADA D8 STA RQLEN SAVE LEN OF DS/3000 REPLY. ALF,ALF STA B LDA T+CLS3 AND B377 IOR B STA T+CLS3 * * CHECK IF THERE IS DATA IN THIS REPLY. * LDA TCNT IS THERE DATA? SZA JMP CONT1 YES. GO PREPARE DATA REPLY. * * CLASS WRITE THE DS/3000 REPLY TO QUEX'S I-O CLASS. * PUT JSB SEND DO CLASS WRITE/READ. NOP IGNORE ERROR RETURN. * * RELEASE TST ENTRY IN S.A.M. * RLTST LDA T+HCLS LEAVING A HOLDING CLASS? SZA,RSS JMP STO0 NO. SET 1ST WORD TO 0. * JSB EXEC GET BUFFER OFF DEF *+5 HOLDING CLASS DEF CLS21 AND DEALLOCATE. DEF T+HCLS DEF TEMP DEF D0 NOP (IGNORE ERRORS.) * STO0 LDB TSTAD CLA SZB (MAKE SURE ADDR IS GOOD!) JSB STRWD * JMP GET DONE WITH THIS REPLY. SPC 5 ************************************************************ * * * INTERMEDIATE CONTINUATION REQUEST RECEIVED FOR DS/3000 * * DREAD/PREAD/DEXEC(1) DATA REPLIES. * * * ************************************************************ * CONRQ LDA T+PRC3 REVERSE PROCESS NUMBER. ALF,ALF STA T+PRC3 JSB EXEC READ DATA. DEF *+6 DEF CLS21 DEF T+HCLS (DE-ALLOCATE) DEF T+APNG DEF D$MAX DEF TCNT # WORDS REMAINING. JMP REJCT ERROR. * ISZ INPLC DATA IS IN PLACE. CLA RESET BYTE STA T+BYT3 COUNT AND CLEAR STA T+HCLS CLASS NUMBER IN LDB TSTAD LOCAL AND ADB D2 SAM TST. JSB STRWD LDA T+CLS3 RESET AND B377 6 WORD IOR UP8 COUNT. STA T+CLS3 SPC 1 ************************************************************ * * * SECONDARY SECTION FOR DREAD/PREAD/DEXEC(1) DATA REPLIES. * * * ************************************************************ * * PROCESS DATA REPLIES (POSSIBLE CONTINUATIONS). * * USE MINIMUM OF D$BSZ (CONFIGURED LINE SIZE, SET BY QUEX) AND * D$MXR (ACTUAL BUFFER SIZE APPENDED) FOR SENDING DATA. * CONT1 LDA D$BSZ SUBTRACT D$BSZ CMA,INA FROM D$MXR. IF ADA D$MXR RESULT > 0 USE D$BSZ. LDB D$BSZ IF < 0, USE D$MXR. SSA LDB D$MXR STB BUFSZ SAVE BUFFER SIZE LOCALLY. * LDA T+CLS3 STORE HEADER + ALF,ALF APPENDAGE LENGTH. AND B377 STA H&ALN ADA TCNT ADD TOTAL # DATA WORDS REMAINING. STA RQLEN SAVE TOTAL REQUEST LENGTH. CMA,INA ADA BUFSZ WILL IT ALL FIT IN THIS REPLY? SSA,RSS JMP CONT3 YES. * LDA BUFSZ NO. SET LENGTH TO MAX. STA RQLEN LDA T+STR3 SET CONTINUATION BIT. IOR BIT13 STA T+STR3 LDA T+LSEQ SET RTE SEQUENCE # SO CONT. STA T+SEQ3 REQUEST WILL GO TO RPCNV. * CONT3 LDA H&ALN SUBTRACT HEADER + CMA,INA APPENDAGE LEN FROM ADA RQLEN TOTAL REQUEST LENGTH STA DALEN FOR DATA LENGTH. * LDA INPLC IF "DATA IN PLACE" SZA FLAG IS SET, JMP CONT4 DON'T NEED TO MOVE DATA. * LDB ARQ0 FIND WHERE TO PUT THE DATA ADB H&ALN IN THE DS/3000 REPLY. LDA DBUFA JSB .MVW MOVE THE NEXT DATA BLOCK. DEF DALEN NOP * CONT4 LDA DALEN UPDATE REPLY BYTE COUNT. ALS ADA T+BYT3 STA T+BYT3 * JSB SEND WRITE REPLY TO QUEX. JMP RLTST .} ERROR RTN: LINE DISCONNECTED. * LDA DALEN REDUCE TCNT BY DALEN. CMA,INA ADA TCNT STA TCNT SZA,RSS ANY MORE DATA BLOCKS? JMP RLTST NO. GO RELEASE TST ENTRY. * * ALLOCATE A HOLDING CLASS AND WRITE DATA. * LDA BIT15 INITIALIZE CLASS # FOR STA T+HCLS NO WAIT. * LDA DBUFA CALCULATE ADDRESS ADA DALEN OF REMAINING DATA. STA DTADR * JSB EXEC WRITE DATA BLOCK TO HOLDING CLASS. DEF *+8 DEF CLS20 DEF D0 DTADR DEF *-* ADDRESS OF REMAINING DATA. DEF TCNT LENGTH OF THIS BLOCK. DEF TCNT DEF D0 DEF T+HCLS JMP REJCT ERROR. * LDB TSTAD SET HOLDING CLASS ADB D2 NUMBER IN TST. LDA T+HCLS JSB STRWD * JMP GET GET NEXT REPLY. SPC 1 BUFSZ NOP BUFFER SIZE. SKP * * BEFORE REJECTING, REVERSE PROCESS NUMBERS FOR SLAVE TCB TIMEOUT. * TOREJ LDA T+PRC3 ALF,ALF STA T+PRC3 * * SEND A "REJECT" REPLY TO THE 3000 FOR THIS REQUEST. * LOCAL TST STORAGE AREA CONTAINS CURRENT TST 4-WORD HEADER * AND FIXED-FORMAT HEADER FROM CURRENT REQUEST. "TSTAD" * CONTAINS ADDRESS OF TST ENTRY IN S.A.M. * REJCT LDA T+STR3 SET REJECT BIT IN REQUEST. IOR BIT14 AND NOT13 CLEAR CONTINUATION BIT. STA T+STR3 CLA SET APPENDAGE/DATA STA T+BYT3 LENGTH 0. LDA D8 REQUEST LENGTH IS 8. STA RQLEN LDA T+CLS3 SET LENGTH OF HEADER AND B377 PLUS APPENDAGE TO 8. IOR UP8 STA T+CLS3 JMP PUT GO SEND REJECT REPLY & RELEASE TST. SPC 5 * * SUBROUTINE TO SAVE RESOURCES AND TERMINATE UNTIL * RE-SCHEDULED BY QUEX WHEN INTERMEDIATE REPLY ARRIVES. * * * SUBROUTINE TO LOAD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I * MWFI MWF NOP SPC 3 * * SUBROUTINE TO STORE INTO ALTERNATE MAP (IF RTE-III OR IV). * STRWD NOP JSB $LIBR NOP MODI3 STA B,I (RSS IF DMS SYSTEM) JMP OUT XSA B,I STORE WORD INTO ALTERNATE MAP. OUT JSB $LIBX DEF STRWD RETURN TO CALLER. SKP * * SUBROUTINE TO WRITE TO QUEX'S I/O CLASS. * SEND NOP * LDA #QXCL IF DISCONNECTED, SSA TAKE ERROR RETURN. JMP SEND,I * JSB EXEC DO CLASS WRITE/READ. DEF *+8 DEF CLS20 NO ABORT. DEF D0 DEF T+CLS3 REPLY ADDRESS. DEF RQLEN REPLY LENGTH. DEF RQLEN DEF D0 DEF #QXCL I/O CLASS OF QUEX. JMP RLTST ERROR RETURN. * ISZ SEND TAKE NORMAL RETURN. JMP SEND,I RETURN TO CALLER. SKP Pl * ************************************************************** * * * SUBROUTINE TO CONVERT DS/1000 REPLIES TO DS/3000 FORMAT. * * * ************************************************************** * D1000 NOP LDA RQB+#STR ISOLATE STREAM TYPE. AND B377 ADA N4 SUBRACT 4. LDB D3 JSB BNDCK CHECK RANGE: 0 - 3. ADA JTAB1 TABLE ADDRESS + STREAM TYPE. LDA A,I JMP A,I GO TO MESSAGE CLASS PROCESSORS. * JTAB1 DEF *+1 DEF MSCL4 PTOP. DEF MSC8B DEXEC. DEF MSC8A RFA. DEF MSCL3 OPERATOR COMMAND. * ************************************************ * SUBROUTINE TO CHECK FOR ASCII ERRORS. * * LOAD B-REG WITH SYSTEM ERROR CODE (-41 FOR * * PTOP, -999 FOR RFA) AND CALL CHKER. NO CHANGE* * TAKES PLACE IF ERROR IS NUMERIC. * ************************************************ * CHKER NOP ENTRY. LDA RQB+#ENO GET ERROR INDICATOR. SSA,RSS IF ASCII BIT NOT SET, JMP CHKER,I RETURN. LDA RQB+#EC1 GET CHARACTER PART. CPA "DS" IF IT'S A DS ERROR, RSS CONVERT TO NUMBER. JMP RTNER OTHERWISE RETURN. LDA RQB+#EC2 GET NUMERIC PART AND B17 OF ERROR CODE. CMA,INA NEGATE. ADA N50 ADD -50. STA B RTNER STB RQB+#EC2 STORE NUMERIC IN BUFFER. JMP CHKER,I RETURN. * ************************************************ * MESSAGE CLASS 3 ..... OPERATOR COMMANDS. * ************************************************ * MSCL3 CLA SET (A) = BYTE COUNT. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 4 ..... PREAD/PWRIT/PCONT.* ************************************************ * MESSAGE CLASS 7, STREAM 21 ..... POPEN/PCLOS.* ************************************************ * MSCL4 LDA RQB+#FCD PCLOS REPLY? AND B17 CPA D5 JMP SBC YES. * LDB N44 IF SYSTEM ERROR OCCURRED, JSB CHKER CHANGE TO NUMERIC CODE. * LDA RQB+#EC2 MAP DS/1000 ERROR CODES TO DS/3000. LDB BIT15 SET DEFAULT TO "CCE". CPA N41 LDB CL209 MAP -41 TO CCL & 209. CPA N42 LDB CL205 MAP -42 TO CCL & 205. CPA N44 LDB CL213 MAP -44 TO CCL & 213. CPA N45 LDB CL216 MAP -45 TO CCL & 216. STB T+APNG STORE IN DS/3000 REPLY. * LDA SB21 INIT. STREAM TO 100021B. STA T+STR3 * LDB T+MASK IF POPEN REPLY, LDA T+FNCD CPA D1 STB T+AP25 MOVE MASK WORD TO DS/3000 REPLY. * LDA B26 SET ACCEPT/REJECT STREAM TYPE. LDB RQB+#FCD SSB LDA B27 IOR BIT15 SET REPLY BIT. STA T+STR3 ELA,CLE,ERA LDB D211 IF REJECT, CPA B27 STB T+APNG STORE CCG & 211. * CLA CLEAR UNUSED WORD. STA T+APN1 * LDA D#PCB MOVE PCB & TAG. LDB ARQ10 JSB .MVW DEF D23 NOP * ISZ INPLC SET "DATA IN PLACE" FLAG. * SBC LDA T+FNCD SET REPLY BYTE COUNT. AND B17 ADA N1 ADA JTAB2 LDA A,I RETURN (A) = BYTE CNT W/O DATA. JMP D1000,I * JTAB2 DEF *+1 DEC 52 POPEN. DEC 50 PREAD. DEC 50 PWRIT. DEC 50 PCONT. DEC 0 PCLOS. * ************************************************ * MESSAGE CLASS 8, STREAM 20 ..... RFA. * ************************************************ * MSC8A LDB N999 IF SYSTEM ERROR OCCURRED, JSB CHKER CHANGE TO NUMERIC. * LDB RQB+#EC2 MOVE IERR TO "A-REG", IERR. STB T+APNG STB T+APN2 * CLA SSB IF ERROR, SKIP RFAMD #. JMP MSCA1 LDB T+FNCD IF DCRET OR DOPEN, MOVE CPB D3 RFAMD ENTRY # TO "B-REG" SLOT. LDA RQB+#RFD CPB D6 LDA RQB+#RFD MSCA1 STA T+APN1 * CPB D9 CHECK FOR ADDITIONAL PROCESSING. JMP DREAD CPB D4 JMP DLOCF CPB D10 JMP DSTAT * LDA D6 NONE OF THE ABOVE. JMP D1000,I RETURN WITH (A) = BYTE COUNT. * DREAD LDA RQB+#LOG MOVE LEN PARAM. LDB RQB+#EC2 SSB CLA STA T+APN3 LDA D8 JMP D1000,I RETURN WITH (A) = BYTE COUNT. * DLOCF LDA D#REP MOVE DLOCF PARAMS. LDB ARQ11 JSB .MVW DEF D7 NOP LDA D20 JMP D1000,I RETURN WITH (A) = BYTE COUNT. * DSTAT CLA STA T+APNG STA T+APN1 LDA D4 JMP D1000,I RETURN WITH (A) = BYTE COUNT. * ************************************************ * MESSAGE CLASS 8, STREAM 21 ..... DEXEC. * ************************************************ * MSC8B DLD RQB+#EC1 MOVE A&B-REG RETURN VALUES. DST T+APNG * CLA MOVE ADDITIONAL VALUES. LDB T+FNCD CPB D11 LDA D5 CPB D13 LDA D3 STA TEMP # ADDITIONAL WORDS. * SZA,RSS JMP FRBC NONE TO MOVE. * LDA D#REP LDB ARQ10 JSB .MVW DEF TEMP NOP * FRBC LDA TEMP FIND RESULTING BYTE COUNT. ADA D2 ALS JMP D1000,I RETURN WITH (A) = BYTE COUNT. SKP * * SUBROUTINE TO CHECK IF INDEX IS WITHIN SPECIFIED RANGE. * (A) = INDEX (PRESERVED) (B) = UPPER LIMIT. * REQUEST IS REJECTED OF OUT OF BOUNDS. * BNDCK NOP STA LOC SAVE A-REGISTER. SSA JMP REJCT REJECT IF NEGATIVE. CMA,INA ADA B SSA JMP REJCT REJECT IF BEYOND LIMIT. LDA LOC RESTORE A-REGISTER. JMP BNDCK,I RETURN. * LOC OCT 0 SPC 3 * * SUBROUTINE TO CHECK IF DATA LENGTH EXCEEDS DS/1000 LIMIT. * LIMCK NOP (A) = TCOUNT: -BYTES OR +WORDS. SSA,RSS JMP LIM1 + WORDS. CMA,INA - BYTES. CONVERT TO +WORDS. INA ARS LIM1 CMA,INA ADA D$MAX SSA JMP REJCT EXCEEDS LIMIT. REJECT. JMP LIMCK,I SKP * * CONSTANTS AND WORKING STORAGE. * D0 DEC 0 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 D13 DEC 13 D20 DEC 20 D21 DEC 21 D23 DEC 23 D211 DEC 211 B17 OCT 17 B20 OCT 20 B26 OCT 26 B27 EQU D23 B377 OCT 377 B60K OCT 60000 UP8 BYT 10,0 DECIMAL 8, LEFT BYTE. BIT13 OCT 20000 BIT14 OCT 40000 BIT15 OCT 100000 NOT13 OCT 157777 SB21 OCT 100021 CLS20 DEF 20,I CLS21 DEF 21,I CL205 OCT 040315 CL209 OCT 040321 CL213 OCT 040325 CL216 OCT 040330 N1 DEC -1 N4 DEC -4 N41 DEC -41 N42 DEC -42 N44 DEC -44 N45 DEC -45 N50 DEC -50 N999 [fd`DEC -999 "DS" ASC 1,DS CLASS NOP PARM1 NOP PARM2 NOP INPLC NOP SVMCL NOP SVSTR NOP SVFTO NOP TEMP NOP TEMP1 NOP RQLOG NOP RQLEN NOP H&ALN NOP DALEN NOP TCNT NOP * C#MXR ABS #MXR MAX LENGTH OF DS/1000 REQUEST. RQB BSS #MXR+#LSZ DS/1000 REQUEST BUFFER. D#REP DEF RQB+#REP D#PCB DEF RQB+#PCB * TSTAD NOP ADDR OF TST ENTRY IN S.A.M. TSTLN DEC 14 LENGTH OF TST ENTRY. LTSTA DEF T+STR1 ADDR OF LOCAL TST AREA. * * OFFSETS INTO LOCAL TST AND DS/3000 REQUEST BUFFER: T EQU D$TST STR1 EQU 0 DS/1000 STREAM LSEQ EQU 1 LOCAL SEQUENCE NO HCLS EQU 2 HOLDING CLASS NO MCLS EQU 3 MONITOR CLASS NO FNCD EQU 4 MONITOR CLASS NO MASK EQU 5 POPEN MASK WORD CLS3 EQU 6 DS/3000 CLASS STR3 EQU 8 DS/3000 STREAM PRC3 EQU 10 PROCESS NUMBERS SEQ3 EQU 11 SEQUENCE NUMBER BYT3 EQU 13 BYTE COUNT APNG EQU 14 APPENDAGE APN1 EQU 15 APPENDAGE WORD 1 APN2 EQU 16 APPENDAGE WORD 2 APN3 EQU 17 APPENDAGE WORD 3 AP25 EQU 39 APPENDAGE WORD 25 (FWA DATA) SPC 3 ARQ0 DEF T+CLS3 FIRST WORD OF DS/3000 HEADER ARQ10 DEF T+APN2 SECOND WORD OF DS/3000 APPENDAGE ARQ11 DEF T+APN3 THIRD WORD OF DS/3000 APPENDAGE * BSS 0 ******** SIZE OF RPCNV ************ * END RPCNV Xf i 91750-18171 2013 S C0122 &RQCNV              H0101 ASMB,Q,C HED 3000 REQUEST CONVERTER (C) HEWLETT-PACKARD CO. NAM RQCNV,19,25 91750-16171 REV.2013 800903 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 EXT EXEC,$LIBR,$LIBX,$RNTB,$OPSY,RNRQ,DTACH,PGMAD EXT #RSAX,#TST,#NULL,#LDEF,#TBRN,#RSM,#NODE EXT #RQCV,#QRN,#RPCV,#QXCL EXT D$TST,D$MXR,D$MAX EXT .CAX,.MVW SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: RQCNV *SOURCE: 91750-18171 * RELOC: 91750-16171 * PGMR: DMT LST **************************** RQCNV ******************************* * * * SOURCE: 91750-18171 * * * * BINARY: 91750-16171 * * * * PROGRAMMER: JIM HARTSELL * * * * FEBRUARY 14, 1977 * * * *----------------------------------------------------------------* * * * MODIFIED BY DMT BEGINNING NOVEMBER 7, 1978 * * FOR DS/1000 ENHANCEMENTS. * * MODIFIED BY JDH [790222] FOR DS REQUEST * * EQUATED OFFSETS. * * T * ****************************************************************** SPC 2 * * RQCNV IS THE INTERFACE TO THE DS/1000 SLAVE MONITORS FOR REQUESTS * ORIGINATING FROM THE HP 3000. ALL INCOMING REQUESTS ARE CONVERTED * TO DS/1000 FORMATS FOR PROCESSING AT THE RTE SYSTEM. * A EQU 0 B EQU 1 XEQT EQU 1717B SUP SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * RFBLK-START * ****************************************************************** * * * R F A B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY: * * * * RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV * * * ****************************************************************** * * OFFSETS INTO RFA REQUEST BUFFERS. * #FCN EQU #REQ RFA FUNCTION CODE. #DCB EQU #FCN+1 DCB/FILENAME AREA. #IRC EQU #DCB+3 DAPOS: IREC #IRB EQU #IRC+1 IRB #XIB EQU #IRC+2 IRB (DXAPO) #IOF EQU #IRB+1 IOFF #XIO EQU #XIB+2 IOFF (DXAPO) #ITR EQU #DCB+3 DCLOS: ITRUN #IC1 EQU #DCB+3 DCONT: ICON1 #IC2 EQU #IC1+1 ICON2 #ICR EQU #DCB+3 DCRET,DNAME,DOPEN,DPURG: ICR(1) #ID EQU #ICR+1 IDSEG #ISC EQU #ID+1 ISECU #SIZ EQU #ISC+1 DCRET: ISIZE(1) #SZ2 EQU #SIZ+1 ISIZE(2) #XRS EQU #SIZ+2 RECSZ (DXCRE) #TYP EQU #SZ2+1 ITYPE #XTY EQU #XRS+2 ITYPE (DXCRE) #NNM EQU #ISC+1 DNAME: NNAME #IOP EQU #ISC+1 DOPEN: IOPTN #NUR EQU #DCB+3 DPOSN: NUR #IR EQU #NUR+1  IR #XIR EQU #NUR+2 IR (DXPOS) #IL EQU #DCB+3 DREAD,DWRIT: IL #NUM EQU #IL+1 NUM #LEN EQU #FCN+1 DSTAT: ILEN #FOR EQU #LEN+1 IFORM #OPT EQU #FOR+1 IOP #NOD EQU #ICR+1 "FLUSH" REQUEST: NODE NUMBER * * OFFSETS INTO RFA REPLY BUFFERS. * #RFD EQU #REP DCRET,DOPEN: RFAMD ENTRY # #JSZ EQU #RFD+1 DCRET: JSIZE (DXCRE) #LOG EQU #REP DREAD: XLOG #REC EQU #REP DLOCF: IREC #RB EQU #REC+1 IRB #XRB EQU #REC+2 IRB (DXLOC) #OFF EQU #RB+1 IOFF #XOF EQU #XRB+2 IOFF (DXLOC) #JSC EQU #OFF+1 JSECT #XJS EQU #XOF+1 JSECT (DXLOC) #JLU EQU #JSC+1 JLU #XJL EQU #XJS+2 JLU (DXLOC) #JTY EQU #JLU+1 JTY #XJT EQU #XJL+1 JTY (DXLOC) #JRC EQU #JTY+1 JREC #XJR EQU #XJT+1 JREC (DXLOC) #IAD EQU #REP DSTAT: IADD * * MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. * #RLW EQU #MHD+13 M A X I M U M S I Z E ! ! ! * * RFBLK-END SKP * DXBLK-START * ****************************************************************** * * * D E X E C B L O C K REV 2013 800221 * * * * OFFSETS INTO DS/1000 DEXEC MESSAGE BUFFERS, USED BY: * * * * DEXEC, EXECM, EXECW, RQCNV, RPCNV, FLOAD, REMAT * * * ****************************************************************** * * OFFSETS INTO DEXEC REQUEST BUFFERS. * #ICD EQU #REQ ICODE FOR DEXEC(ALL) #CNW EQU #ICD+1 CONWD FOR DEXEC(1,2,3,13) #CWX EQU #CNW+1 DLUEX EXTENSION FOR DEXEC(1,2,3,13) #BFL EQU #CWX+1 IBUFL FOR DEXEC(1,2) #PM1 EQU #BFL+1 IPRM1 FOR DEXEC(1,2) #PM2 EQU #PM1+1 IPRM2 FOR DEXEC(1,2) #ZOF EQU #PM1 Z-BUFFER OFFSET FOR DEXEC(1,2,3,13) #ZLN EQU #PM2 Z-BUFFER LENGTH FOR DEXEC(1,2,3,13) #PR2 EQU #PM2+1 2ND OPT. PARAMETER FOR DEXEC(3) [RTE-L]. #KEY EQU #PR2+1 KEYWORD(RN) FOR DEXEC(1,2,3) [RTE-L]. #PRM EQU #CWX+1 IPRAM FOR DEXEC(3) #PGN EQU #ICD+1 PRGNM FOR DEXEC(6,9,10,12,23,24,99) #INU EQU #PGN+3 INUMB FOR DEXEC(6) #DPM EQU #INU+1 PARMS FOR DEXEC(6) (5-WORD AREA) #PMS EQU #PGN+3 PARMS FOR DEXEC(9,10,23,24)(5-WORD AREA) #IBF EQU #PMS+5 IBUFR FOR DEXEC(9,10,23,24) #IBL EQU #IBF+1 IBUFL FOR DEXEC(9,10,23,24) #FNO EQU #IBL+1 FNOD FOR DEXEC(9) (APLDR) #RSL EQU #PGN+3 IRESL FOR DEXEC(12) #MPL EQU #RSL+1 MTPLE FOR DEXEC(12) #HRS EQU #MPL+1 IHRS FOR DEXEC(12) #MIN EQU #HRS+1 IMIN FOR DEXEC(12) #SEC EQU #MIN+1 ISECS FOR DEXEC(12) #MSC EQU #SEC+1 MSECS FOR DEXEC(12) #PAR EQU #ICD+1 PARTI FOR DEXEC(25) (PARTITION #) #IST EQU #PGN+3 ISTAT FOR DEXEC(99) * * OFFSETS INTO DEXEC REPLY BUFFERS. * #EQ5 EQU #EC1 EQT 5 FOR DEXEC(1,2,3) #XML EQU #EC2 TRANSMISSION LOG (DEXEC 1,2) #RPM EQU #REP PRAMS FOR DEXEC(9,23) (5-WORD AREA) #TMS EQU #REP MSEC FOR DEXEC(11) #TSC EQU #TMS+1 SEC FOR DEXEC(11) #TMN EQU #TSC+1 MIN FOR DEXEC(11) #THR EQU #TMN+1 HRS FOR DEXEC(11) #TDA EQU #THR+1 DAY FOR DEXEC(11) #TYR EQU #TDA+1 YEAR FOR DEXEC(11) #ST1 EQU #REP ISTA1 FOR DEXEC(13) #ST2 EQU #ST1+1 ISTA2 FOR DEXEC(13) #ST3 EQU #ST2+1 ISTA3 FOR DEXEC(13) #ST4 EQU #ST3+1 ISTA4 FOR DEXEC(13) [RTE-L]. #PAG EQU #REP IPAGE FOR DEXEC(25) #IPN EQU #PAG+1 IPNUM FOR DEXEC(25) #PST EQU #IPN+1 ISTAT FOR DEXEC(25) #KST EQU #REP ISTAT FOR DEXEC(99) * * MAXIMUM SIZE OF DEXEC REQUEST/REPLY BUFFER. * #DLW EQU #MHD+11+#LSZ M A X I M U M S I Z E ! ! ! * * MAXIMUM SIZE OF DEXEC/EXECM DATA BUFFER. * #DBS EQU 512 M A X I M U M S I Z E  ! ! ! * * DXBLK-END SKP * PPBLK-START * ****************************************************************** * * * P T O P B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY: * * * * POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT * * #SCSM * ****************************************************************** * * OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS. * #FCD EQU #REP FUNCTION CODE. #PCB EQU #FCD+1 PCB AREA (3 WORDS). #TAG EQU #PCB+3 TAG AREA (20 WORDS). * * MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER. * #PLW EQU #MXR M A X I M U M S I Z E ! ! ! * * PPBLK-END SPC 3 * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M 0oS I Z E ! ! ! * * OPBLK-END SKP RQCNV LDA $OPSY RAR,SLA IS THIS AN RTE-III OR IV? RSSI RSS YES. JMP GET NO. LDB RSSI GET "RSS" INSTRUCTION. STB MODI2 MODIFY TO DO CROSS-MAP LOAD. STB MODI3 MODIFY TO DO CROSS-MAP STORE. CLB LDA MWII MODIFY TO DO "MWI" DST DMS2 CROSS-MAP MOVE. LDA MWFI MODIFY TO DO "MWF" DST DMS3 CROSS-MAP MOVE. * JSB DTACH DETACH FROM POSSIBLE SESSION. DEF *+1 * ************************************************************ * * * MAIN PROCESSING SECTION FOR ALL REQUESTS FROM THE 3000. * * * ************************************************************ * GET EQU * * JSB EXEC WAIT FOR A REQUEST. DEF *+5 DEF CLS21 DEF #RQCV RQCNV'S I/O CLASS. ARQ0 DEF T+CLS3 3000 REQUEST BUFFER. DEF D$MXR NOP IGNORE ERRORS. * STB RCVLN SAVE ACTUAL # WORDS RECEIVED. CLA CLEAR TST POINTER INTO S.A.M. STA TSTAD STA T+STR1 CLEAR LOCAL TST HEADER. STA T+LSEQ STA T+HCLS STA T+MCLS STA T+FNCD STA T+MASK * LDA D#RQB CLEAR DS/1000 REQUEST BUFFER AREA. STA TEMP LDB C#MXR CMB,INB CLA CLR STA TEMP,I ISZ TEMP INB,SZB JMP CLR * **** EVENTUALLY, BREAK SHOULD BE HANDLED BY REMOTE SESSION MONITOR **** LDA T+CLS3 CHECK FOR MESSAGE CLASS 6, AND B377 STREAM 22 OCTAL (BREAK). ALF,ALF STA B LDA T+STR3 AND B377 IOR B CPA M6S22 JMP SNRP1 YES. JUST SEND A REPLY. * * 3000 SENDS DSLINE REQUEST FOLLOWING HELLO. IT WILL BE STREAM 22, * BUT MAY BE EITHER CLASS 3 OR 7. * CPA M3S22 JMP SNRP1 CPA M7S2]2 JMP SNRP1 * * CHECK TRANSACTION STATUS TABLE (TST) FOR MATCHING SEQUENCE # * IN 8-WORD FIXED-FORMAT HEADER. A MATCH WILL BE FOUND FOR * RFA/P-TO-P/DEXEC WRITE AND READ CONTINUATIONS. NOTE THAT * THE CONTINUATION BIT IS NOT SET IF THIS IS THE LAST ONE. * DLD #TST GET TST ADDR AND # OF ENTRIES. STA TEMP CMB,INB STB TEMP1 SZA SZB,RSS JMP REJCT REJECT IF NO TST. (SHOULDN'T HAPPEN) * TSTLP LDB TEMP CHECK NEXT ENTRY. JSB LODWD ENTRY IN USE? SZA,RSS JMP NXTST NO. GO ON TO NEXT ENTRY. INB YES. JSB LODWD (CROSS) LOAD LOCAL SEQ. #. CPA T+SEQ3 JMP CONT1 MATCH. GO PROCESS CONTINUATION. * NXTST LDB TEMP BUMP TO NEXT ENTRY. ADB TSTLN STB TEMP ISZ TEMP1 JMP TSTLP * * NO TST ENTRY. PERFORM "GRPM" FUNCTIONS FOR NEW REQUEST. * LDA T+CLS3 IF WORD COUNT BYTE = 8 ALF,ALF AND B377 CPA D8 RSS JMP OK1 LDA T+STR3 AND CONTINUATION BIT IS SET, RAL,RAL THIS IS A RESIDUAL CONTINUATION SSA REQUEST AFTER A TIMEOUT. JMP REJCT * OK1 LDB #NULL SZB,RSS ANY TCBS AVAILABLE? JMP REJCT NO. REJECT. * LDA T+CLS3 GET 3000 MESSAGE CLASS. AND B377 STA TEMP1 LDA T+STR3 GET 3000 STREAM TYPE. AND B377 STA TEMP2 * LDB MAPTB MAP DS/3000 MSG CLASS AND MAPLP STB TEMP STREAM TO DS/1000 STREAM. LDA B,I GET NEXT MAP TABLE ENTRY. CPA N1 JMP REJCT NOT IN TABLE. CPA TEMP1 COMPARE MESSAGE CLASS. RSS JMP NMACH NO MATCH ON THIS ONE. * INB MATCH. LDA B,I COMPARE DS/3000 STREAM TYPE. SZA IF TABLE ENTRY = 0, IT'S A MATCH. CPA TEMP2 NON-ZERO: TEST IT. JMP MATCH MATCH. GO GET DS/1000 STREAM TYPE. * NMACH LDB TEMP W BUMP TO NEXT MAP TABLE ENTRY. ADB D3 JMP MAPLP CONTINUE SEARCH. * MATCH INB LDA B,I GET DS/1000 STREAM TYPE. STA T+STR1 * IOR BIT3K ADD 3000 BIT AND STA RQB+#STR STORE IN REQ BUFFER. * LDA T+STR1 ADA #LDEF ADA D2 POINT TO LIST HEADER POINTER. LDB A,I POINT TO LIST HEADER. INB LDA B,I STA T+MCLS SAVE MONITOR'S CLASS #. INB LDA B,I GET FIRST WORD OF NAME. RAL,CLE,ERA SZA,RSS IF MONITOR NOT ENABLED, JMP REJCT REJECT REQUEST. STA NAME SAVE FIRST TWO CHARACTERS. INB GET REST DLD B,I OF NAME. DST NAME+1 STORE. JSB PGMAD GET STATUS. DEF *+2 DEF NAME SZA NOT FOUND OR CPB D4 AVAILABLE MEMORY SUSPEND? JMP REJCT YES. REJECT THE REQUEST. * LDB $RNTA RSS LDB B,I RESOLVE INDIRECT. RBL,CLE,SLB,ERB JMP *-2 LDA #QRN GET QUIESCENT RN. AND B377 ISOLATE TABLE INDEX. ADB A COMPUTE POSITION IN RN TABLE. LDA B,I GET IT. AND B377 SZA QUIESCING? JMP REJCT YES. SEND IT BACK. * STA RQB+#EC1 CLEAR STA RQB+#EC2 UNUSED STA RQB+#ENO DS/1000 STA RQB+#MAS HEADER STA RQB+#MAR WORDS. STA RQB+#MAC STA RQB+#HCT * LDA #NODE STA RQB+#SRC SET SOURCE AND STA RQB+#DST DESTINATION NODES = LOCAL. * CLA,INA STA RQB+#LVL FORMAT LEVEL = 1. * LDA T+PRC3 SET SESSION ID WORD. STA RQB+#SID * JSB #RSAX BUILD TCB FOR THIS STREAM. DEF *+5 DEF D3 DEF D0 PASS ORIGINATORS SEQUENCE # DEF T+STR1 & STREAM DEF RQB+#SRC & ORIGIN NODE #. * SSB OK? JMP REJCT NO. STA RQB+#SEQ YES.  STORE SEQ # IN RQB. STA T+LSEQ SAVE FOR TST ENTRY. * INB SET "3K" BIT IN WORD 2 OF TCB. JSB LODWD IOR BIT14 JSB STRWD ADB D2 LDA T+LSEQ STORE "LOCAL SEQ #" AS JSB STRWD "ORIG SEQ #" IN TCB. * LDB #NULL IF WE USED SZB LAST TCB, JMP OK JSB RNRQ LOCK TABLE DEF *+4 ACCESS RN DEF LGNW [GLOBAL LOCK] DEF #TBRN [NO WAIT] DEF TEMP [NO ABORT] * * IF CONTINUATION BIT IS SET IN DS/3000 REQUEST, ALLOCATE * A HOLDING CLASS FOR COLLECTION OF DATA BLOCKS BEFORE * PASSING REQUEST TO DS/1000 MONITOR. * OK LDA T+STR3 BIT 13 OF STREAM WORD RAL,RAL IS CONTINUATION BIT. SSA,RSS JMP CONV NO CONTINUATION. * LDA B1315 INITIALIZE CLASS # FOR STA T+HCLS NO RELEASE & NO WAIT. * JSB EXEC QUICK ALLOCATE - NO ABORT. DEF *+5 DEF CLS19 CLASS CONTROL. DEF D0 LU = "BIT BUCKET" FOR ALLOCATION. DEF D0 DUMMY PARAM FOR ALLOCATION. DEF T+HCLS CLASS NUMBER STORAGE ADDRESS. JMP REJCT ERROR. * JSB EXEC COMPLETE PREVIOUS ALLOC. REQUEST. DEF *+5 DEF CLS21 CLASS GET - NO ABORT. DEF T+HCLS DEF D0 DEF D0 JMP REJCT ERROR. * * CONVERT DS/3000 REQUEST TO DS/1000 FORMAT. * CONV JSB D1000 * STA RQLEN SAVE LENGTH OF DS/1000 REQUEST. * * BUILD ENTRY IN TRANSACTION STATUS TABLE (TST). * DLD #TST FIND EMPTY SLOT (AVAIL. ENTRY). STA TEMP CMB,INB STB TEMP1 BLOOP LDB TEMP CHECK NEXT ENTRY. JSB LODWD CROSS LOAD WORD 1. SZA,RSS ZERO? JMP STTST YES. (B) = ADDR IN S.A.M. * LDB TEMP NO. GO TO NEXT ENTRY. ADB TSTLN STB TEMP ISZ TEMP1 JMP BLOOP JMP REJCT NO AVAILABLE ENTRY. *  STTST STB TSTAD SAVE ADDR OF TST ENTRY IN S.A.M. LDA TSTLN LENGTH OF A TST ENTRY. JSB .CAX PREPARE FOR A DMS "MWI". LDA LTSTA GET LOCAL TST AREA ADDRESS. JSB $LIBR NOP DMS2 JSB .MVW MOVE ENTRY TO TST [DMS: "MVI"]. DEF TSTLN NOP JSB $LIBX DEF *+1 DEF *+1 * LDB ARQ0 PREPARE FOR DATA ADDRESS POINTER. LDA T+CLS3 IS THERE DATA? ALF,ALF AND B377 ADB A STB DABUF SET ADDR OF POSSIBLE DATA. ADA N8 CMA,INA LDB T+BYT3 INB BRS ADA B STA DALEN SAVE LENGTH OF DATA (OR ZERO). * * CHECK IF THERE WILL BE A CONTINUATION OF DATA. * LDA T+STR3 CONTINUATION BIT SET IN RAL,RAL DS/3000 REQUEST? SSA JMP CONT2 YES. GO USE HOLDING CLASS. * PUT LDA RQB+#SID IF DESTINATION AND B377 SESSION ID SZA HASN'T BEEN SET, JMP PUT1 LDA #RSM AND THIS NODE RAL,CLE,ERA HAS REMOTE SZA SESSION MONITOR, STA T+MCLS WRITE TO RSM. * PUT1 LDA RQLEN ADD SIZE OF ADA C#LSZ LOCAL APPENDAGE STA RQLEN (MONITOR WILL REMOVE). * * CLASS WRITE THE DS/1000 REQUEST TO REQUIRED MONITOR. * JSB EXEC DO CLASS WRITE/READ. DEF *+8 DEF CLS20 NO ABORT. DEF CONWX CONTROL WORD W/"Z" BIT & "WRITE". DEF DABUF,I DATA ADDRESS. DEF DALEN DATA LENGTH (COULD BE ZERO). DEF RQB REQUEST ADDRESS. DEF RQLEN REQUEST LENGTH. DEF T+MCLS I/O CLASS OF MONITOR. JMP REJCT ERROR RETURN. * JMP GET GO GET NEXT REQUEST. SKP * * PROCESS CONTINUATION REQUEST. * CONT1 LDA TEMP SAVE ADDR OF TST ENTRY IN S.A.M. STA TSTAD * LDA T+CLS3 IF REQUEST IS A ALF,ALF CONTINUATION AND B377 WITHOUT DAJTA, ADA N8 CLE,ELA CMA,INA ADA T+BYT3 SZA PASS IT TO RPCNV. JMP CONRQ (OTHERWISE PROCESS CONT.) SPC 1 ************************************************************ * * * LET RPCNV HANDLE INTERMEDIATE CONTINUATION REQUESTS FOR * * DREAD/PREAD/DEXEC(1). * * * ************************************************************ * JSB EXEC CLASS WRITE/READ TO RPCNV. DEF *+8 DEF CLS20 NO ABORT. DEF D0 SEND ONLY ONE BUFFER. DEF T+CLS3 DS/3000 CONT. REQ. DEF D8 # OF WORDS. DEF D8 FLAG TO RPCNV. DEF TSTAD TST ENTRY ADDR. DEF #RPCV REPLY CONVERTER CLASS. JMP REJCT ERROR RETURN. JMP GET GET NEXT REQUEST. SPC 1 ************************************************************ * * * SECONDARY SECTION FOR DWRIT/PWRIT/DEXEC(2) WHEN DATA * * RECORD LENGTH IS GREATER THAN 256 WORDS (CONTINUATIONS). * * * ************************************************************ * CONRQ LDA D6 MOVE 1ST 6 WORDS OF TST ENTRY JSB .CAX TO LOCAL TST STORAGE AREA. LDA TSTAD LDB LTSTA JSB $LIBR NOP DMS3 JSB .MVW MOVE: [DMS: "MWF"]. DEF D6 NOP JSB $LIBX DEF *+1 DEF *+1 * JSB #RSAX IS SLAVE TCB STILL AROUND? DEF *+4 DEF D5 DEF T+LSEQ DEF T+STR1 * SSB JMP REJCT NO! REJECT. * LDB ARQ0 YES. SET DATA POINTER & LENGTH. LDA T+CLS3 ALF,ALF AND B377 ADB A STB DABUF ADA N8 CMA,INA LDB T+BYT3 INB BRS ADA B  STA DALEN * JMP CONT3 GO STACK THE DATA BLOCK. * * WRITE DS/1000 REQUEST TO HOLDING CLASS. LOCAL TST STORAGE * AREA CONTAINS APPLICABLE TST ENTRY. * CONT2 JSB EXEC WRITE THE DS/1000 REQUEST TO DEF *+8 THE HOLDING CLASS. DEF CLS20 DEF D0 DEF RQB ADDRESS OF REQUEST. DEF RQLEN LENGTH. DEF RQLEN DEF D0 DEF T+HCLS JMP REJCT ERROR. * * WRITE THE DATA BLOCK TO THE HOLDING CLASS. LOCAL TST * STORAGE AREA CONTAINS APPLICABLE TST ENTRY. * CONT3 JSB EXEC WRITE DATA BLOCK TO HOLDING CLASS. DEF *+8 DEF CLS20 DEF D0 DEF DABUF,I ADDRESS OF DATA. DEF DALEN LENGTH OF THIS BLOCK. DEF DALEN DEF D0 DEF T+HCLS JMP REJCT ERROR. * LDA T+STR3 CONTINUATION BIT SET (IS THERE MORE?). RAL,RAL SSA,RSS JMP GATHR NO. GO PREPARE FOR MONITOR. * * SEND INTERMEDIATE REPLY FOR THIS CONTINUATION REQUEST. * LDA T+LSEQ STORE LOCAL SEQUENCE NUMBER. STA T+SEQ3 SNRP1 LDA T+STR3 SET REPLY BIT. IOR BIT15 STA T+STR3 SNREP LDA T+CLS3 SET WDCNT = 8. AND B377 IOR LFT8 STA T+CLS3 LDA T+PRC3 REVERSE PROCESS NUMBERS. ALF,ALF STA T+PRC3 CLA SET N = 0. STA T+BYT3 * LDA #QXCL SSA JMP GET LINE IS DISCONNECTED. IGNORE. * JSB EXEC WRITE "REPLY" TO QUEX'S CLASS. DEF *+8 DEF CLS20 DEF D0 DEF T+CLS3 DEF D8 DEF D8 DEF D0 DEF #QXCL JMP REJCT ERROR. * JMP GET GO WAIT FOR CONTINUATION. * * GATHER DS/1000 REQUEST AND DATA BLOCKS FOR * PASSAGE TO DS/1000 SLAVE MONITOR. * GATHR JSB EXEC GET DS/1000 REQUEST. DEF *+6 DEF CLS21 DEF T+HCLS NO WAIT, NO RELEASE. DEF RQB DEF C#MXR DEF LOG JMP REJCT ERROR. * DSSA ANYTHING THERE? JMP REJCT NO. * LDA LOG STA RQLEN SAVE LEN OF DS/1000 REQUEST. * LDA ARQ8 INIT DATA BUFFER POINTER. STA DABUF SET POINTER TO DATA. STA TEMP CLA INIT TOTAL DATA LENGTH. STA DALEN * GDATA CMA,INA SUBTRACT DATA LENGTH ADA D$MAX FROM MAX BUFFER LENGTH STA TEMP1 TO GET REMAINING LENGTH. * JSB EXEC GET A DATA BLOCK. DEF *+6 DEF CLS21 DEF T+HCLS NO WAIT, NO RELEASE. DEF TEMP,I DATA BUFFER POINTER. DEF TEMP1 REMAINING BUFFER LENGTH. DEF LOG JMP REJCT ERROR. * SSA,RSS ANYTHING THERE? JMP ADJST YES. LDA DALEN NO. DID WE GET ANY DATA? SZA,RSS JMP REJCT NO. REJECT. JSB RLEAS YES. RELEASE HOLDING CLASS. JMP PUT GO SEND REQUEST TO MONITOR. * ADJST LDA TEMP ADJUST FOR NEXT DATA BLOCK. ADA LOG STA TEMP LDA DALEN ADA LOG STA DALEN * JMP GDATA GET MORE DATA. SKP * * SEND A "REJECT" REPLY TO THE 3000 FOR THIS REQUEST. * LOCAL TST STORAGE AREA CONTAINS CURRENT TST 6-WORD HEADER * AND FIXED-FORMAT HEADER FROM CURRENT REQUEST. "TSTAD" * CONTAINS ADDRESS OF TST ENTRY IN S.A.M. * REJCT LDB TSTAD DELETE TST ENTRY IN S.A.M. CLA SZB SKIP IF NO TST CREATED. JSB STRWD * LDA T+LSEQ WAS SLAVE TCB CREATED? SZA,RSS JMP HLD NO. * JSB #RSAX YES. DELETE SLAVE TCB. DEF *+4 DEF D7 DEF T+LSEQ DEF T+STR1 * HLD LDA T+HCLS HOLDING CLASS ALLOCATED? SZA JSB RLEAS YES. RELEASE IT. * LDA T+STR3 SET REJECT BIT IN REQUEST. IOR BIT14 AND NBT13 CLEAR CONTINUATION BIT. STA T+STR3 LDA D8 STA RQLEN LDA T+LSEQ STORE LOCAL SEQUENCE NUMBER. STA T+SEQ3  JMP SNREP GO SEND REJECT REPLY. SKP * * SUBROUTINE TO FLUSH AND RELEASE THE HOLDING CLASS. * RLEAS NOP * CREPT CCA SET RELEASE RE-TRY SWITCH STA TEMP TO -1. * CLRTN JSB EXEC RELEASE CLASS NUMBER. DEF *+5 DEF CLS21 NO ABORT. DEF T+HCLS HOLDING CLASS #. DEF D0 DEF D0 RSS * ISZ TEMP RELEASE PROCESSING COMPLETED? JMP RLEND YES. INA,SZA NO. ARE ALL PENDING REQUESTS CLEARED? JMP CREPT NO. CONTINUE TO CLEAR REQUESTS. * LDA T+HCLS YES. SET FOR DE-ALLOCATE. AND CLMSK STA T+HCLS JMP CLRTN DO FINAL DEALLOCATION. * RLEND CLA CLEAR SLOT IN LOCAL TST. STA T+HCLS LDB TSTAD IF TST ENTRY EXISTS, SZB,RSS JMP RLEAS,I ADB D2 CLEAR SLOT THERE, TOO. JSB STRWD JMP RLEAS,I RETURN TO CALLER. SKP * * SUBROUTINE TO LOAD FROM ALTERNATE MAP (IF RTE-III OR IV). * LODWD NOP MODI2 LDA B,I (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II. XLA B,I LOAD WORD FROM ALTERNATE MAP. JMP LODWD,I * MWII MWI * MWFI MWF SPC 3 * * SUBROUTINE TO STORE INTO ALTERNATE MAP (IF RTE-III OR IV). * STRWD NOP JSB $LIBR NOP MODI3 STA B,I (RSS IF DMS SYSTEM) JMP OUT XSA B,I STORE WORD INTO ALTERNATE MAP. OUT JSB $LIBX DEF STRWD SKP ************************************************************** * * * SUBROUTINE TO CONVERT DS/3000 REQUESTS TO DS/1000 FORMAT. * * * ************************************************************** * D1000 NOP * * KEY OFF 3000 MESSAGE CLASS NUMBER. * LDA T+CLS3 AND B377 ISOLATE MESSAGE CLASS. ADA N3 SUBRACT 3. LDB D5 JSB BNDCK CHECK RANGE:[d 0 - 5. ADA JTAB1 TABLE ADDRESS + MESSAGE CLASS. LDA A,I LDB T+STR3 GET DS/3000 STREAM WORD. JMP A,I GO TO MESSAGE CLASS PROCESSORS. * JTAB1 DEF *+1 DEF MSCL3 OPERATOR COMMAND. DEF MSCL4 PREAD/PWRIT/PCONT. DEF MSCL5 $STDLIST/$STDIN. DEF MSCL6 HELLO/BYE/KILL DEF MSCL7 POPEN/PCLOS. DEF MSCL8 RFA/DEXEC. * ************************************************ * MESSAGE CLASS 3 ..... OPERATOR COMMANDS. * ************************************************ * MSCL3 LDA T+BYT3 STORE COMMAND LENGTH. STA RQB+#CML (+ BYTES) INA ARS CONVERT +BYTES TO +WORDS. STA TEMP * CMA,INA CHECK LENGTH AGAINST LIMIT. ADA MXCMD SSA JMP REJCT COMMAND IS TOO LONG. REJECT. * LDA ARQ8 MOVE ASCII COMMAND. LDB CMDA JSB .MVW DEF TEMP NOP * LDA TEMP SET LENGTH OF DS/1000 REQUEST. ADA L#CML JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 4 ..... PREAD/PWRIT/PCONT. * ************************************************ * MSCL4 LDA B GET DS/3000 STREAM WORD. AND B377 ISOLATE STREAM. ADA NB22 SUBRACT 22 OCTAL. LDB D2 JSB BNDCK CHECK RANGE: 0 - 2. ADA D2 FORM PTOP FCODE. STA RQB+#FCD STORE IN REQUEST. STA T+FNCD STORE IN TST ENTRY. * LDA ARQ10 MOVE PCB AND TAG FIELD. LDB PCBA JSB .MVW DEF D23 NOP * LDA T+FNCD CPA D4 JMP MSC4A SKIP IF PCONT. LDA T+APN1 CHECK FOR DATA LIMIT. JSB LIMCK STB RQB+#PCB+2 STORE IL PARAM IN RQB. * MSC4A LDA C#PLW SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 5 ..... $STDLIST/$STDIN * ********************************i**************** * * SEND SHORT DS/1000 HEADER TO CNSLM AND PUT ENTIRE * DS/3000 REQUEST AS DATA BUFFER. * MSCL5 LDA ARQ0 SET CLASS I/O STA DABUF DATA ADDRESS, LDA RCVLN STA DALEN DATA LENGTH, LDA D7 STA RQLEN AND REQUEST LENGTH. JMP PUT1 PASS ON TO "CNSLM". * ************************************************ * MESSAGE CLASS 6 ..... HELLO/BYE/KILL. * ************************************************ * MSCL6 LDA #RSM GET REMOTE SESSION MONITOR'S RAL,CLE,ERA CLASS. IF NOT PRESENT, SZA,RSS REJECT THE REQUEST. JMP REJCT * STA T+MCLS STORE CLASS NUMBER IN TST. LDA T+STR3 AND B377 ISOLATE STREAM. CPA B20 STREAM 20 JMP HELLO IS HELLO. CPA B21 STREAM 21 JMP BYE IS BYE. CPA B27 STREAM 27 JMP BYE IS KILL. JMP REJCT REJECT OTHERS. * HELLO LDA T+BYT3 GET # OF BYTES. ADA N6 SUBTRACT "HELLO". STA RQB+#LNL STORE IN DS/1000 HEADER. SZA IF LENGTH IF ZERO, SSA OR NEGATIVE, JMP REJCT REJECT. INA CONVERT CLE,ERA TO WORDS. STA TEMP * CMA,INA CHECK LENGTH AGAINST LIMIT. ADA MXUSR SSA JMP REJCT ACCOUNT IS TOO LONG. REJECT. * LDA ARQ11 ACCOUNT NAME SOURCE LDB ACTA AND DESTINATION. JSB .MVW MOVE ACCOUNT. DEF TEMP NOP CLA,INA SET ICODE = 1. JMP STCOD * BYE CLA,INA LENGTH OF MSG STA TEMP IS ONE WORD. LDA RQB+#SID STORE DESTINATION SESSION AND B377 IN BUFFER AND STA RQB+#LNL CLEAR DESTINATION XOR RQB+#SID IN SESSION ID WORD. STA RQB+#SID CLA SET ICODE = 0 * STCOD STA RQB+#LGC STORE ICODE. LDA D2 SET COMMAND STA RQB+#CML LENGTH TO 2. LDA "XX" STORE STA RQB+#CMS "XX". LDA TEMP SET UP ADA L#LNL LENGTH. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 7, STREAM 21 ..... POPEN/PCLOS.* ************************************************ * MSCL7 LDA T+APN2 GET DS/3000 "RFA" CODE. AND B377 ADA NB25 SUBTRACT 25 OCTAL. LDB D1 JSB BNDCK CHECK RANGE: 0 - 1. SZA JMP PCLOS * * CONVERT POPEN REQUEST. * LDA POCLO STORE PTOP FCODE STA RQB+#FCD (POPEN WITH CLONE). STA T+FNCD STORE IN TST ENTRY. * LDA ARQ11 MOVE PROGRAM NAME. LDB PCBA JSB .MVW DEF D3 NOP LDA ARQ29 MOVE TAG FIELD. LDB PCBA ADB D3 JSB .MVW DEF D20 NOP * LDA T+AP47 STORE POPEN MASK IN TST ENTRY. STA T+MASK * LDA C#PLW SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * * CONVERT PCLOS REQUEST. * PCLOS LDA D5 STORE PTOP FCODE. STA RQB+#FCD STA T+FNCD STORE IN TST ENTRY. * LDA ARQ11 MOVE PCB. LDB PCBA JSB .MVW DEF D3 NOP * LDA L#PCB SET LENGTH OF DS/1000 REQUEST. JMP D1000,I * ************************************************ * MESSAGE CLASS 8, STREAM 20 ..... RFA. * ************************************************ * MSCL8 LDA B AND B377 CPA B20 RSS JMP STM21 STREAM 21 IS DEXEC. LDA ARQ12 MOVE DCB (GARBAGE FOR DSTAT). LDB NAMA JSB .MVW DEF D3 NOP * LDA T+APNG GET FCN CODE FROM DS/3000 REQUEST. ADA N150 SUBRACT 150. LDB D12 JSB BNDCK CHECK RANGE: 0 - 12. ADA JMAP1 TABLE ADDRESS + 3000 FCN CODE. LDA A,I GET DS/1000 FCN CODE. STA RQB+#FCN STORE IN DS/1000 REQUEST. STA T+FNCD STORE IN TST ENTRY$. * ADA JTAB3 TABLE ADDRESS + 1000 FCN CODE. LDB A,I LDA XEQT GET ID SEG ADDR OF RQCNV (DUMMY). JMP B,I GO CONVERT THE RFA REQUEST. * JMAP1 DEF *+1 DS/3000 - DS/1000 FCN MAPPING TABLE. D3 DEC 3 DCRET D8 DEC 8 DPURG D6 DEC 6 DOPEN D12 DEC 12 DWRIT DEC 9 DREAD D7 DEC 7 DPOSN DEC 11 DWIND D1 DEC 1 DCLOS D5 DEC 5 DNAME D2 DEC 2 DCONT D4 DEC 4 DLOCF D0 DEC 0 DAPOS DEC 10 DSTAT * JTAB3 DEF *+1 TABLE OF CONVERSION ROUTINE ADDRESSES. DEF DAPOS DEF DCLOS DEF DCONT DEF DCRET DEF DLOCF DEF DNAME DEF DOPEN DEF DPOSN DEF DPURG DEF DREAD DEF DSTAT DEF DWIND DEF DWRIT * * CONVERT DS/3000 RFA REQUEST TO DS/1000 FORMAT. * DAPOS STA RQB+#DCB LDA T+APN7 MOVE RECNUM PARAM. STA RQB+#IRC LDA T+APN8 MOVE REL BLOCK PARAM. STA RQB+#IRB LDA T+APN9 MOVE BLOCK OFFSET PARAM. STA RQB+#IOF * LDA L#IOF SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DCLOS STA RQB+#DCB LDA T+APN7 MOVE ITRUN PARAM. STA RQB+#ITR LDA L#ITR SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DCONT STA RQB+#DCB DLD T+APN7 MOVE ICON1, ICON2 DST RQB+#IC1 * LDA L#IC2 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DCRET STA RQB+#ID LDA T+AP11 MOVE ICR PARAM. STA RQB+#ICR LDA T+AP10 MOVE ISECU PARAM. STA RQB+#ISC DLD T+APN7 MOVE ISIZE(1), ISIZE(2). DST RQB+#SIZ LDA T+APN9 MOVE ITYPE PARAM. STA RQB+#TYP * LDA L#TYP SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DLOCF STA RQB+#DCB LDA L#DCB SET LENGTH OF DS/1000 REQUEST. JMP D1000,ZvI RETURN. * DNAME STA RQB+#ID LDA T+AP11 MOVE ICR PARAM. STA RQB+#ICR LDA T+AP10 MOVE ISECU PARAM. STA RQB+#ISC DLD T+APN7 MOVE NEWNAME PARAM. DST RQB+#NNM LDA T+APN9 STA RQB+#NNM+2 * LDA L#NNM SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DOPEN STA RQB+#ID LDA T+APN9 MOVE ICR PARAM. STA RQB+#ICR LDA T+APN8 MOVE ISECU PARAM. STA RQB+#ISC LDA T+APN7 MOVE IOPTN PARAM. STA RQB+#IOP * LDA L#IOP SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DPOSN STA RQB+#DCB LDA T+APN7 MOVE NUR PARAM. STA RQB+#NUR LDA T+APN8 MOVE ICR PARAM. STA RQB+#IR * LDA L#IR SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DPURG STA RQB+#ID LDA T+APN8 MOVE ICR PARAM. STA RQB+#ICR LDA T+APN7 MOVE ISECU PARAM. STA RQB+#ISC * LDA L#ISC SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DREAD STA RQB+#DCB LDA T+APN7 MOVE IL PARAM. STA RQB+#IL LDA T+APN9 MOVE NUM PARAM. STA RQB+#NUM * LDA L#NUM SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DSTAT CLA CLEAR STA RQB+#FOR IFORM STA RQB+#OPT AND IOP LDA D125 ILEN IS STA RQB+#LEN 125. * LDA L#XXX SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DWIND STA RQB+#DCB LDA L#DCB SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. .q * DWRIT STA RQB+#DCB LDA T+APN7 MOVE IL PARAM. STA RQB+#IL LDA T+APN8 MOVE NUM PARAM. STA RQB+#NUM * LDA T+APN2 CHECK FOR DATA LIMIT. JSB LIMCK * LDA L#NUM SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * ************************************************ * MESSAGE CLASS 8, STREAM 21 ..... DEXEC. Y * ************************************************ * STM21 LDA T+APN4 GET RCODE FROM DS/3000 REQUEST. ADA N1 SUBTRACT 1. LDB D12 JSB BNDCK CHECK RANGE: 0 - 12. LDB A STORE RCODE IN TST ENTRY. INB STB T+FNCD STB RQB+#ICD STORE RCODE FOR DS/1000. ADA JTAB4 TABLE ADDRESS + RCODE. LDA A,I JMP A,I GO CONVERT THE DEXEC REQUEST. * JTAB4 DEF *+1 TABLE OF CONVERSION ROUTINE ADDRESSES. DEF DEX1 READ DEF DEX1 WRITE (SAME AS READ) DEF DEX3 I/O CONTROL. DEF REJCT DEF REJCT DEF REJCT DEF REJCT DEF REJCT DEF REJCT DEF DEX10 SCHEDULE DEF DEX11 TIME DEF DEX12 EXECUTION TIME DEF DEX13 I/O STATUS * * CONVERT DS/3000 DEXEC REQUEST TO DS/1000 FORMAT. * DEX1 LDA T+APN5 MOVE ICNWD PARAM. STA RQB+#CNW LDA T+APN6 MOVE IBUFL PARAM. STA RQB+#BFL DLD T+APN7 MOVE IPRM1, IPRM2. DST RQB+#PM1 * LDA T+APN2 CHECK FOR DATA LIMIT. JSB LIMCK * LDA L#PM2 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX3 LDA T+APN5 MOVE ICNWD PARAM. STA RQB+#CNW LDA T+APN6 MOVE IPRAM STA RQB+#PRM * LDA L#PRM SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX10 LDA ARQ13 MOVE PROG NAME & 5 PARAMS. LDB NAMA JSB .MVW DEF D8 NOP * LDA L#PMS SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX11 LDA L#TYR SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX12 LDA ARQ13 MOVE PROGRAM NAME. LDB NAMA JSB .MVW DEF D3 NOP DLD T+APN8 MOVE IRESL, MULT PARAMS. DST RQB+#RSL LDA T+AP10 MOVE IOFST/IHRS PARAM. STA RQB+#HRS SSA JMP DX12A NEGATIVE - DONE WITH THIS OANE. * DLD T+AP11 MOVE MINS, ISECS. DST RQB+#MIN LDA T+AP13 MOVE MSECS. STA RQB+#MSC LDA L#MSC SET LENGTH OF DS 1000 REQUEST. RSS * DX12A LDA L#HRS SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. * DEX13 LDA T+APN5 MOVE ICNWD PARAM. STA RQB+#CNW * LDA L#ST3 SET LENGTH OF DS/1000 REQUEST. JMP D1000,I RETURN. SKP * * SUBROUTINE TO CHECK IF INDEX IS WITHIN SPECIFIED RANGE. * (A) = INDEX (PRESERVED) (B) = UPPER LIMIT. * REQUEST IS REJECTED IF OUT OF BOUNDS. * BNDCK NOP STA LOC SAVE A-REGISTER. SSA JMP REJCT REJECT IF NEGATIVE. CMA,INA ADA B SSA JMP REJCT REJECT IF BEYOND LIMIT. LDA LOC RESTORE A-REGISTER. JMP BNDCK,I RETURN. * LOC OCT 0 SPC 3 * * SUBROUTINE TO CHECK IF DATA LENGTH EXCEEDS DS/1000 LIMIT. * LIMCK NOP (A) = TCOUNT: -BYTES OR +WORDS. SSA,RSS JMP LIM1 + WORDS. CMA,INA - BYTES. CONVERT TO +WORDS. INA ARS LIM1 STA B SAVE WORD COUNT IN B-REG. CMA,INA ADA D$MAX SSA JMP REJCT EXCEEDS LIMIT. REJECT. JMP LIMCK,I SKP * * CONSTANTS AND WORKING STORAGE. * * MAPPING TABLE BETWEEN DS/3000 AND DS/1000 STREAM TYPES. * * WORD 1 = DS/3000 MESSAGE CLASS. * WORD 2 = DS/3000 STREAM (0 = DON'T CARE). * WORD 3 = DS/1000 STREAM TYPE. * MAPTB DEF *+1 OCT 3,20,7 RTE COMMANDS - OPERM OCT 4,0,4 SLAVE PREAD/PWRIT/PCONT - PTOPM OCT 5,0,2 UNREQUESTED I/O - CNSLM OCT 6,0,7 HELLO/BYE/KILL - OPERM/RSM OCT 7,21,4 SLAVE POPEN/PCLOS - PTOPM OCT 10,20,6 RTE FMP RFA - RFAM OCT 10,21,5 REMOTE EXEC (DEXEC) - EXECM OCT -1 DELIMITER FOR MAP TABLE. * LGNW OCT 140002 USED FOR RN LOCK POCLO OCM*T 20001 CODE FOR POPEN WITH CLONE. B20 OCT 20 B21 OCT 21 B377 OCT 377 B1315 OCT 120000 BIT14 OCT 40000 BIT15 OCT 100000 BIT3K OCT 110000 "3K" & LEVEL BITS FOR DS/1K STREAM WORD NBT13 OCT 157777 ALL BUT BIT 13. CLMSK OCT 117777 LFT8 BYT 10,0 DECIMAL 8, LEFT BYTE. CONWX OCT 10100 CLS19 DEF 19,I CLS20 DEF 20,I CLS21 DEF 21,I M3S22 BYT 3,22 CLASS 3, STREAM 22. M6S22 BYT 6,22 CLASS 6, STREAM 22. M7S22 BYT 7,22 CLASS 7, STREAM 22. D20 DEC 20 D23 DEC 23 D125 DEC 125 B27 EQU D23 N1 DEC -1 N3 DEC -3 N5 DEC -5 N6 DEC -6 N8 DEC -8 N150 DEC -150 NB22 OCT -22 NB25 OCT -25 "XX" ASC 1,XX $RNTA DEF $RNTB LOG NOP NAME BSS 3 TEMP NOP TEMP1 NOP TEMP2 NOP RCVLN NOP RQLEN NOP DABUF NOP DALEN NOP * C#PLW ABS #PLW L#CML ABS #CML+1 L#LNL ABS #LNL+1 L#PCB ABS #PCB+3 L#IOF ABS #IOF+1 L#ITR ABS #ITR+1 L#IC2 ABS #IC2+1 L#TYP ABS #TYP+1 L#DCB ABS #DCB+3 L#NNM ABS #NNM+3 L#IOP ABS #IOP+1 L#IR ABS #IR+1 L#ISC ABS #ISC+1 L#NUM ABS #NUM+1 L#XXX ABS #OPT+1 L#PM2 ABS #PM2+1 L#PRM ABS #PRM+1 L#PMS ABS #PMS+5 L#TYR ABS #TYR+1 L#MSC ABS #MSC+1 L#HRS ABS #HRS+1 L#ST3 ABS #ST3+1 C#LSZ ABS #LSZ * C#MXR ABS #MXR MAX LENGTH OF DS/1000 REQUEST. RQB BSS #MXR DS/1000 REQUEST BUFFER. D#RQB DEF RQB NAMA DEF RQB+#DCB PCBA DEF RQB+#PCB CMDA DEF RQB+#CMS ACTA DEF RQB+#LUN * MXCMD ABS #OLW-#CMS MAXIMUM LENGTH OF COMMAND STRING. MXUSR ABS #OLW-#LUN MAXIMUM LENGTH OF ACCOUNT IN HELLO. * TSTAD NOP ADDR OF TST ENTRY IN S.A.M. TSTLN DEC 14 LENGTH OF TST ENTRY. LTSTA DEF T+STR1 ADDR OF LOCAL TST AREA. SPC 1 * OFFSETS INTO LOCAL TST AND DS/3000 REQUEST BUFFER: T EQU D$TST STR1 EQU 0 DS/1000 STREAM LSEQ EQU 1 LOCAL SEQUENCE NO HCLS EQU 2 HOLDING CLASS NO MCLS EQU 3 MONITOR CLASS NO FNCD EQU 4 FUNCTION CODE MASK EQU 5 POPEN MASK WORD CLS3 EQU 6 DS/3000 CLASS STR3 <{EQU 8 DS/3000 STREAM PRC3 EQU 10 PROCESS NUMBERS SEQ3 EQU 11 SEQUENCE NUMBER BYT3 EQU 13 BYTE COUNT APNG EQU 14 APPENDAGE APN1 EQU 15 APPENDAGE WORD 1 APN2 EQU 16 APPENDAGE WORD 2 APN3 EQU 17 APPENDAGE WORD 3 APN4 EQU 18 APPENDAGE WORD 4 APN5 EQU 19 APPENDAGE WORD 5 APN6 EQU 20 APPENDAGE WORD 6 APN7 EQU 21 APPENDAGE WORD 7 APN8 EQU 22 APPENDAGE WORD 8 APN9 EQU 23 APPENDAGE WORD 9 AP10 EQU 24 APPENDAGE WORD 10 AP11 EQU 25 APPENDAGE WORD 11 AP13 EQU 27 APPENDAGE WORD 13 AP21 EQU 35 APPENDAGE WORD 21 AP47 EQU 61 APPENDAGE WORD 47 * ARQ8 DEF T+APNG ARQ10 DEF T+APN2 ARQ11 DEF T+APN3 ARQ12 DEF T+APN4 ARQ13 DEF T+APN5 ARQ29 DEF T+AP21 * BSS 0 ******** SIZE OF RQCNV ************ * END RQCNV  j 91750-18172 2013 S C0122 &RSM              H0101 XfASMB,R,Q,C HED RSM 91750-16172 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM RSM,19,20 91750-16172 REV.2013 800314 RTE-IVB W/S.M. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 EXT .CLGN,.CLGF,#DFUN,#PASS,#POOL,#RSAX EXT #RQUE,#LDEF,#RSM,#RPB,#NRVS,#MNUM EXT #SLAV,$OPSY,DTACH,$LIBR,$LIBX,#GETR EXT #NODE,#BREJ,$TIME,#QCLM EXT .DRCT,.LBT,.CBT,.MBT,.MVW,$CVT1 EXT EXEC,LUSES,IDRPD * RQB EQU #RPB * SUP * * NAME: RSM * SOURCE: 91750-18172 * RELOC: 91750-16172 * PGMR: JIM HARTSELL * * * IS THE DS/1000 REMOTE SESSION-MONITOR INTERFACE MODULE. * RUNS IN ALL SESSION-MONITOR NODES AND INSURES THAT REMOTE-USER * ACCESS TO THIS NODE FALLS UNDER THE SAME SYSTEM PROTECTION PROVIDED * BY THE SESSION MONITOR. * * THE FIRST REQUEST SENT FROM EACH REMOTE MASTER WILL TYPICALLY NOT * CONTAIN A DESTINATION SESSION ID IN THE HEADER. RETHREADS * THESE REQUESTS TO . IF THE REQUEST IS AN EXPLICIT LOG-ON REQUEST * (VIA SW/AT COMMANDS OR LOG-ON CALL), WILL CREATE * A SESSION FOR THE SPECIFIED USER-NAME. OTHERWISE, WILL CREATE A * SESSION FOR THE DEFAULT USER-NAME SPECIFIED DURING INITIALIZATION. * ALL SUBSEQUENT REQUESTS BY THE MASTER USER WILL CONTAIN THE IDENTIFIER * FOR THE SESSION AND WILL BE PASSED BY DIRECTLY TO THE SERVING * SLAVE MONITOR (, , ETC.). THE SLAVE MONITORS WILL ATTACH * TO THE SPECIFIED SESSION FOR THE EXECUTION OF THE REQUEST, THEN DETACH. * * SESSIONS WILL BE LOGGED OFF ON REQUEST OF THE USER ( DE/EX * COMMANDS OR LOG-OFF) OR BY AFTER THE PROGRAM TERMINATES. * * ALL ACCESS FROM "OLD NODES" (MESSAGE FORMAT LEVEL 0) WILL BE ASSIGNED * TO THE SAME PERMANENT DEFAULT SESSION, SUCH THAT THE RESULTING SHARED * ACCESS WILL APPEAR TO THE USER AS A NON-SESSION-MONITOR SYSTEM. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSIO,N ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP A EQU 0 B EQU 1 * RSM EQU * LDB $OPSY RBR,SLB SKIP IF NON-DMS CLA,RSS JMP DTCH STA MOD1 * DTCH JSB DTACH DETACH FROM SESSION. DEF *+1 * RSGET JSB #GETR HANG ON CLASS: READ ENTIRE REQUEST DEF *+4 INTO RSM AND SAVE S.A.M. BUFFER. DEF #RSM DEF RQB REQUEST BUFFER DEF C#MXR MAXIMUM LENGTH. * JMP RSGET ERROR RETURN. * * SUCCESSFUL READ COMPLETION LOGIC FOLLOWS * SQ CLA STA SID STA PDFLG STA LGERR CLEAR ERROR REPLY VALUES. STA LGTYP STA LGQLF * JSB #NRVS GET +NODE NUMBER AND UPGRADE LEVEL DEF *+6 OF SOURCE NODE. DEF RQB+#SRC -LU OR +NODE FOR SEARCH. DEF TEMP DUMMY (MASTER TIME-OUT). DEF SLEVL SOURCE UPGRADE LEVEL RETURNED. DEF TEMP DUMMY (NEIGHBOR). DEF SNODE +SOURCE NODE # IF CALLED WITH -LU. NOP ERROR RETURN. * LDA RQB+#SRC WAS #NRVS CALL MADE WITH +NODE? SSA,RSS STA SNODE YES. STORE ORIGINAL SOURCE NODE PARAM. * LDA RQB+#STR GET STREAM WORD. AND B77 CPA B7 OPERATOR COMMAND? RSS JMP DEFLT NO. DEFAULT SESSION NEEDED. * LDA RQB+#CML YES. COMMAND LEN = 2? ADA N2 SSA JMP DEFLT NO. USER WANTS DEFAULT SESSION. * LDA RQB+#CMS YES. COMMAND = "XX"? CPA "XX" JMP ACCNT YES. LOGON/LOGOF/NON-SESSION. * * DEFAULT SESSION REQUIRED. * DEFLT LDA SLEVL REQUEST FROM OLD NODE (LEVEL 0)? SZA JMP DFLT1 NO. * * REQUEST IS FROM AN OLD LEVEL 0 NODE (NO SESSION ID FIELD IN HEADER). * USE PERMANENT DEFAULT SESSION CREATED SOLELY FOR OLD NODES. THIS * SESSION IS CREATED WHEN IT IS FIRST NEEDED, AND FROM THEN ON EVERY * OLD NODE REQUEST WILL PASS THRU HERE AND BE ASSIGNED THE "OLD NODE * PERMANENT DEFAULT SESSION" ID. OLD NODES CANNOT SEND LOG-OFF REQUESTS * FOR THIS SESSION. * LDA PDFID HAVE WE CREATED THE "PERMANENT" SZA,RSS "OLD NODE" SESSION? JMP DPERM NO. GO CREATE IT. * JSB LUSES YES. IS IT STILL UP? DEF *+2 DEF PDFID * SZA,RSS JMP SGONE NO. LDA PDFID YES. PUT SESSION ID IN REQUEST STA SID AND DISPATCH TO PROPER MONITOR. JMP STID1 * SGONE LDA PDFEN GET ADDRESS OF "PERM DEFAULT" ENTRY. JSB RLEAS RELEASE TH-pE POOL ENTRY. * DPERM CLA,INA FLAG THAT THIS IS TO BE THE OLD STA PDFLG NODE "PERMANENT" DEFAULT SESSION. * * SET UP TO CREATE DEFAULT SESSION. ALL "NEW NODE" USERS GET THEIR * OWN SESSIONS SO THAT INTER-SESSION COMMUNICATION CAN TAKE PLACE. * DFLT1 CLA CLEAR "LOGON" FLAG. STA LGFLG * JSB .DRCT MOVE DEFAULT USER NAME DEF #DFUN LDB DLGBF TO LOGON BUFFER. JSB .MVW DEF D11 NOP LDA D21 SET LENGTH IN BYTES. STA LGLEN JMP SCAN GO FIND SESSION ID. * * EXPLICIT DLGON/DLGOF/DLGNS REQUEST. * ACCNT CLA,INA SET "LOGON" FLAG. STA LGFLG * LDA RQB+#LGC GET REQUEST CODE. CPA B1 JMP RLGON GO DO LOG-ON. CPA B2 JMP NONSM GO DO NON-SESSION. JMP RLGOF GO DO LOG-OFF (O OR -1). * RLGON LDA RQB+#LNL GET # BYTES IN USER NAME. ADA N33 CHECK LIMIT, LDB RQB+#LNL AND IF NECESSARY, SSA,RSS TRUNCATE TO THE LDB D32 MAXIMUM OF 32 CHARACTERS. STB LGLEN JSB .DRCT MOVE REQUESTED USER NAME DEF RQB+#LUN RAL LDB DLGBF TO LOGON BUFFER. RBL JSB .MBT DEF LGLEN NOP * * CHECK FOR "HELLO" FOLLOWED BY "HELLO" FROM AN HP 3000. ALSO, * CHECK FOR ABANDONED SESSION THAT MAY HAVE BEEN CREATED FROM THE * SOURCE STATION LU (SOURCE SESSION ID). THIS CAN HAPPEN WHEN THE * SOURCE NODE IS REBOOTED WITHOUT A LOG-OFF. IF ONE IS FOUND, LOG IT OFF. * (...IF SOURCE SID IS ZERO, SESSION WAS CREATED FROM A PROGRAM OR * TERMINAL IN A NON-MTM/SESSION NODE OR FROM THE SYSTEM CONSOLE IN AN * MTM/SESSION NODE... NOTHING CAN BE DONE HERE UNTIL FUTURE ENHANCEMENTS * TIE SEQUENCE NUMBERS TO ALL SESSION IDENTIFIERS. * SCAN LDA RQB+#SID ALF,ALF AND B377 SOURCE SESSION ID (STATION LU, ZERO, STA OSID 254, MTM LU, OR MPE "FROM PROCESS #"). SZA,RSS TAKE JzdUMP IF NO SOURCE SESSION ID (COULD JMP FLUSH BE FROM "OLD" NODE OR "AUTO-SCHED" PROG. * LDB #POOL GET ADDR OF SID POOL. JSB LODWD STA TEMP SAVE # POOL ENTRIES (NEGATIVE). INB * SCANL STB POOLA SAVE POOL ENTRY ADDRESS. JSB LODWD (CROSS) LOAD WORD 1 OF NEXT ENTRY. SSA,RSS SIGN BIT SET (IN USE)? JMP BUMPI NO. GO TO NEXT ENTRY. * INB YES. CHECK SOURCE NODE #. JSB LODWD (IF 3000 2ND HELLO, SOURCE NODE # WILL CPA SNODE BE LOCAL NODE # IN REQUEST & IN #POOL.) RSS JMP BUMPJ NO MATCH. INB MATCH. CHECK SOURCE SESSION ID JSB LODWD OR MPE "FROM PROCESS #". AND B377 CPA OSID RSS JMP BUMPK NO MATCH. * LDB POOLA MATCH. GET DEST. SESSION ID. JSB LODWD AND B377 ISOLATE. IOR BIT13 SET BIT 13 TO KILL ACTIVE PROGS. STA OSID STORE FOR LOG OFF. * JSB .CLGF LOG OFF PRIOR (OR ABANDONED) SESSION. OSID OCT 0 * (A) = COMPLETION CLASS #. SSA,RSS IF SESSION NOT INITIALIZED (!), SZA,RSS OR IF SCB NOT FOUND, JMP RPOOL SKIP THE CLASS FLUSH. * JSB LRSPN FLUSH RESPONSE FROM "LOGON". CLA IGNORE LOGOF ERROR BY STA LGTYP CLEARING ANY RETURNED STA LGERR ERROR CODES. * RPOOL JSB RLEAS RELEASE #POOL ENTRY AT "POOLA". JMP FLUSH GO FLUSH ID POOL. * BUMPI INB BUMPJ INB BUMPK ADB POOSZ ADB N2 (FOR POOSZ-2) ISZ TEMP JMP SCANL LOOP TILL DONE. * * FLUSH ID POOL OF ALL "IN USE" ENTRIES FOR WHICH A SESSION NO LONGER * EXISTS, INCLUDING THE FIRST ENTRY (PERMANENT "OLD NODE" DEFAULT SESSION). * FLUSH LDB #POOL GET ADDRESS OF SID POOL. JSB LODWD GET # POOL ENTRIES (NEGATIVE). STA CNT INB POINT TO 1ST POOL ENTRY. FLOOP JSB LODWD (CROSS) LOAD WORD 1 OF POOL ENTRY. SSA,RSS IS ENTRY IN USE (CHECK BIT 15)? JMP FNEXT NO. GO TO NEXT POOL ENTRY. * STB POOLA YES. SAVE ADDRESS OF POOL ENTRY. AND B377 ISOLATE "IN-USE" SESSION ID. STA IOP1 * JSB LUSES IS THE SESSION FOR THIS DEF *+2 #POOL ENTRY STILL AROUND? DEF IOP1 * LDB POOLA (RESTORE B-REGISTER) SZA JMP FNEXT YES. ENTRY IS GOOD. JSB RLEAS NO. RELEASE POOL ENTRY AT "POOLA". LDA IOP1 WAS THIS THE PERM. DEFAULT SESSION? CLB CPA PDFID STB PDFID YES. INDICATE THAT IT IS GONE. LDB POOLA * FNEXT ADB POOSZ ADVANCE TO NEXT POOL ENTRY. ISZ CNT JMP FLOOP LOOP TILL DONE. * * FIND AN AVAILABLE SESSION IDENTIFIER IN SESSION ID POOL. EACH * POOL ENTRY CONSISTS OF: SESSION ID (BIT 15 SET IF IN USE), OWNER'S * NODE NUMBER, OWNER'S SOURCE SESSION ID, AND THREE WORDS FOR NAME OF * PROGRAM SCHEDULED IN THIS SESSION FROM A REMOTE NODE. * THE FIRST ENTRY IS DEDICATED FOR USE AS THE PERMANENT "OLD NODE" * DEFAULT SESSION. * LDB #POOL GET ADDR OF SID POOL. JSB LODWD GET # POOL ENTRIES (NEGATIVE). STA CNT INB POINT TO 1ST POOL ENTRY. * LDA PDFLG ARE WE CREATING THE PERMANENT SZA,RSS "OLD NODE" DEFAULT SESSION? JMP NXENT NO. ADVANCE TO 2ND #POOL ENTRY. JSB LODWD YES. FIRST ENTRY IS FOR JMP IDFND THIS PURPOSE. * LOOP JSB LODWD (CROSS) LOAD WORD 1 OF NEXT ENTRY. SSA,RSS IS SIGN BIT SET? JMP IDFND NO. THIS ID IS AVAILABLE. * NXENT ADB POOSZ BUMP ADDR TO NEXT ID. ISZ CNT END OF POOL? JMP LOOP NO, CONTINUE. * JMP RS03 GIVE A "SESSION LIMIT" ERROR. * IDFND AND B377 STA SID SAVE SESSION ID. STB POOLA SAVE ADDRESS OF SID POOL ENTRY. * JSB LUSES DOES SOME OTHER SUBSYSTEM HAVE A DEF *+2 SESSION FOR THIS ID? DEF SID (NOT EXPECTED) * LDB POOLA (RESTORE (B)) SZA JMP NXENT YES. GO TO NEXT #POOL ENTRY. * LDA SID NO. ALL CLEAR. IOR BIT15 SET SIGN BIT FOR "IN USE". JSB STUFF STORE BACK TO #POOL ENTRY. * * STORE OWNER'S NODE # AND SOURCE SESSION ID IN POOL ENTRY. * IF PERMANENT "OLD NODE" DEFAULT SESSION, ONLY THE CREATING NODE * WILL BE DESCRIBED. * INB LDA SNODE JSB STUFF STORE NODE NUMBER. INB LDA RQB+#SID ALF,ALF AND B377 JSB STUFF STORE SOURCE SESSION ID. * * PERFORM PROGRAMMATIC LOG-ON. * LDB DLGBF ADDRESS OF ACCOUNT NAME. LDA LGLEN LENGTH OF ACCOUNT NAME IN BYTES. CMA,INA NEGATIVE # BYTES. * JSB .CLGN CALL LOGON. SID OCT 0 SESSION IDENTIFIER. * (A) = COMPLETION CLASS #. SSA,RSS IF SESSION NOT INITIALIZED (!), JMP GETRS LDA "SM" SET FOR "REMOTE SESSION STA LGTYP NOT INITIALIZED" ERROR, LDA "00" STA LGERR JMP RLESP AND SEND REPLY. * GETRS JSB LRSPN GET RESPONSE FROM "LOGON". * SZA,RSS IF NO ERROR, JMP RSLT GO FINISH UP. * RLESP JSB RLEAS ERROR. RELEASE POOL ENTRY (IF ANY). CLA STA SID CLEAR SESSION ID. * JMP REPLY SEND REPLY. * RSLT JSB DTACH DETACH FROM "LOG-ON" SESSION. DEF *+1 * LDA LGFLG WAS THIS AN EXPLICIT LOG-ON REQ? SZA,RSS JMP STID NO. * * SEND A REPLY FOR LOG-ON, LOG-OFF, OR NON-SESSION ACCESS REQUEST * REGARDLESS OF WHETHER IT CAME FROM AN HP 1000 OR HP 3000, AND * WHETHER OR NOT A LOGON/LOGOF ERROR OCCURRED. * SEND REPLIES FOR SLAVE MONITORS WHEN DEFAULT SESSION LOG-ON FAILED. * REPLY LDA RQB SET REPLY BIT. IOR RPBIT STA wRQB LDA RQB+#SID STORE DEST SESSION ID (IF ANY). AND B1774 IOR SID STA RQB+#SID LDA LGERR STORE LOGON ERROR CODE (IF ANY). STA RQB+#EC2 LDB LGTYP STORE ERROR TYPE CODE (IF ANY). STB RQB+#EC1 LDA #NODE GET LOCAL NODE NUMBER. SZB IF LGTYP NOT ZERO, IOR BIT15 SET SIGN BIT. STA RQB+#ENO STORE REPORTING NODE NUMBER. LDB LGQLF GET QUALIFIER. BLF POSITION. LDA RQB+#ECQ AND NOTQ IOR B PLACE QUALIFIER (IF ANY) IN REPLY. STA RQB+#ECQ * SNRPY JSB #SLAV SEND THE REPLY. DEF *+4 (CAN ALSO GO TO RPCNV.) DEF C#MHD DEF B0 DEF B0 NOP IGNORE ERROR RETURN. * * RELEASE THE BUFFER IN S.A.M. * CLEAR LDA #RSM ALR,RAR CLEAR "SAVE BUFFER" FLAG. STA CLASS * JSB EXEC DO DUMMY GET TO CLEAR DEF *+5 CLASS BUFFER. DEF SD21 DEF CLASS DEF RQB DEF B0 NOP IGNORE ERROR. * JMP RSGET GO BACK TO GET. * * RETHREAD "CORRECTED" HP 1000 REQUESTS TO PROPER MONITOR. * STID LDA PDFLG IS THIS THE PERMANENT DEFAULT SZA,RSS SESSION FOR OLD NODES? JMP STID1 NO. LDA SID YES. SAVE STA PDFID SESSION ID LDA POOLA AND STA PDFEN POOL ENTRY ADDRESS. CLA CLEAR THE FLAG. STA PDFLG * STID1 LDA RQB+#SID GET SESSION ID WORD OF REQ. AND B1774 CLEAR OLD DEST SESSION ID. IOR SID STORE DEST SESSION ID. STA RQB+#SID * LDA RQB+#STR FIND MONITOR'S CLASS #. AND B77 ISOLATE STREAM. ADA #LDEF ADA B2 POINT TO LIST HEADER POINTER. LDB A,I POINT TO LIST HEADER. INB ADDR OF CLASS #. LDA B,I GET MONITOR'S CLASS #. RAL,CLE,ERA CLEAR SIGN BIT. STA CLASS Q* JSB #RQUE RETHREAD TO MONITOR. DEF *+9 DEF K20N ICODE. DEF B10K REQUE WITH Z BIT SET. DEF B0 NO DATA. DEF B0 DEF RQB SPECIFY 14-WORD OVERLAY. DEF D14 DEF CLASS DEST. CLASS #. DEF #RSM SOURCE CLASS #. * RSS ERROR RETURN. JMP RSGET NORMAL RETURN. * CPA "DS" LOOK FOR DS08 ERROR. RSS JSB ERR1 (JSB IS FOR COMPUTING RELATIVE ADDR) CPB "08" RSS IF DS08, THEN BUSY ERROR. JSB ERR1 (JSB IS FOR COMPUTING RELATIVE ADDR) * STA RQB+#EC1 RETURN BUSY ERROR. STB RQB+#EC2 LDA #NODE IOR BIT15 STA RQB+#ENO LDA RQB+#STR AND RTYCT IOR RPBIT IOR #BREJ STA RQB+#STR JMP SNRPY GO SEND REPLY. SKP * * REQUEST FOR NON-SESSION ACCESS. * NONSM LDA #PASS IS "RES" PASSWORD BLANK? CPA BLNKS JMP NSID YES. ALLOW ACCESS. * LDA N10 FIND # CHAR IN "RES" PASSWORD. STA TEMP CLA STA CNT INITIALIZE CHARACTER COUNT. JSB .DRCT DEF #PASS LDB A RBL COUNT JSB .LBT CPA B40 JMP CKSLS ISZ CNT COUNT CHARACTERS UNTIL BLANK ISZ TEMP OR END OF FIELD. JMP COUNT * CKSLS LDA RQB+#LUN SET "SLASH FIX" DEPENDING WHETHER ALF,ALF REQUEST PASSWORD BEGINS WITH AND B377 A SLASH OR NOT. CLB CPA SLASH INB STB SLSHF 0 = NO SLASH, 1 = SLASH PRESENT. CMB,INB PRIME TO SUBTRACT "SLASH FIX". * ADB RQB+#LNL COMPARE PASSWORD LENGTHS. CPB CNT RSS JMP RS05 DIFFERENT LENGTHS. ERROR. * JSB .DRCT COMPARE PASSWORDS. DEF #PASS PASSWORD IN "RES". RAL STA B JSB .DRCT DEF RQB+#LUN PASSWORD IN REQUEST BUFFER. RAL ADA SLSHF sU ADD "SLASH FIX". JSB .CBT DEF CNT NOP JMP NSID PASSWORD MATCHES. JMP RS05 MISMATCH, JMP RS05 MISMATCH. ERROR. * NSID LDA D254 MATCH. ALLOW ACCESS. STA SID SET SESSION ID = 254. JMP REPLY GO SEND REPLY. SKP * * REQUEST FOR LOG-OFF. CAN BE A "NO-REPLY" REQUEST!!! * RLGOF LDA RQB+#LNL GET LOG-OFF SESSION ID. AND B377 ISOLATE. STA OFFID * LDB #POOL GET ADDR OF SID POOL. JSB LODWD GET # POOL ENTRIES (NEGATIVE). STA TEMP INB POINT TO 1ST POOL ENTRY. LOOP1 JSB LODWD (CROSS) LOAD WORD 1 OF NEXT ENTRY. SSA,RSS ENTRY IN USE? JMP NEXTP NO. GO CHECK NEXT ENTRY. AND B377 CPA OFFID YES. DEST SESSION ID? JMP SAVAD YES. NEXTP ADB POOSZ NO. GO CHECK NEXT ENTRY. ISZ TEMP JMP LOOP1 JMP CKREP NOT FOUND. * SAVAD STB POOLA FOUND. SAVE ADDR OF POOL ENTRY. * LDA RQB+#LGC IS THIS AN UPLIN LOG-OFF FOR A INA,SZA TERMINATED/ABORTED MASTER PROGRAM? JMP KILL NO. * JSB LODWD YES. TELL DS SLAVE MONITORS (#ATCH) NOT IOR BIT13 TO ATTACH TO THIS DYING SESSION. JSB STUFF (SET BIT 13 OF 1ST WORD IN #POOL ENTRY.) * JSB LUSES GET SCB POINTER FOR THIS SESSION. DEF *+2 DEF OFFID SZA,RSS JMP KILL1 STA SCBP SAVE THE SCB POINTER. * JSB $LIBR GO PRIVILEGED. NOP * LDA KEYWD GET ADDRESS OF KEYWORD TABLE. STA KEYPT SET POINTER TO TOP OF TABLE. SLOOP LDB KEYPT,I GET NEXT ID SEGMENT ADDRESS. SZB,RSS JMP IDEND END OF LIST. ADB D32 POINT TO SCB POINTER WORD. LDA B,I GET SCB POINTER, IF ANY. CPA SCBP IS THIS ID SEGMENT ATTACHED TO THE RSS SESSION TO BE LOGGED OFF? JMP NXTID NO. GO CHECK NEXT ID SEGMENT. P* ADB N20 YES. CHECK IF IT'S A DS SLAVE MONITOR. CLE,ELB STB ADDR BYTE ADDR OF NAME IN ID SEGMENT. LDA #MNUM NUMBER OF SLAVE-STREAM TYPES. CMA,INA STA CNT SET COUNTER. * LDB #LDEF SEARCH SLAVE MONITOR NAMES ADB B2 FOR ID-SEGMENT NAME. STB TEMP ADDR OF 1ST SLAVE-STREAM HEADER ADDR. HLOOP LDB TEMP,I NEXT SLAVE-STREAM HEADER ADDR. ADB B2 ADDR OF MONITOR NAME IN ENTRY. CLE,ELB BYTE ADDR OF MONITOR NAME. LDA ADDR BYTE ADDR OF NAME IN ID SEGMENT. JSB .CBT COMPARE THE NAMES. DEF B5 NOP JMP DTCHM MATCH. GO DETACH THE DS MONITOR. NOP ISZ TEMP NO MATCH. GO TO NEXT SLAVE HEADER ADDR. ISZ CNT JMP HLOOP LOOP TILL END OF HEADERS. JMP NXTID ATTACHED PROG NOT A DS MONITOR. * DTCHM LDB KEYPT,I DETACH THE DS SLAVE MONITOR ADB D32 FROM THE SESSION BY CLA CLEARING THE SCB POINTER WORD STA B,I IN THE ID SEGMENT. * NXTID ISZ KEYPT POINT TO NEXT ID SEGMENT. JMP SLOOP GO CHECK IT OUT. * IDEND JSB $LIBX GO UN-PRIVILEGED. DEF *+1 DEF *+1 * KILL LDA OFFID SET BIT 13 TO KILL ACTIVE PROGS. IOR BIT13 STA OFFID * JSB .CLGF CALL LOGOF. OFFID OCT 0 SESSION ID. * (A) = COMPLETION CLASS #. SSA,RSS IF SESSION NOT INITIALIZED (!), SZA,RSS OR SCB NOT FOUND, JMP *+2 SKIP THE CLASS BUFFER FLUSH. * JSB LRSPN GET RESPONSE FROM LOGOF. * KILL1 JSB RLEAS RELEASE #POOL ENTRY AT "POOLA". * CLA STA SID * CKREP LDA RQB+#LGC CHECK IF "NO-REPLY" LOG-OFF. INA,SZA JMP REPLY GO SEND A REPLY. * JSB #RSAX NO REPLY. RELEASE "OPERM'S" TCB. DEF *+4 DEF B7 DEF RQB+#SEQ (SEQ # = 0) DEF RQB+#STR ٜ(STREAM 7 ) * JMP CLEAR GO RELEASE S.A.M. BUFFER. SKP * * SUBR. TO PROCESS RESPONSE BUFFERS FROM REPLY CLASS OF LOGON AND LOGOF. * SET (A) = REPLY CLASS NUMBER PASSED FROM LOGON/LOGOF. * RETURNS WITH ERROR CODE (OR ZERO) IN (A) AND IN "LGERR". * LRSPN NOP STA CLASS STORE REPLY CLASS NUMBER. LDA "RS" PRE-LOADED IN CASE THERE IS STA LGTYP AN I/O CLASS ERROR ON LOGON STATUS. * LRSP1 JSB EXEC GET RESPONSE FROM LOGON/LOGOF. DEF *+8 DEF SD21 DEF CLASS CLASS NUMBER. DEF LGBUF BUFR FOR ASCII MSGS. DEF B0 LENGTH. (NORMALLY 128 WORDS, BUT ASCII DEF IOP1 INFO NOT DISPL SINCE NOT INTERACTIVE. DEF IOP2 PARAM FROM LOGON. DEF CALL JMP LRSPE ERROR RETURN. * LDA CALL FETCH CALL TYPE. CPA B1 MUST BE READ OR WRITE/READ. RSS JMP LRSP1 TRY AGAIN. * LDA IOP2 FETCH LOGON/LOGOF STATUS. SSA,RSS IF NEGATIVE (ERROR TERMINATION) SZA,RSS OR ZERO (GOOD LOGON/LOGOF RETURN) RSS CONTINUE, JMP LRSP1 ELSE GET NEXT MESSAGE. * CLA NO "RS" ERROR FROM LOGON STATUS, STA LGTYP SO CLEAR THE ERROR TYPE. LDA CLASS REMOVE "SAVE CLASS" BIT. XOR BIT13 STA CLASS * AGAIN JSB EXEC RELEASE THE LOGON/LOGOF CLASS. DEF *+5 DEF SD21 DEF CLASS DEF LGBUF DEF B0 RSS JMP AGAIN * LDA IOP2 EXTRACT LOGON/LOGOF ERROR CODE ALF,ALF (IF ANY). RAL,RAL AND B77 LDB "SM" IF LOGON/OF ERROR, SZA,RSS JMP LEXIT STB LGTYP SET ERROR TYPE = "SM". RSS LRSPE LDA B2 FORCED ERROR CODE FOR CLASS GET. CCE JSB $CVT1 CONVERT ERROR CODE TO ASCII. IOR LB60 MAKE SURE LEFT BYTE IS ACSII. LEXIT STA LGERR (ERROR TYPE ALREADY SET) +* JMP LRSPN,I RETURN TO CALLER. SKP * * SUBROUTINE TO RELEASE #POOL ENTRY. * RLEAS NOP LDB POOLA ADDR OF POOL ENTRY TO RELEASE. SZB,RSS JMP RLEAS,I EXIT IF NONE. * JSB LODWD GET WORD 1. RAL CHECK BIT 14 FOR CLONED PROG. SSA,RSS JMP RCLR NO CLONED ID SEGMENT. * LDB POOLA GET NAME OF CLONED PROGRAM ADB B3 FROM #POOL ENTRY JSB LODWD INTO LOCAL STORAGE. STA BUF INB JSB LODWD STA BUF+1 INB JSB LODWD STA BUF+2 * JSB IDRPD RELEASE CLONED ID SEGMENT. DEF *+3 DEF BUFAD ADDR OF PROGRAM NAME. DEF TEMP RETURNED ERROR CODE. * RCLR LDB POOLA RELEASE #POOL ENTRY. JSB LODWD GET WORD 1. AND B377 CLEAR ALL LEFT BYTE FLAGS. JSB STUFF STORE BACK. * LDA POOSZ CLEAR WORDS 2-LAST. CMA,INA INA STA TEMP LDB POOLA CLA CLENT INB JSB STUFF ISZ TEMP JMP CLENT * JMP RLEAS,I RETURN. SKP * * SUBROUTINE TO STORE A WORD IN SAM. * STUFF NOP JSB $LIBR GO PRIVILEGED. NOP MOD1 JMP STUF2 NOP HERE IF DMS. XSA B,I STORE IN ALTERNATE MAP. RSS STUF2 STA B,I JSB $LIBX DEF STUFF * * LOAD WORD FROM S.A.M., CROSS-LOAD IF DMS SYSTEM. * LODWD NOP LDA $OPSY OPERATING SYSTEM TYPE. RAR,SLA SKIP IF NON-DMS. JMP *+3 DMS. GO EXECUTE XLA. LDA B,I NON-DMS. PICK UP SAM WORD. JMP LODWD,I RETURN. XLA B,I CROSS-LOAD SAM WORD. JMP LODWD,I SKP * * ERROR SECTION FOR ALL RSM-GENERATED ERRORS. * ("RS02" IS DONE IN THE "LRSPN" SUBROUTINE.) * RS03 CLA,INA SET QUALIFIER = 1. STA LGQLF LDA "03" NODAL SESSION LIMIT EXCEEDED. JMP ERTN1 RS05 LDA "05" WRONG PASSWORD FOR NONԅ-SESSION. * ERTN1 STA LGERR STORE AS LOGON ERROR CODE. LDA "RS" SET ERROR CODE TYPE. STA LGTYP CLA CLEAR SESSION ID. STA SID LDA RQB+#STR INITIALIZE RETRY COUNTERS. AND RTYCT IOR #BREJ STA RQB+#STR * JMP REPLY SEND REPLY. * * THIS REQUEST IS NON-RECOVERABLE, CLEAR, LOG, THEN IGNORE IT * ERR1 NOP HERE TO REPORT IRRECOVERABLE ERROR DST RQB+5 SAVE REGS FOR QCLM LDA @RSM GET BASE ADDR OF "RSM". CMA,INA GET RELATIVE ERROR ADDRESS ADA ERR1 AND STA RQB+4 PASS ERROR ADDR TO QCLM. DLD $TIME RECORD TIME OF ERROR DST RQB+7 LDA PNAME PASS PROGRAM NAME (RSM). STA RQB+9 DLD PNAME+1 DST RQB+10 LDA #QCLM SZA,RSS IF NO QCLM, JMP CLEAR FORGET MESSAGE. * JSB EXEC MAILBOX WRITE/READ TO QCLM DEF *+8 DEF K20N DEF B0 DEF RQB DEF D12 DEF B0 DEF B0 DEF #QCLM NOP * JMP CLEAR GO CLEAR BUFFER IN SAM. SKP * * CONSTANTS AND STORAGE * KEYWD EQU 1657B B0 OCT 0 B1 OCT 1 B2 OCT 2 B3 OCT 3 B5 OCT 5 B7 OCT 7 B40 OCT 40 B10K OCT 010000 BIT13 OCT 020000 BIT15 OCT 100000 B77 OCT 77 B377 OCT 377 B1774 OCT 177400 NOTQ OCT 177417 SD21 OCT 100025 SLASH OCT 57 LB60 OCT 30000 POOSZ DEC 7 SIZE OF #POOL ENTRY. D11 DEC 11 D12 DEC 12 D14 DEC 14 D21 DEC 21 D32 DEC 32 D254 DEC 254 N2 DEC -2 N10 DEC -10 N20 DEC -20 N33 DEC -33 K20N OCT 100024 C#MHD ABS #MHD SNODE NOP SLEVL NOP POOLA NOP LGTYP NOP LGERR NOP LGQLF NOP LGFLG NOP PDFLG OCT 0 PDFID OCT 0 PDFEN NOP SLSHF NOP TEMP NOP CLASS NOP CALL NOP CNT NOP SCBP NOP ADDR NOP KEYPT NOP IOP1 NOP IOP2 NOP @RSM DEF RSM PNAME ASC 3,RSM LGBUF BSS 1 CAN BE MADE 128 WORDS IF NEED ARISC~`^ZES. DLGBF DEF LOGBF LOGBF BSS 16 LGLEN NOP BUFAD DEF BUF BUF BSS 3 RPBIT OCT 40000 RTYCT OCT 170077 STREAM WORD RETRY COUNT MASK * "RS" ASC 1,RS "SM" ASC 1,SM "XX" ASC 1,XX BLNKS ASC 1, "00" ASC 1,00 "03" ASC 1,03 "05" ASC 1,05 "08" ASC 1,08 "DS" ASC 1,DS C#MXR ABS #MXR * BSS 0 SIZE OF RSM. * END RSM ޏ` k 91750-18173 2013 S C0122 &RTRY              H0101 kASMB,R,L,C HED RTRY 91750-16173 REV 2013 * (C) HEWLETT-PACKARD CO. 1979* NAM RTRY,17,20 91750-16173 REV 2013 800107 ALL SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 **************************************************************** * * NAME: RTRY * SOURCE: 91750-18173 * RELOC: 91750-16173 * PGMR: CHUCK WHELAN * DATE WRITTEN DEC 1976 * * MODIFIED BY: LYLE WEIMAN, JAN. '78 * MODIFIED BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/ JSB'S * MODIFIED BY CCH [790330] TO ELIMINATE REFERENCE TO . * MODIFIED BY DWT [790424] FOR PHASE TWO (#NRVS). * MODIFIED BY DWY [790606] FOR PHASE FIVE (REMOVE O/S DEPENDENCE). * *************************************************************** SPC 3 EXT EXEC,$TIME,DTACH EXT #RDLY,#GETR,#PUTR EXT #RQUE,#QCLM,#RTRY,#GRPM,#NRVS * * SPC 3 * RTRY PERFORMS WRITE RETRIES IN THE DS/1000 SYSTEM * * WHEN A WRITE OPERATION FAILS, "GRPM" RETHREADS THE CLASS BUFFER * ON "RTRY"S CLASS AND STORES THE ABSOLUTE TIME AT WHICH THE RETRY * IS TO OCCUR IN THE EQT5 STATUS SAVE WORD IN THE CLASS HEADER. * WHEN "RTRY"S GET IS SATISFIED, IF THE ABSOLUTE TIME HASN'T BEEN * REACHED, "RTRY" COMPUTES THE NECESSARY TIME OFFSET AND PUTS * ITSELF IN THE TIME-LIST. WHEN IT IS RESCHEDULED, IT OUTPUTS * THE CLASS BUFFER, RETHREADING IT ON "GRPM"S CLASS. IF AN * ERROR OCCURS, RTRY WRITES AN ERROR NOTIFICATION TO QCLM * AND DEALLOCATES THE CLASS BUFFER. * SKP * RTRY EQU * JSB DTACH DEF *+1 GET EQU * JSB P#GETR DEF *+9 DEF #RTRY DEF QBUF DEF K4 DEF K0 DEF K0 DEF DUMMY DEF LLU RETURN LAST LU WORD DEF ABTIM RETURN DELAY TIME JSB ERR1 STA RQLEN * LDA ABTIM LOAD ABSOLUTE START TIME CMA,INA ADA $TIME SUBTRACT START TIME FROM CURR. TIME SSA,RSS TIME REACHED? JMP THRED YES, RETHREAD NOW STA OFSET SET OFFSET UNTIL IT CAN GO DLD $TIME GET CURRENT SYSTEM TIME SSA INB,SZB DAY ABOUT TO ROLL OVER? JMP SUSPD NO LDA ABTIM YES SSA DID PASSED TIME ROLL OVER? JMP SUSPD NO LDA OFSET COMPENSATE FOR INITIAL TIME IN ADA B2500 $TIME FOR NEW DAY (25000B) STA OFSET * SUSPD EQU * LDA OFSET BE SURE OFFSET ISN'T TOO BIG CMA,INA MAKE IT POSITIVE ADA #RDLY SUBTRACT LARGEST OFFSET. SSA TOO BIG? JMP SUSP. NO, USE WHAT WE HAVE. LDA #RDLY YES, IT'S TOO BIG! STA OFSET USE SMALLER VALUE. SUSP. EQU * JSB EXEC PUT SELF IN TIME LIST DEF *+6 DEF D12N DEF K0 DEF K1 DEF K0 DEF OFSET JSB ERR1 ERROR * THRED EQU * LDA STREM LOAD STREAM WORD LDB SRC# AND RPBIT CHECK STREAM WORD SZA,RSS REPLY? LDB DESTN .NO, LOAD DESTN NODE # INSTEAD STB VECTR SAVE NODE # FOR LU CONVERSION SSB,RSS NEGATIVE LU? JMP NRVS .NO, SEARCH NRV FOR LU CMB,INB .YES, MAKE IT POSITIVE LDA 1 PUT IT IN A REG. JMP FNDLU * * CONVERT DESTINATION NODE TO LU * NRVS EQU * JSB #NRVS SERACH NRV DEF *+2 DEF VECTR NODE ADDRESS JSB ERR1 ERROR RETURN, CANNOT FIND NODE FNDLU EQU * SZA,RSS LU = 0? JSB NPATH YES, NO PATH ERROR IOR =B[o100000 STA CONWD SAVE RETRUNED LU * JSB #RQUE OUTPUT BUFFER DEF *+9 DEF K20N DEF CONWD DEF K0 DEF K0 DEF K0 DEF K0 DEF #GRPM DEF #RTRY JSB ERR1 JMP GET * * IF NO PATH ERROR, SETUP TO REQUEUE BACK TO GRPM TO ISSUE ERROR * NPATH NOP LDA LLU GET LAST LU WORD IOR =B400 SET NOT FROM DRIVER BIT STA LLU ISZ RQLEN SET UP OFFSET OF LLU WORD IN SAM JSB #PUTR GO TO "STUFF" LLU BACK TO THE MESSAGE DEF *+3 DEF RQLEN DEF LLU JSB ERR1 CLA JMP NPATH,I RETURN * * IRRECOVERABLE REQUEST ERROR OCCURRED, CLEAR CLASS BUFFER & LEAVE ERR1 NOP DST AREG SAVE REGS FOR QCLM LDA ERR1 STA PREG SAVE ERROR ADDR DLD $TIME DST TOD LDA PNAME STA PGM DLD PNAME+1 DST PGM+1 LDA #RTRY ALR,RAR STA CLASS * * JSB EXEC DO DUMMY GET TO RETURN CLASS BUFFER DEF *+5 DEF K21 DEF CLASS DEF K0 DUMMY BUFFER DEF K0 ZERO LENGTH * LDA #QCLM STA CLASS JSB EXEC WRITE ERROR NOTICE TO QCLM DEF *+6 DEF K20N DEF K0 DEF QBUF DEF K12 DEF CLASS K0 NOP NOP * JMP GET BACK TO GET SPC 3 * * DATA AREA * DUMMY NOP VECTR NOP OFSET NOP CLASS NOP ABTIM NOP RQLEN NOP LLU NOP * * K1 DEC 1 K4 DEC 4 K12 DEC 12 K21 DEC 21 K20N OCT 100024 B2500 OCT 2500 D12N OCT 100014 RPBIT OCT 40000 CONWD NOP OCT 10100 PNAME ASC 3,RTRY * * QBUF BSS 12 BUFFER TO SEND TO 'QCLM' * STREM EQU QBUF SEQ# EQU QBUF+1 SRC# EQU QBUF+2 DESTN EQU QBUF+3 PREG EQU QBUF+4 AREG EQU QBUF+5 BREG EQU QBUF+6 TOD EQU QBUF+7 PGM EQU QBUF+9 * * SIZE BSS 0 * END RTRY Y lu 91750-18174 2013 S C0122 &SEGLD +              H0101 xASMB,R,L,C,Z * FOR 'N' ASSEMBLY OPTION (NO DS/1000) * NAME: SEGLD * SOURCE: 92064-18175 * RELOC: 92064-16058 * PGMR: G.L.M.,C.E.J. * * FOR 'Z' ASSEMBLY OPTION (DS/1000) * NAME: SEGLD * SOURCE: 92064-16058 * RELOC: 91750-16174 * PGMR: G.L.M.,C.E.J. * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 SEGLD,7 92064-16058 REV 1740 770912 XIF IFZ NAM SEGLD,7 91750-16174 REV.2013 800130 M XIF * * ENT SEGLD * EXT .ENTR,.MVW,$LIBR,$LIBX IFZ EXT DOPEN,DREAD,DCLOS,D$OVR XIF IFN EXT OPEN,READF,CLOSE DOPEN EQU OPEN DREAD EQU READF DCLOS EQU CLOSE XIF SUP * * SEGLD NOP STB XB SAVE B REGISTER IN CASE NO PARMS PASSED LDA WD5A RESET TRAILER RECORDS STA SPCAD POINTER. * LDA DZERO STA NAMR RESET PARMS STA IERR STA XT1 STA XT2 STA XT3 STA XT4 STA XT5 IFZ STA NODE XIF CLA STA SPCNT ZERO SPECIAL RECORD COUNT IFZ CMA STA DNODE RESET LOCAL DEFAULT FOR DS NODE XIF 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 IFZ NODE DEF ZERO XIF * 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 IFZ * * SET UP DESTINATION NODE PARAMETER FOR DS CALLS * LDA NODE DESTINATION NODE CPA DZERO GIVEN? JMP L.0 NO--DEFAULT IS LOCAL NODE LDA A,I YES--FETCH PARAMETER STA DNODE AND SAVE IT IN TWO WORD CRN XIF * * * IF NO TEMPS -- MOVE ID TMPS TO LOCAL BUFFER * ELSE MOVE TEMPS INTO LOCAL BUFFER * * * L.0 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 * IFZ CLA,INA TURN ON STA D$OVR SESSION OVERRIDE XIF JSB DOPEN DEF RTO DEF SGDCB DEF ERRS DEF NAMR,I DEF OPENO FORCE TO BINARY IFZ DEF ZERO DEF CRN 2ND WORD IS DESTINATION NODE XIF * RTO LDA ERRS FETCH ERROR RETURN SSA JMP SGERR OPEN ERROR * SPC 5 * * READ ABSOLUTE RECORD * RDF0 JSB DREAD READ DEF RTR DEF SGDCB THRU SEGLD'S D"cCB 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 DCLOS GO CLOSE IF OPEN DEF CEX DEF SGDCB DEF ERRS * CEX EQU * IFZ CLA TURN OFF STA D$OVR SESSION OVERRIDE XIF 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 ISZ SPCNT AND SPECIAL RECORD COUNT JMP RDF0 FETCH NEXT RECORD SPC 3 * * GOT AN EOF * EOF LDA N39 RELOCATABLE INPUT ERROR LDB SPCNT CPB .10 RSS JMP SGERR MUST HAVE SEEN 10 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 DCLOS DEF CRTN DEF SGDCB CLOSE SEG FILE BEFORE ENTERING THE UNKNOWN! DEF ERRS CRTN EQU * IFZ CLA TURN OFF STA D$OVR SESSION OVERRIDE XIF * * * * 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. * * * LDA XDEF ADDR]TESS 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 * * * ROUTINE TO MOVE WORDS IN PRIVELEDGED MODE * PMOVE NOP JSB $LIBR NOP JSB .MVW DEF PMOVE,I NOP ISZ PMOVE JSB $LIBX DEF PMOVE * * * SKP * .2 DEC 2 .4 DEC 4 .10 DEC 10 .22 DEC 22 .64 DEC 64 N5 DEC -5 N10 DEC -10 N39 DEC -39 IBUF BSS 64 * ZERO NOP IFZ DNODE DEC -1 CRN EQU ZERO XIF 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 SPCNT NOP * IFN SGDCB BSS 144 XIF IFZ SGDCB BSS 4 XIF * * XEQT EQU 1717B A EQU 0 B EQU 1 PLEN EQU * END r m w 91750-18175 2013 S C0122 &SGLDL              H0101 sASMB,R,L,C * NAME: SGLDL * SOURCE: 91750-16175 * RELOC: 91750-1X175 * PGMR: GERRY BELDEN * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 91750-1X175 REV 2013 791003 L * * ENT SEGLD,SEGRT * EXT .ENTR,.MVW,$LIBR,$LIBX,$XQT EXT DOPEN,DREAD,DCLOS,D$OVR SUP SKP * * SEGLD NOP STB XB SAVE B REGISTER IN CASE NO PARMS PASSED * 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 CALL PARMS DEF NAMR * LDA NAMR MUST HAVE CPA DZERO NAME PARM. JMP ERR14 ELSE--PARAM. ERROR * * IF PARAMETERS PASSED, RETRIEVE ACTUAL VALUES * LDA XT1 1ST PRAM ADDRESS CPA DZERO ANYTHING PASSED ? JMP NOPAR LDA DM5 YES, GET ALL FIVE STA TEMP LDA XDEF A(PRAM DEFS) SLOOP LDB A,I GET DEF LDB B,I GET VALUE STB A,I SAVE IT IN PLACE OF DEF INA ISZ TEMP DONE ? JMP SLOOP NOPE SKP * * DETERMINE # OF PROGRAM SEGMENTS, IF ANY, AND FIND * SHORT ID OF MATCHING SEGMENT NAME. * NOPAR LDB $XQT ID SEGMENT ADDRESS ADB D23 FIND # SEGMENTS LDA B,I AND B1760K SZA,RSS JMP ERR14 NONE, ERROR ALF RAL,RAL STA TEMP SAVE # SEGMENTS CMA NEGATE FOR LOOP COUNT STA NMSEG & SAVE LDB $XQT FIND LOW MAIN SO AS TO ADB D20 FIND 1ST SHORT ID LDB B,I STB TEMP1 SAVE FOR LATER * CHKLP STB IDADR JSB SUM VERIFY CHECKSUM, NO RETURN * ON ERROR LDA DM3 INITIALIZE NAME CHECK LOOP STA CKLOP LDA NAMR A(SEG. NAME) STA TSTNM LDB IDADR A(SHORT ID) * SEG0 LDA B,I 2 ASCII CHARS OF NAME ISZ CKLOP RSS JMP SEG1 LAST CHAR. CHECK CPA TSTNM,I MATCH ? RSS JMP CONT NO, CONTINUE INB A(NEXT 2 CHARS) ISZ TSTNM DITTO JMP SEG0 * SEG1 XOR TSTNM,I TEST FOR LAST CHAR. AND UBYTE MATCH SZA,RSS JMP MATCH * CONT LDB D8 CALCULATE ADDRESS NEXT ADB IDADR SHORT ID ISZ NMSEG JMP CHKLP * JMP ERR14 SHORT ID NOT FOUND SKP * * APPROPRIATE SHORT ID FOUND, TRY TO ACCESS FILE * MATCH LDA IDADR FIND THE ADDRESS OF THE BLOCK # ADA D6 FOR THIS FILE LDA A,I & SAVE FOR LODIT STA IREC * * FIND RESERVED BLOCK FOLLOWING SHORT IDS * LDA TEMP # SEGMENTS MPY D8 RESULT WILL FIT IN A REG. ADA TEMP1 LOW MAIN STA TEMP1 1ST WORD OF RESERVED BLOCK LDB A JSB SUM CHECK CHECKSUM LDA TEMP1 INA STA TEMP A(SECURITY CODE) INA STA TEMP2 A(CRN / NODE #) * LDA $XQT GET FILE NAME ADA D12 LDB AFNAM JSB .MVW MOVE IT TO LOCAL BUFFER DEF D3 NOP LDA FNAME+2 MERGE 5TH & 6TH CHARS. AND UBYTE ADA TEMP1,I PICK UP 6TH CHAR FROM RESERVED BLK STA FNAME+2 SAVE BOTH xBACK TO COMPLETE NAME * CLA,INA TURN ON REMOTE SESSION STA D$OVR OVERRIDE. JSB DOPEN OPEN REMOTE FILE CONTAINING THE DEF *+7 SEGMENT DEF DCB PSEUDO DCB DEF ERRS DEF FNAME DEF D4 FORCE TO TYPE 1 DEF TEMP,I SECURITY CODE DEF TEMP2,I CRN / NODE # * LDA ERRS ANY ERROR ? SSA JMP ERRXX RFA / DS ERROR SKP * * SETUP FOR, & READ IN SEGMENT MAIN * SET NEW 'CURRENT SEGMENT + 1' INTO ID SEGMENT * LDB $XQT FIND SEGMENT LOW MAIN ADB D21 (EQUALS HIGH MAIN + 1) LDA B SAVE ADDRESS LDB B,I GOT SEGMENT LOW MAIN INA ADDRESS OF CURRENT SEG + 1 ADDR. STA TEMP1 SAVE IT LDA IDADR FIND SEG HIGH MAIN + 1 ADA D4 LDA A,I GOT IT ! * JSB $LIBR GO PRIVILEGED TO WRITE NOP NEW CURRENT SEG + 1 IN ID STA TEMP1,I JSB $LIBX DEF *+1 DEF *+1 * JSB LODIT READ IN THE MAIN (IREC PRESET) * * DO BASE PAGE * CLA CONTINUE READING FROM FILE STA IREC WHERE WE LEFT OFF. LDA IDADR GET SEG HIGH BASE PAGE + 1 ADA D5 LDA A,I LDB $XQT GET LOW SEG BASE BAGE ADB D24 (EQUALS HIGH MAIN B.P.+1) LDB B,I GOT IT ! JSB LODIT LOAD B.P. SKP JSB DCLOS CLOSE THE REMOTE FILE DEF *+3 DEF DCB DEF ERRS CLA TURN OFF REMOTE SESSION STA D$OVR OVERRIDE. * * IF ANY PARAMETERS PASSED, PLACE THEM IN ID SEG. * LDA XT1 FETCH 1ST PRAM ADDRESS CPA DZERO ANYTHING PASSED ? JMP SEG2 NOPE, DONE LDB $XQT INB STB XB SAVE FOR SEGMENT LDA XDEF A(PRAM DEFS) JSB $LIBR GO PRIVILEGED NOP TO GET TO ID SEGMENT JSB .MVW TRANSF ER PRAMS DEF D5 NOP JSB $LIBX DEF *+1 DEF *+1 CONTINUE * * SUCCESSFUL SEGLD SO LETS TRANSFER TO IT * SEG2 LDB XB SET UP B REG.: IF NO PRAMS B IS * ORIG. VALUE, ELSE A(ID TEMPS) LDA IDADR SHORT ID ADDRESS ADA D3 LDA A,I SEGMENT ENTRY POINT ADDRESS JMP A,I SKP * * ERROR & SEGRT EXITS * ERR07 LDA D7 CHECKSUM ERROR = 7 RSS ERR14 LDA D14 SEGMENT ERROR = 14 ERRXX EQU * RFA OR DS ERROR STA IERR,I * JSB DCLOS CLOSE FILE IF OPENED DEF *+3 DEF DCB DEF ERRS * CLA STA D$OVR TURN OFF REMOTE SESS. OVERIDE RTRN JMP DEGLD,I RETURN TO CALLER * * RETURN TO MAIN FROM A SEGMENT * SEGRT NOP CLA NO ERROR STA IERR,I JMP RTRN GO TO EXIT SKP * * SUM - DOES A 7 WORD CHECKSUM & COMPARES RESULT WITH ONE'S * COMPLEMENT OF 8TH WORD (AS REQ'D BY DS). ENTERED WITH B * CONTAINING STARTING ADDRESS. CONTENTS OF BOTH REGISTERS * DESTROYED. IF CHECK FAILS CONTROL NOT RETURNED TO CALLER. * SUM NOP LDA DM7 # WORDS TO SUM STA SUMCT # WORDS TO SUM CLA INITIALIZE ACCUMULATOR SUMLP ADA B,I ADD NEXT WORD INB NEXT WORD TO SUM ISZ SUMCT DONE ? JMP SUMLP NO * CMA TAKE COMPLEMENT CPA B,I & COMPARE TO CHECKSUM WORD JMP SUM,I OK ! * JMP ERR07 NO GOOD, SHORT ID CLOBBERED ! SKP * * LODIT - LOAD MEMORY FROM A REMOTE FILE * * LODIT LOADS PROGRAM OR BASE PAGE FROM A REMOTE FILE AS * FOLLOWS: IT TAKES THE HIGH & LOW LOAD ADDRESSES FROM * THE A & B REGISTERS, THE STARTING LOAD FILE RECORD # * FROM IREC AND TRANSFERS THE DATA BLOCK BY BLOCK UNTIL * COMPLETE. THE FILE MUST BE AN ALREADY OPENED TYPE 6 * FILE (FORCED TO TYPE 1) ANOD NO CHECKING IS DONE AS TO * WHETHER THE HIGH & LOW LOAD ADDRESSES ARE CORRECT. * * CALLING SEQUENCE: * A = HIGH ADDRESS + 1 * B = LOW ADDRESS * IREC = LOAD FILE RECORD # * * JSB LODIT * ON RETURN: * CONTENTS OF BOTH REGS. DESTROYED * LODIT NOP STA HIHAD SAVE HIGH ADDRESS LDA D128 INITIALIZE TRANSFER SIZE STA SVAMT * * READ / LOAD LOOP * LODLP STB LOWAD SAVE LOW ADDRESS CMB,INB ADB HIHAD HIGH - LOW SZB,RSS ANYTHING LEFT ? JMP LODIT,I NOPE, DONE ! SSB JMP LODIT,I DONE ! LDA D128 LESS THAN 128 WORDS LEFT ? CMA,INA ADA B SSA STB SVAMT YES, ONLY TRANSFER REMAINDER * JSB DREAD READ IN A BLOCK DEF *+7 (OR PARTIAL BLOCK) DEF DCB DEF ERRS DEF IDBUF INPUT BUFFER DEF SVAMT # WORDS ( * WHERE IS THE LU WHERE THE INFORMATION IS TO BE PRINTED. * * THE SLC LONG TERM STATISTICS ARE PRINTED FIRST, FOLLOWED BY THE * EVENT TRACE TABLE. * * NOTE: MODIFIED 9-22-77 TO REMOVE CHARACTER TRACE PRINT SPC 1 SKP * PICK UP SCHEDULING PARAMETER SLCIN EQU * JSB RMPAR GET SCHEDULING PARAMETER. DEF *+2 DEF OUTLU LDA OUTLU * SZA,RSS IF OUTLU=0, CLA,INA OUTLU:=1. STA OUTLU * LDA #FWAM HAS DS/1000 SZA BEEN INITIALIZED? JMP CHEK2 YES--IS 3000 ENABLED? * JSB PRINVAT PRINT DEF INTLN ERROR DEC 12 MESSAGE. JMP FINIS TERMINATE. * CHEK2 LDA #LU3K IF 3000 HAS SZA NOT BEEN JMP CHEK3 ENABLED, * JSB PRINT PRINT DEF NOTEN ERROR DEC 10 MESSAGE. JMP FINIS TERMINATE. * CHEK3 LDA D$XS5 IF 3000 LINK AND D2 IS VIA MODEM, SZA,RSS JMP LTSTS * JSB PRINT PRINT DEF WRDVR ERROR DEC 9 MESSAGE. JMP FINIS TERMINATE. SPC 2 INTLN ASC 12, NEED TO INITIALIZE NODE! NOTEN ASC 10, HP 3000 NOT ENABLED WRDVR ASC 9, 3000 LINK NOT HSI SKP * PRINT LONG TERM STATISTICS * LTSTS JSB PRINT PRINT DEF SHEAD HEADING. DEC 13 LDA DN11 SET UP COUNTER STA CNT1 FOR 11 LINES. LDA FSTVL INITIALIZE JSB INDR STA FSTVL ADA DN1 STA VPNT VALUE POINTER. LDA MSGTB INITIALIZE STA MPNT MESSAGE POINTER. LDA D14 SET OUTPUT STA BUMP BUMP TO 14. * LOOPA LDA AW3 SET OUTPUT STA OPNTR POINTER. LDA BLANK CLEAR JSB FILL BUFFER. * LOOPB ISZ VPNT BUMP STAT POINTER. LDA MPNT,I GET # OF STA CNT2 CHARACTERS. ISZ MPNT LDA MPNT MESSAGE SOURCE ADDR. LDB OPNTR MESSAGE DESTINATION FIELD. ADB D3 MVW CNT2 MOVE MESSAGE. STA MPNT POINT TO NEXT MESSAGE. LDB VPNT,I CONVERT THE JSB TO10 VALUE. ISZ CNT1 LAST MESSAGE? RSS JMP LPRNT YES--GO DO LAST PRINT. LDA OPNTR IF PRINTLINE CPA AW17 NOT FULL, JMP LOOPB MOVE 2ND MESSAGE. * JSB PRINT PRINT DEF BUFR MESSAGES. DEC 30 JMP LOOPA NO--STAY IN LOOP. SPC 1 LPRNT JSB PRINT PRINT DEF BUFRي FINAL D14 DEC 14 STATISTIC. SKP * DUMP EVENT TRACE TABLE * * CALCULATE START/END OF EVENT TABLE LDA TRFWA CALCULATE JSB INDR OFFSET STA TRFWA FOR CMA,INA TRACE ADA @PNTR TABLES. ADA D2 STA OFSET * ADA D$EQT INA STA EOTBL 1 WORD PAST EVENT TRACE TABLE. * JSB PRINT PRINT DEF BLANK BLANK D1 DEC 1 LINE. JSB PRINT PRINT HEADINGS. DEF EHEAD DEC 12 JSB PRINT DEF EHED2 DEC 28 JSB PRINT DEF BLANK DEC 1 LDB D4 SET PRINT STB BUMP BUMP TO 4. * * MOVE TRACE TABLES AND POINTERS LDA TRFWA SOURCE. ADA DN2 LDB @PNTR DESTINATION. JSB $LIBR TURN OFF NOP INTERRUPTS. MVW D202 MOVE 202 WORDS. JSB $LIBX TURN DEF *+1 INTERRUPTS DEF *+1 BACK ON. * LDB PNTRS+1 B:=FIRST ENTRY ADDRESS. * LOOP LDA BLANK CLEAR JSB FILL PRINTLINE. ADB OFSET ADD OFFSET FOR LOCAL TABLES. STB LINK STORE LINK ADDRESS. STB ENTRY SAVE ENTRY ADDRESS. JSB NXTEV PICK UP WORD 2. LDB AW3 SET UP STB OPNTR OUTPUT POINTER. CLB CLEAR B-REG. LSL 8 B:=COMPLETION STATUS. STB STATS STORE. CLB LSL 2 B:=REQUEST CODE. STB REQCD STORE. CLB LSL 6 B:=FUNCTION CODE. STB FUNCD STORE. * DECODE FUNCTION LDA REQCD LOAD REQUEST CODE. CPA D1 IF = 1, JMP READ DECODE FOR READ. CPA D2 IF = 2, JMP WRITE DECODE FOR WRITE. CPA D3 IF = 3, JMP CNTRL DECODE FOR CONTROL. * BAD FUNCTION BAD LDB REQCD CONVERT REQUEST JSB TO8 CODE AND LDB REQCD FUNCTION TO JSB TO8 OCTAL. JMP WRD3 GO GET WORD 3. * READ LDA FUNCD ** PROCESS READ FUNCTION ** CPA D2 CHECK FOR RSS BAD FUNCTION. JMP BAD LDA READI A-REG POINTS TO "READ INITIAL". LDB AW8 B-REG POINTS TO DESTINATION. MVW D6 MOVE MESSAGE. JMP WRD3 GO GET WORD 3. * WRITE LDA FUNCD ** PROCESS WRITE FUNCTION ** SZA,RSS CHECK JMP BAD FOR CPA D7 BAD JMP BAD FUNCTION. LDB AW8 MOVE LDA @WRIT "WRITE". MVW D3 LDA FUNCD DON'T USE AND D7 FUNCTION BITS 9-11. ADA @WTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW11 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. JMP WRD3 GO GET WORD 3. * CNTRL LDA FUNCD ** PROCESS CONTROL FUNCTION ** CPA D5 CHECK FOR JMP BAD BAD FUNCTION AND D7 AND LDB D11 MAP CPA FUNCD 40-45 LDB D6 TO ADA DN6 5-12. SSA,RSS JMP BAD ADA B ADA @CTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW8 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * WRD3 JSB NXTEV PICK UP WORD 3. LDB LINK,I ALREADY ADB OFSET UP TO CPB ENTRY NEXT ENTRY? JMP SPCAS YES--SPECIAL CASE! * LOOP2 CLB LSL 8 B:=EVENT #. STB EVENT STORE. CLB LSL 8 B:=STATE #. STB STATE STORE. * LDA EVENT DECODE EVENT. ADA DN33 CHECK SSA,RSS FOR JMP BADE BAD  LDA EVENT EVENT. ADA @ETBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW17 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * DESTA LDA STATE DECODE STATE. ADA DN25 CHECK SSA,RSS FOR JMP BADS BAD LDA STATE STATE. ADA @STBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW26 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * PRNT1 JSB PRINT PRINT EVENT ENTRY. DEF BUFR D33 DEC 33 LDA BLANK JSB FILL FILL OUTPUT BUFFER WITH BLANKS. JSB NXTEV GET NEXT WORD. LDB LINK,I PROCESSED ADB OFSET THE LAST CPB ENTRY EVENT/STATE WORD? JMP PRSTA YES--PRINT STATUS INFO. LDB AW18 NO-- STB OPNTR SET OUTPUT POINTER JMP LOOP2 AND PRINT THEM. * * SPECIAL CASE--NO EVENT/STATE WORDS SPCAS JSB PRINT PRINT DEF BUFR FIRST WORD DEC 15 INFO ONLY. * PRSTA LDA STATS GET STATUS. CLB CONVERT RRR 3 TO ALF,RAL ASCII RRL 3 (OCTAL). IOR "00" STA STASC LDA D18 STATUS MESSAGE STA STMLN LENGTH = 12. LDA STATS IF STATUS IS ADA BN22 LESS THAN 22 (OCTAL) SSA,RSS JMP PSTAT LDA STATS MOVE STATUS MESSAGE. ADA @STAT LDA A,I LDB A,I STB TEMP ADB STMLN SET STATUS MESSAGE LEN. STB STMLN INA LDB @STMS MVW TEMP PSTAT JSB PRINT PRINT STATUS MESSAGE. DEF STMSG STMLN NOP JSB PRINT DEF BLANK DEC 1 * LDB LINK,I CPB PNTRS nLAST ENTRY? JMP FINIS YES! SSB NEGATIVE? JMP FINIS BAD LINK! CMB,INB LESS THAN FIRST WORD? ADB TRFWA CMB,SSB,INB,SZB JMP FINIS BAD LINK! LDB D$EQT GREATER THAN LAST? CMB,INB ADB LINK,I CMB,SSB,INB,SZB JMP FINIS BAD LINK! LDB LINK,I JMP LOOP NO--LOOP AGAIN. SPC 3 * VARIABLES USED IN EVENT TRACE * EVENT NOP STATE NOP REQCD NOP FUNCD NOP STATS NOP SPC 2 BADE LDA AW17 BAD EVENT-- STA OPNTR CONVERT LDB EVENT TO JSB TO10 DECIMAL. JMP DESTA SPC 2 BADS LDA AW26 BAD STATE-- STA OPNTR CONVERT LDB STATE TO JSB TO10 DECIMAL. JMP PRNT1 SKP FINIS JSB EXEC TERMINATE DEF *+2 DEF D6 SPC 6 * SUBROUTINES SPC 3 * CONVERT B-REG CONTENTS TO ASCII (OCTAL) TO8 NOP STB TEMP STORE NUMBER. STA AREG SAVE A-REG. JSB CNUMO GO CONVERT. DEF *+3 DEF TEMP DEF OPNTR,I LDA AREG RESTORE A-REG. LDB OPNTR BUMP ADB BUMP OUTPUT STB OPNTR POINTER. CLB CLEAR B-REG. JMP TO8,I RETURN. SPC 5 * CONVERT B-REG CONTENTS TO ASCII (DECIMAL) * TO10 NOP STB TEMP STORE NUMBER. STA AREG SAVE A-REG. JSB CNUMD GO CONVERT. DEF *+3 DEF TEMP DEF OPNTR,I LDA AREG RESTORE A-REG. LDB OPNTR BUMP ADB BUMP OUTPUT STB OPNTR POINTER. CLB CLEAR B-REG. JMP TO10,I RETURN. SPC 3 * PRINT A MESSAGE * MSG NOP MESSAGE ADDRESS LEN NOP LENGTH * PRINT NOP LDA PRINT,I PICK STA MSG UP ISZ PRINT PARAMETERS. LDA PRINT,I STA LEN ISZ PR0INT * JSB EXEC CALL EXEC FOR WRITE. DEF *+5 DEF D2 DEF OUTLU DEF MSG,I DEF LEN * JMP PRINT,I RETURN. SPC 3 * GET NEXT ENTRY IN EVENT TABLE * NXTEV NOP LDA ENTRY GET CURRENT ENTRY ADDRESS. INA ADD ONE. CPA EOTBL IF OUT OF TABLE, LDA SOTBL RESET TO BEGINNING. STA ENTRY STORE. LDA A,I A:=CONTENTS OF ENTRY. JMP NXTEV,I RETURN. * SOTBL DEF TABLE START OF EVENT TRACE TBL EOTBL NOP END OF EVENT TRACE TBL SPC 3 * FILL OUTPUT BUFFER WITH CHAR IN A-REG * FILL NOP LDX D33 INITIALIZE COUNTER. FLOOP SAX BUFR-1 STORE A-REG. DSX DECREMENT X-REG AND JMP FLOOP STAY IN LOOP UNTIL 0. * JMP FILL,I RETURN. SPC 3 * CHASE DOWN INDIRECTS * INDR NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP INDR,I SPC 6 * CONSTANTS AND STORAGE SPC 1 FSTVL DEF D$XS5+1 BLANK ASC 1, VPNT NOP MPNT NOP BUMP NOP LINK NOP ENTRY NOP CNT1 NOP CNT2 NOP TEMP NOP AW3 DEF BUFR+2 AW8 DEF BUFR+7 AW11 DEF BUFR+10 AW17 DEF BUFR+16 AW18 DEF BUFR+17 AW26 DEF BUFR+25 OPNTR NOP BUFR ASC 20, ASC 13, * HEADINGS: SHEAD ASC 13, SLC LONG TERM STATISTICS: EHEAD ASC 12, SLC EVENT TRACE TABLE: EHED2 ASC 25, FUNCTION EVENT ASC 3,STATE OUTLU NOP RUN-TIME BSS 4 PARAMETERS AREG NOP DN33 DEC -33 DN25 DEC -25 DN11 DEC -11 DN6 DEC -6 DN2 DEC -2 DN1 DEC -1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 D18 DEC 18 D202 DEC 202 BN22 OCT -22 "00" ASC 1,00 SPC 3 * LONG TERM STATS HEADINGS * MSGTB DEF *+1 MESSAGE TABLE D7 DEC 7 ASC 7, READ REQUESTS DEC 8 ASC 8, WRITE REQUESTS D11 DEC 11 ASC 11, MESSAGES TRANSMITTED DEC 10 ASC 10, SPURIOUS INTERRUPTS D6 DEC 6 ASC 6, LINE ERRORS DEC 7 ASC 7, NAKS RECEIVED DEC 9 ASC 9, BCC/PARITY ERRORS DEC 7 ASC 7, LONG TIMEOUTS DEC 8 ASC 8, RESPONSE ERRORS DEC 7 ASC 7, RESPONSE REJ DEC 9 ASC 9, WACK/TTD RECEIVED SPC 3 * POINTERS INTO TABLES * @WRIT DEF STA12+1 @WTBL DEF WTBL-1 @CTBL DEF CTBL @ETBL DEF ETBL @STBL DEF STBL @STAT DEF STATT SPC 3 * LOCAL STORAGE FOR TRACE TABLES AND POINTERS * @PNTR DEF PNTRS TRFWA DEF D$XS5+14 FIRST WORD OF EVENT TRACE. OFSET NOP PNTRS BSS 2 TABLE BSS 200 SPC 3 * READ FUNCTION TABLE * READI DEF *+1 ASC 6,READ INITIAL SPC 2 * WRITE FUNCTION TABLE * WTBL DEF WMSG1 DEF WMSG2 DEF WMSG3 DEF WMSG4 DEF WMSG5 DEF WMSG6 WMSG1 DEC 4 ASC 4,INQUIRY WMSG2 DEC 4 ASC 4,CONTINUE WMSG3 DEC 5 ASC 5,CONVERSTNL WMSG4 DEC 3 ASC 3,RESET WMSG5 DEC 5 ASC 5,DISCONNECT WMSG6 DEC 3 ASC 3,DELAY SPC 2 * CONTROL FUNCTION TABLE * CTBL DEF CMSG0 DEF CMSG1 DEF CMSG2 DEF CMSG3 DEF CMS40 DEF CMS41 DEF CMS42 DEF CMS43 DEF CMS44 DEF CMS45 CMSG0 DEC 3 ASC 3,CLEAR CMSG1 DEC 5 ASC 5,INITIALIZE CMSG2 DEC 5 ASC 5,LINE OPEN CMSG3 DEC 5 ASC 5,LINE CLOSE CMS40 DEC 8 ASC 8,ESTABLISH LOC ID CMS41 DEC 8 ASC 8,ESTBL REM ID LST CMS42 DEC 8 ASC 8,CHNG ERROR PRAMS CMS43 DEC 8 ASC 8,ZERO COMM STATS CMS44 DEC 7 ASC 7,SHIFT TO RECEV CMS45 DEC 8 ASC 8,DISABLE NAK SEND SPC 2 * EVENT TABLE * ETBL DEF EVT00 DEF EVT01 DEF EVT02 DEF EVT03 DEF EVT04 DEF EVT05 DEF EVT06 DEF EVT07 DEF EVT08 DEF EVT09 DEF EVT10 DEF EVT11 DEF EVT12 DEF EVT13 DEF EVT14 DEF \EVT15 DEF EVT16 DEF EVT17 DEF EVT18 DEF EVT19 DEF EVT20 DEF EVT21 DEF EVT22 DEF EVT23 DEF EVT24 DEF EVT25 DEF EVT26 DEF EVT27 DEF EVT28 DEF EVT29 DEF EVT30 DEF EVT31 DEF EVT32 EVT00 DEC 7 ASC 7,LINE OPEN REQ EVT01 DEC 7 ASC 7,LINE CLOSE REQ EVT02 DEC 8 ASC 8,READ INQUIRY REQ EVT03 DEC 8 ASC 8,READ INITIAL REQ EVT04 DEC 8 ASC 8,READ CONTINUE RQ EVT05 DEC 8 ASC 8,READ REPEAT REQ EVT06 DEC 8 ASC 8,READ/REV INT REQ EVT07 DEC 5 ASC 5,DELAY READ EVT08 DEC 8 ASC 8,WRITE INQURY REQ EVT09 DEC 8 ASC 8,WRITE CNTNUE REQ EVT10 DEC 7 ASC 7,WRITE CONV REQ EVT11 DEC 8 ASC 8,WRT RESET(EOT)RQ EVT12 DEC 8 ASC 8,WRITE DISCON REQ EVT13 DEC 8 ASC 8,DELAY WRITE REQ EVT14 DEC 7 ASC 7,ACK0 RECEIVED EVT15 DEC 7 ASC 7,ACK1 RECEIVED EVT16 DEC 7 ASC 7,WACK RECEIVED EVT17 DEC 7 ASC 7,RVI RECV/SENT EVT18 DEC 6 ASC 6,ENQ RECEIVED EVT19 DEC 6 ASC 6,NAK RECEIVED EVT20 DEC 6 ASC 6,EOT RECEIVED EVT21 DEC 8 ASC 8,DLE EOT RECEIVED EVT22 DEC 6 ASC 6,TTD RECEIVED EVT23 DEC 7 ASC 7,TEXT RECEIVED EVT24 DEC 8 ASC 8,BCC PRTY/FMT ERR EVT25 DEC 6 ASC 6,TEXT OVERRUN EVT26 DEC 8 ASC 8,GARBAGE RECEIVED EVT27 DEC 8 ASC 8,BAD ID SEQUENCE EVT28 DEC 7 ASC 7,SHORT TIMEOUT EVT29 DEC 6 ASC 6,LONG TIMEOUT EVT30 DEC 2 ASC 2,LOW EVT31 DEC 2 ASC 2,HIGH EVT32 DEC 2 ASC 2,MID SPC 2 * STATE TABLE * STBL DEF STA00 DEF STA01 DEF STA02 DEF STA03 DEF STA04 DEF STA05 DEF STA06 DEF STA07 DEF STA08 DEF STA09 DEF STA10 DEF STA11 DEF STA12 DEF STA13 DEF STA14 DEF STA15 DEF STA16 DEF STA17 / DEF STA18 DEF STA19 DEF STA20 DEF STA21 DEF STA22 DEF STA23 DEF STA24 STA00 DEC 4 ASC 4,UNOPENED STA01 DEC 4 ASC 4,CONTROL STA02 DEC 4 ASC 4,READ ENQ STA03 DEC 7 ASC 7,READ ENQ ERROR STA04 DEC 7 ASC 7,CHECK READ REQ STA05 DEC 2 ASC 2,READ STA06 DEC 5 ASC 5,READ TEXT STA07 DEC 4 ASC 4,READ RVI STA08 DEC 8 ASC 8,RESTRICTED READ STA09 DEC 5 ASC 5,WRITE ENQ STA10 DEC 8 ASC 8,WRITE ENQ ERROR STA11 DEC 8 ASC 8,ENQ-ENQ CONTENTN STA12 DEC 3 ASC 3,WRITE STA13 DEC 5 ASC 5,WRITE TEXT STA14 DEC 8 ASC 8,WRITE RESPNS ENQ STA15 DEC 7 ASC 7,CHECK RESPONSE STA16 DEC 8 ASC 8,BAD ACK RECEIVED STA17 DEC 6 ASC 6,WRITE RETRY STA18 DEC 8 ASC 8,ENQ RCV IN WRITE STA19 DEC 8 ASC 8,ENQ RCRD IN WRIT STA20 DEC 8 ASC 8,WRITE CONVERSTNL STA21 DEC 5 ASC 5,WRITE EOT STA22 DEC 8 ASC 8,READ EOT RSPONSE STA23 EQU WMSG5 STA24 DEC 5 ASC 5,WRITE TTD SPC 3 STATT DEF ST00 DEF ST01 DEF ST02 DEF ST03 DEF ST04 DEF ST05 DEF ST06 DEF ST07 DEF ST10 DEF ST11 DEF ST12 DEF ST13 DEF ST14 DEF ST15 DEF ST16 DEF ST17 DEF ST20 DEF ST21 ST00 DEC 9 ASC 9,NORMAL COMPLETION ST01 DEC 8 ASC 8,INVALID REQUEST ST02 DEC 16 ASC 16,REQST INCOMPATIBLE W/ LINE STATE ST03 DEC 1 ASC 1, [BAD ID SEQUENCE] ST04 DEC 11 ASC 11,LOCAL HARDWARE FAILURE ST05 DEC 6 ASC 6,EOT RECEIVED ST06 DEC 15 ASC 15,DISCONNECT (DLE EOT) RECEIVED ST07 DEC 6 ASC 6,LONG TIMEOUT ST10 DEC 11 ASC 11,EOT SENT, ENQ RECEIVED ST11 DEC 6 ASC 6,DATA OVERRUN ST12 DEC 9 ASC 9,MAX NAKS RECEIVED ST13 DEC 7 ASC 7,MAX ENQS SENT ST14 DEC 6 ASC 6,RVI RECEIVED ST15 DEC 11 ASC 11B@<,ENQ SENT, ENQ RECEIVED ST16 DEC 11 ASC 11,ENQ SENT, NAK RECEIVED ST17 DEC 9 ASC 9,MAX ENQS RECEIVED ST20 DEC 1 ASC 1, [TTD SENT, NAK RECEIVED] ST21 DEC 10 ASC 10,IMPOSSIBLE SITUATION * STMSG ASC 16, COMPLETION STATUS STASC ASC 18,XX: @STMS DEF STASC+2 SPC 1 BSS 0 SIZE OF SLCIN. SPC 1 END SLCIN B o 91750-18177 2013 S C0122 &TLOG +              H0101 }uASMB,Q,C * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 TLOG--INTERACTIVE DS/1000 LOG EDITOR/TRANSLATOR NAM TLOG,19,90 91750-16177 REV 2013 800505 * * NAME: TLOG * * RELOC: 91750-16177 * * SOURCE: 91750-16177 * * PRGR: C. JONAS * * MOD BY: DOUG W. TSUI (SEPT. 1978) * SUP * * THIS PROGRAM ACCEPTS THE BINARY LOG OUTPUT FROM PLOG AND PERFORMS USER * SPECIFIED SEARCHES AND TRANSLATIONS ON THE DATA. * SCHEDULING SEQUENCE: * *RU,TLOG[,INPUT NAMR[,LOG NAMR[,LIST LU]]] * WHERE: * INPUT NAMR = (INTERACTIVE) LU FOR COMMAND INPUT, OR * = NAMR OF A FILE CONTAINING COMMANDS FOR INPUT. * DEFAULT IS THE SCHEDULING TERMINAL. * LOG NAMR = LU OF A DEVICE CONTAINING LOG INFORMATION, OR * = NAMR OF A FILE CONATINING LOG INFORMATION. * DEFAULT IS DISC FILE 'PLOG:DS. * LIST LU = LU OF THE LIST DEVICE. * DEFAULT IS INPUT LU IF INTERACTIVE, ELSE 6. * * TLOG INITIALIZES ITSELF USING THE VALUES IN RES, OR THE TWO WORDS * ON TAPE, OR FIRST RECORD IN LOG FILE. PLOG'S #TYPE WORD IS KEPT * IN TTYPE, WHERE BITS, IF SET, MEAN: * * ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! * !--15--14--13--12--11--10---9---8---7---6---5---4---3---2---1---0 * ^ ^ ^ ^ !<----------LOG LU #----------->! * ! ! ! ! * DISC ! FULL DATA * LOG ! BUFFER LOGGED * WINDOW * SET * * SPC 3 EXT #PLOG,CLOSE,CNUMD,CNUMO,CREAT EXT ~IFTTY,EXEC,IFBRK EXT KCVT,OPEN,PURGE,READF EXT RNRQ,TMVAL,WRITF EXT #PKUP EXT .MBT,.LDY,.JPY,.CBT,.LBY EXT .DSY,.MVW,.LAY,.LBT,.CMW,.SBT #CLAS DEF #PLOG #PRN DEF #PLOG+1 #TYPE DEF #PLOG+2 #RECS DEF #PLOG+3 #SIZE DEF #PLOG+4 #CRNT DEF #PLOG+5 A EQU 0 B EQU 1 SKP * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * SKP TLOG NOP * * PICK UP SCHEDULING PARAMETERS * JSB #PKUP DEF *+4 DEF PMASK DEF INNAM DEF DEFLU * * SETUP INPUT NAMR PARAMETER * LDA INLU GET INLU SSA JMP LUERR SZA DEFAULT LU? JMP SETLO .NO LDA DEFLU .YES, SET DEFAULT STA INLU LDA D1 ALSO SET PARAMETER AS NUMERIC STA INTYP * * SETUP LOG NAMR PARAMETER * SETLO LDA LOTYP GET LOG TYPE SZA,RSS JMP DF/LO NO PARAMETER, USE DEFAULT CPA D1 LU AS PARAMETER? RSS JMP CHKIN NO, FILE TYPE LDA LOGLU YES, LOAD LU SSA JMP LUERR SZA,RSS LU = 0? JMP DF/LO .YES, USE DEFAULT IOR B100 SET BINARY BIT STA LOGBI JMP CHKIN DF/LO LDA PLNAM STA LONAM DLD PLNAM+1 DST LONAM+1 LDA PLSEC STA LOSEC LDA PLCRN STA LOCRN LDA D3 SET PARAMETER AS ALPHA STA LOTYP * * CHECK INPUT NAMR PARAMETER * CHKIN CLA STA PRMT? CLEAR PROMPT FLAG LDA INLU SET ECHO BIT IOR B400 IN LU WORD STA INLU2 LDA INTYP WAS LU # OR FILE NAME GIVEN? CPA D1 JMP INTER LU # --SEE IF DEVICE INTERACTIVE JSB OPEN FILE NAME--OPEN FILE DEF *+1+6 RETURN ADDRESS DEF INDCB DCB ADDRESS DEF STAT STATUS/ERROR WORD DEF INNAM ADDRESS OF FILE NAME ARRAY DEF D0 STANDARD OPEN DEF:G INSEC SECURITY CODE DEF INCRN SSA,RSS WAS AN ERROR CODE RETURNED? JMP CHKLI NO--CONTINUE LDB .INAM YES--INFORM USER AND TERMINATE JMP FIERR * * SEE IF DEVICE IS INTERACTIVE OR NOT, SET PROMPT FLAG ACCORDINGLY * INTER EQU * JSB IFTTY DEF *+2 DEF INLU SSA ISZ PRMT? SET PROMPT FLAG ON * * CHECK LIST PARAMETER * CHKLI LDA LSTLU SSA JMP LUERR SZA JMP CHKLO IF LIST LU GIVEN, SKIP CHECK LDA D6 DEFAULT CHECK LDB PRMT? SZB LDA INLU IF INTERACTIVE, USE INLU STA LSTLU * * CHECK LOG NAMR PARAMETER * CHKLO LDA LOTYP WAS LU # OR CPA D1 FILE NAME GIVEN? RSS JMP FILLO FILE LOG * * DEVICE LOG * LDA #PLOG SZA,RSS JMP DEVOK LDA #TYPE,I AND LOBYT CPA LOGLU MAKE SURE PLOG IS NOT ON THE SAME LU JMP PLERR IT IS--ERROR DEVOK JSB EXEC O/W, READ 1ST TWO WORDS (= #TYPE & #RECS) DEF *+1+4 RETURN ADDRESS DEF NA1 READ, NO ABORT DEF LOGBI MT LU # DEF TTYPE BUFFER ADDRESS DEF D2 BUFFER LENGTH = 2 WORDS JMP EXERR ERROR RETURN LDA TTYPE GET TYPE WORD, AND HIBYT REMOVE OLD MT LU # IOR LOGLU ADD NEW MT LU # STA TTYPE LDA TTYPE+1 AND SAVE RECORD SIZE STA RECSZ JMP COMMD GO START COMMAND PROCESSING * * FILE LOG * FILLO DLD .LDCB SET UP CURRENT DCB & NAME DST .DCB ARRAY TO POINT TO LOG FILE JSB TOPEN THEN OPEN FILE SSA,RSS ANY ERRORS? JMP *+3 NO--BRANCH AROUND LDB .NAM YES--INFORM USER AND TERMINATE JMP FIERR * CLA,INA SET CURRENT RECORD # STA CURNT TO 1 & GET DCB ADDRESS AGAIN LDA .DCB JSB TREAD READ FIRST RECORD IN FILE SSA,RSS ANY ERRORS? JMP *+3 NO--BRANCH AROUND LDB .NAM YES--INFORM USER AND TERMINATE JMP FIERR * LDA BUFFR GET FIRST WORD SZA,RSS IS IT EQUAL TO ZERO? JMP RES YES--GET VALUES FROM RES * AND HIBYT NO--THIS IS #TYPE WORD LDB LOGLU REPLACE OLD LU WITH NEW LU CMB,INB IOR B STA TTYPE AND SET INTO TTYPE LDA BUFFR+1 2ND WORD = CURRENT RECORD # STA CURNT LDA BUFFR+2 3RD WORD = FILE SIZE STA SIZE LDA BUFFR+3 4TH WORD = RECORD SIZE STA RECSZ LDA SIZE DETERMINE LAST RECORD NUMBER+1 CLB IN FILE DIV RECSZ INA STA RECNM JMP SETPT * * HERE FOR VALUES FROM RES (PLOG IS ALSO LOGGING TO THE FILE) * RES EQU * LDA #PLOG IS PLOG THERE? SZA,RSS (CLASS WORD = 0?) JMP LOERR .NO, BAD LOG FILE LDA #SIZE,I ALL VALUES IN RES STA SIZE SAVE LOCALLY LDA #RECS,I STA RECSZ * * TAKE SNAP SHOT OF THE LOG FILE * JSB CREAT CREATE FILE 'TLOG DEF *+1+7 IDENTICALLY TO LOG FILE DEF TLDCB DEF IERR DEF TLNAM DEF SIZE DEF D2 DEF LOSEC DEF LOCRN SSA,RSS ANY ERRORS? JMP RES1 NO--JUST CONTINUE CPA M2 YES--DUPLICATE FILE? JMP TLERR YES--EXPLAIN TO USER LDB .TNAM NO--GIVE USER ERROR CODE JMP FIERR * RES1 CLA,INA SET UP RECORD #'S FOR COPYING STA RECNM LOG FILE TO 'TLOG RNLCK JSB RNRQ LOCK PLOG'S RN, SUSPENDING DEF *+1+3 PLOG FOR DURATION OF COPY DEF RN1 DEF #PLOG+1 DEF STAT JMP EXERR LDA STAT LOCK SUCCESSFUL? CPA D2 RSS JMP RNLCK NO--TRY AGAIN * COPY JSB READF THESE READS & WRITES ENCODED DEF *+1+6 SEPARATELY FOR S PEED IN COPYING DEF LODCB THE RECORDS DEF IERR DEF BUFFR DEF RECSZ DEF TEMP DEF RECNM CPA M12 END-OF-FILE ENCOUNTERED? JMP RES2 YES--COPY IS DONE SSA NO--ANY OTHER ERRORS JMP RNULK YES--CAUSE TLOG TO TERMINATE * JSB WRITF NO--CONTINUE WITH WRITE DEF *+1+5 DEF TLDCB DEF IERR DEF BUFFR DEF RECSZ DEF RECNM SSA ANY ERROS ON WRITE CAUSE JMP RNULK TLOG TO TERMINATE ISZ RECNM BUMP RECORD # JMP COPY AND CONTINUE * RES2 LDA #CRNT,I COPY SUCCESSFUL STA CURNT GET CURRENT RECORD # LDA #TYPE,I AND CURRENT TYPE WORD STA TTYPE RNULK JSB RNRQ THEN UNLOCK PLOG'S RN DEF *+1+3 DEF RN4 DEF #PLOG+1 DEF STAT JMP EXERR LDA STAT CPA D1 UNLOCK SUCCESSFUL? RSS JMP RNULK NO--TRY AGAIN * LDA IERR WAS COPY SUCCESSFUL CPA M12 JMP RES3 YES--BRANCH AROUND PURGE DLD .TDCB NO--GET DCB AND FILE NAME ARRAY ADDRESSES JSB TPURG AND PURGE 'TLOG JMP COERR THEN INFORM USER OF ERROR RES3 LDA .LDCB EVERYTHING OKAY, CLOSE LOG FILE JSB TCLOS SSA,RSS ANY ERRORS? JMP RES4 NO--BRANCH AROUND LDB .LNAM YES--INFORM USER AND TERMINATE JMP FIERR * RES4 DLD .TDCB SET UP CURRENT DCB & NAME DST .DCB ARRAY TO POINT TO 'TLOG FILE * * SET UP POINTERS TO THE LOG FILE * SETPT LDA TTYPE WINDOW START & ENDING ALF,RAL RECORD NUMBERS LDB CURNT IF FULL BUFFER & CURRENT SSA,RSS RECORD NE LAST+1, THEN LDB D2 FIRST RECORD & WINDOW CPB RECNM STARTING RECORD IS CURRENT LDB D2 RECORD #, ELSE STB START RECORD # 2 STB WSTRT IF BUFFER FULL AND LDB CURNT CURRENT RECORD IS 2, THEN CPB D2 LAST RECORD+1 IS RECNM, SSA,RSS ELSE LAST RECORD+1 RSS IS CURNT LDB RECNM ADB M1 CPB D1 IF LAST RECORD+1 IS THEN = 1 JMP NOLOG WE HAVE AN EMPTY LOG FILE STB LAST STB WLAST LDB START SET CURRENT RECORD TO STB CURNT STARTING RECORD JMP COMMD * NOLOG CMB,INB SET ALL STARTING RECORDS TO MINUS ONE STB WSTRT STB START STB CURNT JMP COMMD START COMMAND PROCESSING * LDA NORFG DEFAULT IS NORMAL STA PRFLG LISTING SPC 5 * * DATA AREA FOR INITIALIZATION PHASE * * * THIS AREA IS USED BY #PKUP AND SHOULD ALWAYS BE IN THIS ORDER PMASK BYT 3,3 3 PARAMETERS, FIRST 2 IS IN NAMR FORM INNAM BSS 10 INPUT FILE NAME INLU EQU INNAM INPUT LU INTYP EQU INNAM+3 INPUT PARAMETER TYPE INSEC EQU INNAM+4 INPUT SEC INCRN EQU INNAM+5 INPUT CRN LONAM BSS 10 LOG FILE NAME LOGLU EQU LONAM LOTYP EQU LONAM+3 LOSEC EQU LONAM+4 LOCRN EQU LONAM+5 LSTLU NOP LIST LU DEFLU NOP DEFAULT INPUT LU * INDCB BSS 144 INPUT DCB .IDCB DEF INDCB INPUT DCB ADDRESS .INAM DEF INNAM INPUT NAME ARRAY ADDRESS--MUST FOLLOW .IDCB * LOGBI NOP LOG LU FOR BINARY READ LODCB BSS 144 .LDCB DEF LODCB MUST BE .LNAM DEF LONAM TOGETHER * TLNAM ASC 3,'TLOG FILE FOR SNAP SHOT TLDCB BSS 144 .TDCB DEF TLDCB MUST BE .TNAM DEF TLNAM TOGETHER * PLNAM ASC 3,'PLOG DEFAULT LOG FILE PLSEC ASC 1,DS DEFAULT LOG SECURITY PLCRN DEC 0 DEFAULT LOG CRN * .DCB NOP CURRENT LOG DCB .NAM NOP & NAME ADDRESS IERR NOP * TEMP NOP TEMP1 NOP D20 DEC 20 SKP * * COMMAND STRING PARSER * COMMD LDA .CML2 PRINT A BLANK LINE LDB D1 JSB LIST JMP EXERR LDA INTYP  LU # OR FILE NAME FOR COMMAND INPUT? CPA D1 JMP CMDLU LU--GET COMMAND FROM IT * * HERE TO GET A COMMAND FROM A FILE * JSB READF PERFORM READ DEF *+1+5 RETURN POINT DEF INDCB DCB ADDRESS DEF STAT STATUS/ERROR WORD DEF CMLIN COMMAND LINE BUFFER DEF D36 LONGEST LEGAL COMMAND LINE DEF CMLEN ACTUAL COMMAND LINE LENGTH SSA,RSS ERROR CODE RETURNED? JMP *+3 NO--BRANCH AROUND LDB .INAM JMP FIERR * LDB CMLEN EOF GIVEN? SSB JMP EOCMD YES--PROCESS * BLS GET COMMAND LENGTH IN BYTES STB CMLEN JMP ECHO THEN PRINT COMMAND AND PARSE IT * * HERE TO GET DATA FROM AN LU * CMDLU LDA PRMT? LU--SHOULD PROMPT BE ISSUED? SZA,RSS JMP GETCM NO--FLAG = 0 * JSB EXEC YES--PROMPT = TLOG? DEF *+1+4 RETURN ADDRESS DEF NA2 DEF INLU DEF PROMT PROMPT ADDRESS DEF D4 AND LENGTH JMP EXERR ERROR RETURN * GETCM JSB EXEC GET COMMAND FOR NON-INTERACTIVE DEVICE DEF *+1+4 RETURN ADDRESS DEF NA1 READ, NO ABORT DEF INLU2 LU # W/ ECHO BIT SET DEF CMLIN COMMAND LINE BUFFER DEF M72 AND LENGTH, IN BYTES JMP EXERR ERROR RETURN SZB,RSS ZERO INPUT? JMP PRNXT YES, JUST PRINT NEXT BUFFER STB CMLEN ACTUAL LENGTH OF DATA TRANSFERED SPC 2 * * ECHO COMMAND, THEN PARSE IT * ECHO LDB CMLEN PUSH FINAL BLANK ON LINE ADB .CMLN LDA .BLNK JSB .MBT DEF D1 NOP LDB CMLEN PICK BACK UP COMMAND LENGTH CMB,INB NEGATE LENGTH STB BCNT SAVE NEG LENGTH FOR COMMAND PARSE COUNTER LDA INLU COMMAND INPUT LU AND CPA LSTLU LIST LU THE SAME? JMP PARSE YES--NEED NOT ECHO COMMAND * LDA .CeML2 NO--ECHO ON LIST DEVICE CMB,CLE,INB ERB SEZ,INB BUMP TO INCLUDE LENGTH OF PRECEEDING BLANKS INB IF ODD BYTE COUNT, ADD ONE JSB LIST JMP EXERR ERROR RETURN * PARSE LDA .CMLN GET ADDRESS OF COMMAND LINE JSB NBLNK AND FIND FIRST NON-BLANK CHARACTER JMP PRNXT ALL BLANK COMMAND--JUST PR NEXT BUFFER JMP CMERR CHARACTER LT A BLANK--ERROR STA CMSAV JSB .LDY DEF D8 CHAR. GT A BLANK--OK, SET UP INDEX FOR LDB .CLEN COMM. TBL SEARCH & GET ADDRESS OF LENGTH STB TBLN OF NEXT COMMAND TABLE AND SAVE. LDB .CMTB GET BYTE ADDRESS OF COMMAND TABLE JSB SERCH AND PERFORM SEARCH JMP CMERR ERROR RETURN SPC 2 * * COMMAND WORD OK--NOW GET PARAMETERS * CLA ZERO PARAMETER COUNT STA FICNT LDA .PTAB RESET PARAMETER STA .NEXT TABLE ADDRESS LDA CMSAV GET ADDRESS OF COMMAND GTPAR JSB IBLNK FIND NEXT BLANK OR COMMA JMP RTAB1 NONE--JUMP TO COMMAND ROUTINE GTPR2 JSB NBLNK FIND NEXT NON-DELIMITING CHARACTER JMP RTAB1 NONE--JUMP TO COMMAND ROUTINE JMP PMERR LT--ILLEGAL CHARACTER STA .NEXT,I GT--IT'S POSSIBLE SAVE PARAM ADDR. ISZ .NEXT AND INCREMENT TABLE ADDRESS ISZ FICNT INCREMENT PARAMETER COUNT LDB FICNT MAKE SURE NO MORE THAN SIX CPB D7 JMP PMERR MORE--AN ERROR JMP GTPAR OK--CONTINUE SEARCH SPC 2 * * HERE ON END OF PARSE, ROUTINE TABLE * RTAB1 JSB .JPY DEF RTAB2 YES--JUMP TO COMMAND ROUTINE RTAB2 NOP JMP HECMD ?? (HELP) COMMAND ROUTINE JMP BACMD BALANCE COMMAND ROUTINE JMP EXCMD EXIT COMMAND ROUTINE JMP FICMD FIND COMMAND ROUTINE JMP FOCMD FORMAT COMMAND ROUTINE JMP LICMD LIST COMMAND ROUTINE JMP PRCMD PRINT COMMAND ROUTINE  JMP TICMD TIME COMMAND ROUTINE SPC 5 * * DATA AREA FOR COMMAND PARSING * CMTB ASC 18,TIMEPRINTLISTFORMATFINDEXITBALANCE?? .CMTB DBL CMTB CMTBL NOP DEC 2 DEC 7 DEC 4 DEC 4 DEC 6 DEC 4 DEC 5 DEC 4 .CLEN DEF CMTBL CMSAV NOP RECNM NOP INLU2 NOP ASC 1, CMLIN BSS 36 COMMAND LINE BUFFER .CMLN DBL CMLIN .CML2 DEF CMLIN-1 D7 DEC 7 D36 DEC 36 M2 DEC -2 M4 DEC -4 M6 DEC -6 M12 DEC -12 M72 DEC -72 RN1 OCT 040001 RN4 OCT 040004 NA1 OCT 100001 HIBYT OCT 177400 LOBYT OCT 377 CMLEN NOP RETURNED COMMAND LINE LENGTH SKP * * ROUTINE TO FIND NEXT BLANK, COMMA, OR EQUAL SIGN IN STRING * ON ENTRY: * A->STRING * BCNT = -(# CHARACTERS IN STRING) * ON EXIT: * A->NEXT BLANK, COMMA, OR EQUAL SIGN (IF ANY) IN STRING * RETURN POINTS = * IBLNK,I IF NO BLANKS, COMMAS, OR EQUAL SIGNS * IBLNK,I+1 IF BLANK OR COMMA FOUND * IBLNK NOP IBL1 LDB .BLNK GET ADDRESS OF CHAR. BLANK JSB .CBT DEF D1 COMPARE BYTE NOP JMP IBL3 EQ--RETURN+1 JMP IBL2 LT--CONTINUE SEARCH LDB .COMA GT--SEE IF COMMA JSB .CBT DEF D1 NOP JMP IBL3 EQ--RETURN+1 JMP IBL2 LT--CONTINUE SEARCH LDB .EQSN GT--SEE IF AN EQUAL SIGN JSB .CBT DEF D1 NOP JMP IBL3 EQ--RETURN+1 NOP LT, OR GT,--CONTINUE SEARCH IBL2 INA GET NEXT CHAR. IN STRING ISZ BCNT DECREMENT LENGTH JMP IBL1 JMP IBLNK,I END-OF-STRING--RETURN IBL3 ADA M1 ISZ IBLNK INCREMENT RETURN JMP IBLNK,I POINT AND RETURN SPC 2 * * ROUTINE TO FIND NEXT CHARACTER THAT IS NOT A BLANK, COMMA, OR * EQUAL SIGN * ON ENTRY: * A->STRING * BCNT = -(# CHARACTERS IN STRING) * ON EXIT: * A->CHAR. OyTHER THAN BLANK, COMMA, OR EQUAL SIGN (IF FOUND) * RETURN POINTS = * NBLNK,I IF ALL BLANK(S), COMMA(S), OR EQUAL SIGN(S) * NBLNK,I+1 IF CHARACTER LT A BLANK * OR LT A COMMA AND GT A BLANK * NBLNK,I+2 IF CHARACTER GT A COMMA * NBLNK NOP NBL1 LDB .BLNK GET BLANK CHAR. ADDRESS JSB .CBT DEF D1 DO COMPARISON NOP JMP NBL2 EQ--TRY NEXT JMP NBL4 LT--RETURN+1 LDB .COMA GT--SEE IF A COMMA JSB .CBT DEF D1 NOP JMP NBL2 EQ--TRY NEXT JMP NBL4 LT--RETURN+1 LDB .EQSN GT--SEE IF AN EQUAL SIGN JSB .CBT DEF D1 NOP JMP NBL2 EQ--TRY NEXT NOP JMP NBL3 LT, OR GT,--RETURN+2 NBL2 ISZ BCNT DECREMENT STRING LENGTH JMP NBL1 AND CONTINUE SEARCH JMP NBLNK,I END OF STRING--RETURN NBL3 ISZ NBLNK RETURN+2 NBL4 ISZ NBLNK RETURN+1 JMP NBLNK,I SPC 2 * * ROUTINE TO SEARCH FOR COMMAND OR KEYWORD IN TABLE * ON ENTRY: * A->WORD IN STRING FOR COMPARISON * B->COMMAND OR KEYWORD TABLE * TBLN->COMMAND OR KEYWORD LENGTHS TABLE * Y=# OF COMMANDS OR KEYWORDS IN TABLE * ON EXIT: * A->LAST CHARACTER IN STRING COMPARED * Y=INDEX FOR COMMAND, IF FOUND, ELSE 0 * RETURN POINTS = * SERCH,I IF WORD IN STRING DOES NOT MATCH A COMMAND * OR KEYWORD * SERCH,I+1 IF MATCH FOUND * SERCH NOP SRCH1 STA VALUE STB SESCR SAVE COMMAND TABLE ADDRESS TEMPORARILY JSB .LBY DEF TBLN,I GET LENGTH FOR COMPARISON STB CMPLN LDB SESCR PICK BACK UP THE TABLE ADDRESS JSB .CBT DEF CMPLN DO COMPARISON NOP JMP SRCH2 SAME--RETURN+1 NOP STB SESCR SAVE PLACE IN COMMAND TABLE TEMPORARILY LDB .BLNK GET BYTE ADDRESS OF CHAR. BLANK - JSB .CBT DEF D1 COMPARE BLANK AND BYTE IN COMMAND STRING NOP JMP SRCH2 EQ--AN ABBREVIATION, RETURN+1 NOP LDB .COMA SEE IF CHAR. A COMMA JSB .CBT DEF D1 NOP JMP SRCH2 EQ--AN ABBREVIATION NOP LDB .EQSN SEE IF CHAR. AN EQUAL SIGN JSB .CBT DEF D1 NOP JMP SRCH2 EQ--AN ABBREVIATION NOP JSB .DSY CHECK NEXT CMMD OR KEYWORD RSS IN TABLE IF ANY LEFT JMP SERCH,I NO MORE, ERROR RETURN LDA VALUE LDB SESCR JMP SRCH1 ELSE, TRY AGAIN SRCH2 ISZ SERCH JMP SERCH,I SPC 2 CHARS ASC 2, ,= .BLNK DBL CHARS .COMA DBL CHARS+1 .EQSN DBR CHARS+1 VALUE NOP SESCR NOP SKP * * ?? (HELP) COMMAND ROUTINE * HECMD NOP JSB .LDY DEF D9 SET UP FOR INDEX THROUGH LIST LDA CMLST SET UP REGISTERS FOR OUTPUT HEC1 JSB .LBY DEF LSTLN THROUGH SUBROUTINE CONSL JSB CONSL LET CONSL DO OUTPUT DEF EXERR JSB .DSY ON LAST LINE? RSS JMP COMMD YES--RETURN TO PROMPT ADA B NO--GET NEXT LINE JMP HEC1 AND BRANCH BACK UP * CMLST DEF *+1 ASC 14, COMMAND DESCRIPTION ASC 15, ?? DISPLAY COMMANDS ASC 27, BALANCE BALANCE LOGGED REPLIES TO LOGGED REQUESTS ASC 13, EXIT END TLOG RUN ASC 27, FIND FIND BUFFERS WITH SPECIFIED CONDITION(S) ASC 19, FORMAT SET OUTPUT LISTING FORMAT ASC 14, LIST SET LISTING LU ASC 18, PRINT SELECT BUFFERS TO PRINT ASC 15, TIME SET A TIME WINDOW LSTLN NOP DEC 15 DEC 18 DEC 14 DEC 19 DEC 27 DEC 13 DEC 27 DEC 15 DEC 14 D9 DEC 9 SKP * * EXIT COMMAND ROUTINE * EXCMD LDA .PTAB PURGE PARAMETEAR GIVEN? CPA .NEXT JMP EXIT1 NO--BRANCH OUT LDB .EXLN YES--SEE IF KEYWORD CORRECT STB TBLN JSB .LDY DEF D1 LDB .EXKY LDA A,I JSB SERCH JMP PMERR INCORRECT--INFORM USER LDA .PTAB ONLY PARAMETER GIVEN? INA CPA .NEXT RSS JMP PMERR NO--ERROR, INFORM USER * LDB TTYPE SSB,RSS DISC OR TAPE LOG? JMP PMERR ERR, CANNOT PURGE TAPE * LDA .DCB MAKE SURE WE HAVE ADDRESS LDB .NAM OF CORRECT DCB & NAME JSB TPURG AND TRY PURGE OF LOG FILE SSA,RSS IF PURGE NOT SUCCESSFUL, TRY CLOSE JMP EXIT2 * EXIT1 LDB TTYPE SSB,RSS JMP EXIT2 SKIP CLOSE IF TAPE LDA .DCB JSB TCLOS JUST CLOSE FILE, IGNORE ERRORS * EXIT2 LDA INTYP COMMANDS FROM INPUT FILE? CPA D1 JMP EXIT3 NO--BRANCH AROUND CLOSE JSB CLOSE YES--CLOSE FILE DEF *+1+2 RETURN ADDRESS DEF INDCB FILE DCB DEF STAT STATUS--ERROR WORD (ERRORS IGNORED) * EXIT3 LDA .DONE PRINT "END TLOG" MESSAGE LDB D6 JSB TELL NOP * JSB EXEC THEN TERMINATE DEF *+1+3 DEF D6 REQUEST CODE = TERMINATE DEF D0 THIS PROGRAM DEF D0 NORMALLY SPC 2 EXKEY ASC 3,PURGE .EXKY DBL EXKEY .EXLN DEF * DEC 5 DONE ASC 6, ** END TLOG .DONE DEF DONE SKP * * PRINT COMMAND ROUTINE * PRCMD EQU * LDA .PTAB ANY PARAMETER GIVEN? CPA .NEXT JMP PRNXT DEFAULT TO NEXT LDB .PRLN CHECK KEYWORD STB TBLN JSB .LDY DEF D4 LDB .PRKY LDA A,I JSB SERCH JMP PMERR LDA .PTAB ONLY PARAMETER GIVEN? INA CPA .NEXT RSS JMP PMERR NO, ERROR JSB .JPY DEF PRTAB PRTAB NOP JMP PRFIR JMP PRNXT / JMP PRLAS JMP PRALL * PRFIR CCA SET FLAG TO STA HALT ADVANCE JSB FBUFR TO THE FIRST BUFFER PRBUF JSB FBUFR GET BUFFER JMP COMMD JSB PBUF PRINT BUFFER JMP COMMD * PRNXT JSB FBUFR GET NEXT BUFFER JMP PREOF IF EOF, PRINT MESSAGE JSB PBUF PRINT BUFFER JMP COMMD PREOF LDA .LEOF LDB D8 JSB TELL JMP COMMD JMP COMMD * PRLAS CLA STA HALT LDA TTYPE SSA,RSS DISC OR MT LOG? JMP PLST1 JMP TO MT LOG LDA WLAST DISC--SET CURNT TO WLAST STA CURNT JMP PRBUF JMP TO PRINT BUFFER PLST1 LDA LOGLU MAG TAPE--JUMP TO END OF FILE IOR B1300 STA TEMP1 JSB EXEC DEF *+1+2 DEF NA3 DEF TEMP1 JMP EXERR LDA LOGLU THEN BACKSPACE ONE RECORD IOR B200 STA TEMP1 JSB EXEC DEF *+1+2 DEF NA3 DEF TEMP1 JMP EXERR JMP PRBUF * PRALL CCA SET FLAG TO STA HALT ADVANCE JSB FBUFR TO THE FIRST BUFFER PALL1 JSB FBUFR FILL BUFFER JMP COMMD NO MORE BUFFER--END OF COMMAND JSB PBUF PRINT BUFFER JMP PALL1 GET NEXT BUFFER SPC 2 PRKEY ASC 8,ALLLASTNEXTFIRST LEOF ASC 8, EOF IN LOG FILE .LEOF DEF LEOF .PRKY DBL PRKEY .PRLN DEF * DEC 5 DEC 4 DEC 4 DEC 3 B200 OCT 200 B1300 OCT 1300 SKP * * FORMAT COMMAND ROUTINE * FOCMD EQU * LDA .PTAB CPA .NEXT JMP FONOR DEFAULT IS NORMAL LISTING LDB .FOLN STB TBLN JSB .LDY DEF D5 LDB .FOKY LDA A,I JSB SERCH JMP PMERR LDA .PTAB INA CPA .NEXT RSS JMP PMERR JSB .JPY DEF FOTAB FOTAB NOP JMP FOOFF JMP FONOR JMP FOBUF JMP FODAT JMP FOBO*T * FOOFF LDA OFFFG STA PRFLG JMP COMMD * FONOR LDA NORFG STA PRFLG JMP COMMD * FOBUF LDA BUFFG STA PRFLG JMP COMMD * FODAT LDA DATFG STA PRFLG JMP COMMD * FOBOT LDA BOTFG STA PRFLG JMP COMMD SPC 2 FOKEY ASC 12,BOTHDATABUFFERNORMALOFF .FOKY DBL FOKEY .FOLN DEF * DEC 3 DEC 6 DEC 6 DEC 4 DEC 4 OFFFG DEC 1 NORFG DEC 2 BUFFG DEC 4 DATFG DEC 8 BOTFG DEC 16 PRFLG NOP LISTING FLAG SKP * * LIST COMMAND ROUTINE * LICMD EQU * LDA .PTAB CPA .NEXT JMP PMERR ERR,NO LU LDA A,I LDB D3 SEE IF 2 CHAR. LU CMB,INB STB BCNT JSB IBLNK JMP PMERR IF LONGER THAN 2 CHARS, ERR CMA,INA ADA .PTAB,I STA CVLEN LDB .PTAB,I GET ADDRESSES OF LU LDA .LIST AND STORAGE PLACE JSB CNVOC JMP PMERR NOT A NUMBER, ERR LDA .PTAB INA CPA .NEXT RSS JMP PMERR MORE THAN ONE PARAMETER, ERR LDA .LIST,I STA LSTLU JMP COMMD SPC 2 .LIST DEF *+1 NOP SKP * * BALANCE COMMAND ROUTINE * BACMD LDA .PTAB ANY PARAMETERS GIVEN? CPA .NEXT RSS JMP PMERR YES--SHOULD NOT BE ANY * CLA STA RQCNT ZERO OUT COUNT CCA SET FLAG STA HALT TO ADVANCE JSB FBUFR TO FIRST BUFFER BAC1 JSB FBUFR GET LOG BUFFER FILLED JMP BAC9 NO MORE--FINISH COMMAND LDB .BFAD GET ADDRESS OF NEXT BUFFER ADB D3 LDA B,I AND REPLY IS IT A REPLY? SZA JMP BAC4 YES--FIND CORRESPONDING REQUEST * LDB FREE NO--A REQUEST, ADD TO QUEUE SZB,RSS IF OUT OF SPACE, MORE THAN 10 REQUESTS UNMATCHED JMP BAERR INFORM USER, THEN PRINT OUT REQUESTS. LDA B,I A SIMPLE POP FROM FREE STA FREE LDA USED AND STA B,I A SIMPLE PUSH ONTO USED STB USED INB GET BODY OF QUEUE ELEMENT LDA .BFAD ADA D4 AND REQUEST BUFFER AGAIN JSB .MVW DEF D2 MOVE SEQ. # & SOURCE NODE # OF REQUEST NOP ISZ RQCNT INCREMENT REQUEST COUNT JMP BAC1 GET NEXT LOG RECORD SPC 2 * * HERE ON REPLY * BAC4 CLA ZERO OUT TEMPORARY ADDRESS STA TEMP1 STORAGE SPACE INB LDA B,I GET SEQUENCE NUMBER STA SEQ# SAVE FOR COMPARISONS LDB USED GET USED QUEUE BAC5 SZB,RSS ANY IN THERE? JMP BAC1 NONE--GET NEXT LOG RECORD * STB TEMP INB GET NEXT SEQUENCE NUMBER LDA B,I XOR SEQ# DO COMPARISON ON SEQ. #'S SZA,RSS JMP BAC7 SAME--NOW CHECK NODE #'S BAC6 LDB TEMP STB TEMP1 LDB TEMP,I DIFFERENT--TRY NEXT ONE JMP BAC5 * BAC7 INB GET ADDRESS OF SOURCE NODE #'S LDA .BFAD IN QUEUED BUFFER ADA D5 AND IN BLOCK BUFFER LDA A,I CPA B,I COMPARE NODE #'S JMP BAC8 SAME--REMOVE REQUEST JMP BAC6 DIFFERENT--TRY NEXT REQUEST * BAC8 LDA TEMP,I GET FORWARD POINTER FROM THIS QUEUED SPACE LDB TEMP1 GET PREVIOUS SPACE'S ADDRESS SZB,RSS IF ZERO, LDB .USED GET USED'S ADDRESS STA B,I REPLACE ITS FORWARD POINTER LDB FREE GET FIRST FREE SPACE'S ADDRESS STB TEMP,I PUT IT IN NEW FIRST FREE SPACE'S POINTER LDA TEMP STA FREE AND UPDATE HEAD POINTER LDA RQCNT DECREMENT BUFFER COUNT ADA M1 STA RQCNT JMP BAC1 AND GO GET NEXT LOG RECORD SPC 2 * * HERE ON END OF BLOCKS * BAC9 JSB CNUMD CONVERT BCNT TO ASCII & PUT INTO MESSAGE DEF *+1+2 RETURN ADDRESS D$ DEF RQCNT BUFFER COUNT DEF UNBAL+1 MESSAGE BUFFER LDA .UNBL GET MESSAGE ADDRESS LDB D18 AND ITS LENGTH JSB TELL AND PRINT MESSAGE JMP EXERR ERROR RETURN LDA RQCNT GET UNBALANCED COUNT AGAIN SZA,RSS JMP COMMD IF ZERO, WE ARE DONE BAC10 JSB FBUFR IF NOT, MUST WRITE JMP COMMD OUT ALL UNBALANCED BUFFERS BAC11 LDA .USED GET ADDRESS OF NEXT ENTRY IN USED QUEUE LDB .USED,I SZB IF NONE, JMP BAC12 CMA STA HALT SET HALT FLAG JMP BAC10 AND LET FBLCK END COMMAND BAC12 STA TEMP1 SAVE OLD STORAGE LOCATION ADDRESS LDA B SWITCH REGISTERS LDB A,I AND PICK UP FORWARD POINTER SZB IF POINTER ZERO, LAST ENTRY FOUND JMP BAC12 IF NOT, TRY AGAIN INA GET SEQUENCE # LDB A,I OF NEXT REQUEST IN USED QUEUE STB SEQ# AND SAVE FOR COMPARISON BAC13 LDA .BFAD ADA D4 AND ADDRESS OF THAT IN NEXT BUFFER LDB A,I COMPARE THE TWO CPB SEQ# RSS JMP BAC14 NOT SAME--TRY NEXT JSB PBUF SAME--LIST IT LDA TEMP1,I REMOVE REQUEST FROM USED QUEUE CLB STB TEMP1,I ZERO OUT LAST FORWARD POINTER LDB FREE AND STB A,I A SIMPLE PUSH ONTO FREE STA FREE JMP BAC11 BAC14 JSB FBUFR GET NEXT LOG BUFFER TO COMPARE TO JMP COMMD ONE IN QUEUE JMP BAC13 SPC 2 FREE DEF *+1 DEF *+3 REQUEST BUFFER RECORDING BSS 2 AREA FOR REQUEST BALANCING DEF *+3 BSS 2 DEF *+3 BSS 2 DEF *+3 BSS 2 DEF *+3 BSS 2 DEF *+3 BSS 2 DEF *+3 BSS 2 DEF *+3 BSS 2 DEF *+3 BSS 2 DEC 0 BSS 2 USED NOP RECORDED BUFFERS LINKED LIST HEADER .USED DErF USED SEQ# NOP D4 DEC 4 D5 DEC 5 REPLY OCT 040000 UNBAL ASC 18, REQUEST BUFFERS UNBALANCED .UNBL DEF UNBAL D18 DEC 18 SKP * * SET COMMAND ROUTINE * TICMD LDA TTYPE REMOVE ANY OLD WINDOW AND WINDO SZA,RSS WAS THERE ONE? JMP SEC1 NO--BRANCH AROUND XOR TTYPE YES--RESET TYPE WORD STA TTYPE SSA,RSS DISK LOG? JMP SEC1 NO--BRANCH AROUND * LDB START YES--RESET RECORD STB WSTRT VALUES STB CURNT LDB LAST STB WLAST * SEC1 LDB .PTAB SEE IF ANY BOUNDS SPECIFIED BY USER CPB .NEXT JMP COMMD NO--DONE LDB B,I LDA .LOBD STORE TIME IN LOWER BOUND JSB CNVTO PARSE TIME PARAM & CONVERT TO OCTAL * LDB .PTAB UPPER BOUND GIVEN? INB CPB .NEXT RSS JMP SEC3 YES--JUMP AROUND CCA NO--SET INFINITE ALS,RAR UPPER STA UPBND BOUND JMP SEC5 * SEC3 LDB B,I GET UPPER BOUND PARAM LDA .UPBD STORE TIME IN UPPER BOUND JSB CNVTO PARSE & CONVERT TO OCTAL * LDA .PTAB LAST CHECK FOR LEGALITY OF COMMAND INA INA CPA .NEXT RSS JMP PMERR STILL A PARAMETER LEFT--ERROR SEC5 LDA .PTAB ELSE, RESET ADDRESS VALUE STA .NEXT CLA CLEAR RECORD COUNT STA RQCNT CCA SET FLAG STA HALT TO ADVANCE JSB FBUFR TO FIRST BUFFER * SEC6 LDA CURNT SET WINDOW STARTING RECORD TO STA WSTRT NEXT RECORD JSB FBUFR FILL BUFFER BLOCK JMP SEC8 END OF BUFFERS--EMPTY WINDOW JSB BCHEK CHECK BOUNDS JMP SEC6 TOO SMALL--READ NEXT RECORD JMP SEC8 TOO LARGE--EMPTY WINDOW ISZ RQCNT JUST RIGHT--BUMP COUNT * SEC7 LDA CURNT STA TEMP SET BACKWARD POINTER FOR SETTING WLAST JSB FBUFR READ NEXT RECORD JMP SEC10 END OF DATA--WLAST ALREADY SET JSB BCHEK CHECK BOUNDS JMP *+2 IGNORE, LOOSE WINDOW JMP SEC9 TOO LARGE--SET WLAST ISZ RQCNT WITHIN BOUNDS--BUMP COUNT JMP SEC7 AND TRY NEXT * SEC8 CCA EMPTY WINDOW, SET WSTRT STA WSTRT TO A MINUS ONE JMP SEC10 * SEC9 LDA TEMP SET WLAST CPA D2 IF LAST RECORD READ = RECORD 2, THEN LAST RECORD JMP *+3 IN WINDOW IS LAST RECORD IN FILE, ELSE ADA M1 LAST RECORD READ - 1. RSS LDA RECNM STA WLAST * SEC10 STA HALT SET HALT FLAG AND LET FBUFR END COMMAND JSB FBUFR NOP JSB CNUMD CONVERT BCNT TO ASCII & PUT INTO MESSAGE DEF *+1+2 DEF RQCNT BUFFER COUNT DEF CMMSG+1 MESSAGE BUFFER LDA .CMSG GET ADDRESS OF MESSAGE LDB D20 AND ITS LENGTH JSB TELL AND PRINT IT JMP EXERR ERROR RETURN LDA TTYPE SET WINDOW SET BIT IN TTYPE IOR WINDO STA TTYPE JMP COMMD DONE--GET NEXT COMMAND SPC 2 START NOP WSTRT NOP WINDO OCT 004000 SKP * * FIND COMMAND ROUTINE * FICMD CLA CLEAR THE SEARCH ITEM COUNT STA FICNT STA RQCNT CLEAR BUFFER COUNT LDA .PTAB KEYWORD GIVEN? STA FITAB CPA .NEXT JMP NOKEY FIND ALL * FIC0 LDA A,I YES--SET UP FOR SEARCH OF LDB .FKLN KEYWORD TABLE STB TBLN JSB .LDY DEF D8 LDB .FKEY JSB SERCH PERFORM SEARCH JMP PMERR ERROR RETURN--INFORM USER ISZ FICNT INCREMENT KEYWORD COUNT LDA FICNT ARS,ARS MAKE SURE NO MORE THAN THREE KEYWORDS SZA JMP PMERR TOO MANY--ERROR LDA FITAB OK--GET VALUE ADDRESS INA STA FITAB JSB .JPY DEFQ FITAB AND JUMP TO KEYWORD ROUTINE FITAB NOP JMP THKEY "3000" KEYWORD ROUTINE JMP BUKEY "BUSY" KEYWORD ROUTINE JMP DEKEY "DESTINATION" KEYWORD ROUTINE JMP LIKEY "LINERR" KEYWORD ROUTINE JMP REKEY "REJECT" KEYWORD ROUTINE JMP SEKEY "SEQUENCE" KEYWORD ROUTINE JMP SOKEY "SOURCE" KEYWORD ROUTINE * LDB D0 "STREAM" KEYWORD, GET INDEX FOR JMP FIC1 STREAM WORD ADDRESS * SOKEY LDB D2 GET INDEX FOR JMP FIC1 SOURCE NODE ADDRESS * SEKEY LDB D1 GET INDEX FOR JMP FIC1 SEQUENCE # ADDRESS * DEKEY LDB D3 GET INDEX FOR DEST. NODE ADDRESS * FIC1 STB .INDX,I STORE INDEX FOR FIND CPA .NEXT PARAMETER MUST BE SPECIFIED JMP PMERR LDA A,I GET ADDRESS OF PARAMETER LDB M7 GET LONGEST POSSIBLE INTEGER LENGTH + 1 STB BCNT IN NEGATIVE CHARACTERS JSB IBLNK AND FIND NEXT BLANK OR COMMA JMP PMERR MUST BE THERE LDA BCNT GET NEG. LENGTH OF PARAMETER CMA,INA IN BYTES ADA M7 STA CVLEN LDB FITAB,I SET UP FOR CONVERSION LDA .ITEM MUST BE INTEGER FOR ALL BUT "STREAM" JSB CNVOC DO CONVERSION JMP FIC3 NOT AN INTEGER * FIC2 LDA .INDX,I SEE IF INDEX=0, I.E. "STREAM" KEYWORD CCB SZA JMP SETMK .NO, JUST MASK LDB B77 YES--SET MASK FOR STREAM NUMBER LDA .ITEM,I GET ITEM AND 1 AND W/ MASK CPA .ITEM,I STILL EQUAL? RSS .YES, O.K. JMP PMERR .NO, ERROR SETMK EQU * STB .MASK,I LDA FITAB UPDATE PARAMETER ADDRESS INA STA FITAB JMP FIC5 * FIC3 LDA .INDX,I SEE IF INDEX=0, I.E. "STREAM" KEYWORD SZA JMP PMERR NO--NON-INTEGER PARAMETER IS AN ERROR LDA FITAB,I YES--SET UP FOR PARAMETER TABLE SEARCH LDB .NATL STB TBLN JSB .LDY DEF D6 LDB .NATB JSB SERCH AND PERFORM SEARCH JMP PMERR ERROR RETURN JSB .LAY DEF NUMTB TRANSFORM INDEX INTO CORRECT NUMBER STA .ITEM,I AND PUT IN ITEM TABLE JMP FIC2 THEN BRANCH BACK UP TO FINISH * NOKEY EQU * CCA SET FLAG STA HALT TO ADVANCE JSB FBUFR TO FIRST BUFFER FIALL JSB FBUFR FILL BUFFER JMP FIC10 NO MORE BUFFER JSB PBUF PRINT BUFFER ISZ RQCNT UP COUNT JMP FIALL GET NEXT * THKEY LDA D0 GET INDEX FOR 3000 BIT ADDRESS LDB FIRST AND COMPARISON MASK JMP FIC4 * BUKEY LDA D0 GET INDEX FOR REMOTE BUSY COUNT ADDRESS LDB B7400 AND COMPARISON MASK JMP FIC4 * LIKEY LDA D0 GET INDEX FOR LINE ERROR COUNT ADDR. LDB B300 AND COMPARISON MASK JMP FIC4 * REKEY LDA D0 GET INDEX FOR BUSY REJECT BIT ADDR. LDB BUSY AND COMPARISON MASK * FIC4 STA .INDX,I SET INDEX STB .MASK,I MASK STB .ITEM,I AND COMPARISON WORD * FIC5 ISZ .MASK UPDATE MASK TABLE ADDRESS, ISZ .ITEM ITEM TABLE ADDRESS, AND ISZ .INDX INDEX TABLE ADDRESS. LDA FITAB GET PLACE IN PARAMETER TABLE CPA .NEXT IF ANY KEYWORDS LEFT, RSS JMP FIC0 CONTINUE PARSE * LDA FICNT ELSE, SET UP SEARCH COUNTER CMA,INA STA FICNT STA SUB ADA .MASK RESET MASK STA .MASK LDA SUB ADA .INDX INDEX STA .INDX LDA SUB ADA .ITEM AND ITEM TABLE ADDRESSES STA .ITEM CCA SET FLAG STA HALT TO ADVANCE JSB FBUFR TO FIRST BUFFER * FIC6 JSB FBUFR FILL LOG BUFFER JMP FIC10 END OF DATA--FINISH UP * FIC7 LDB .BFAD GET NEXT LOG ADDRESS ADB D3 INCREMENT TO G}HET BUFFER ADDRESS ADB .INDX,I ADD INDEX TO GET PROPER WORD LDA B,I GET WORD AND .MASK,I ISOLATE PROPER BITS LDB B300 IS THIS A LINERR CHECK? CPB .MASK,I RSS JMP FIC8 NO--BRANCH AROUND SZA,RSS YES--IS IT ZERO? JMP FIC9 YES--REQUEST/REPLY DOES NOT MATCH IOR .ITEM,I NO--SET UP TO GET A ZERO ON XOR * FIC8 XOR .ITEM,I DO COMPARISON SZA IF ANY BITS LEFT ON, JMP FIC9 REQUEST/REPLY DOES NOT MATCH CONDITIONS * ISZ .MASK ELSE--CHECK ALL SEARCH ITEMS ISZ .ITEM UPDATE ALL SEARCH ITEM ISZ .INDX ADDRESSES ISZ FICNT INCREMENT ITEM COUNT JMP FIC7 AND LOOP JSB PBUF IF NO MORE, BUFFER MATCHED ALL CONDITIONS ISZ RQCNT PRINT IT, AND INCREMENT COUNT * FIC9 LDA FICNT END OF ONE BUFFER MATCH CMA,INA RETURN ALL SEARCH ADDRESSES TO ADA SUB THEIR ORIGINAL VALUES STA FICNT ADA .MASK STA .MASK LDA FICNT ADA .INDX STA .INDX LDA FICNT ADA .ITEM STA .ITEM LDA SUB STA FICNT RESET ITEM COUNTER JMP FIC6 GET NEXT LOG RECORD SPC 2 * * HERE ON END OF DATA * FIC10 JSB CNUMD CONVERT BCNT TO ASCII DEF *+1+2 RETURN ADDRESS DEF RQCNT BUFFER COUNT DEF CMMSG+1 MESSAGE BUFFER LDA .CMSG SET UP TO PRINT MESSAGE LDB D20 JSB TELL PRINT MESSAGE JMP EXERR ERROR RETURN LDA .PTAB RESTORE PARAMETER TABLE ADDRESS STA .NEXT JMP COMMD AND GO GET NEXT COMMAND SPC 2 FKEY ASC 26,STREAMSOURCESEQUENCEREJECTLINERRDESTINATIONBUSY3000 .FKEY DBL FKEY FKYLN NOP DEC 4 DEC 4 DEC 11 DEC 6 DEC 6 DEC 8 DEC 6 DEC 6 .FKLN DEF FKYLN NATAB ASC 12,RFAPTOPOREXECWEXECMDLIST .NATB DBL NATAB NATLN NOP DEC 5 DEC 5 DEC 5 DEC 2 DEC 4 DEC 3 .NATL DEF NATLN FICNT EQU NATLN NUMTB NOP DEC 1 DEC 5 DEC 3 DEC 7 DEC 4 DEC 6 MASK BSS 3 MASK TABLE FOR FIND COMMAND .MASK DEF MASK INDEX BSS 3 INDEX TABLE FOR FIND COMMAND .INDX DEF INDEX ITEMS BSS 3 ITEM TABLE FOR FIND COMMAND .ITEM DEF ITEMS D0 DEC 0 D6 DEC 6 B77 OCT 000077 B300 OCT 000300 B7400 OCT 007400 M1 DEC -1 M7 DEC -7 BUSY OCT 020000 FIRST OCT 100000 SUB NOP TBLN NOP SKP * * ROUTINE TO CONVERT TIME PARAMETER TO OCTAL * ON ENTRY: * A->DESTINATION ADDRESS * B->TIME PARAMETER (ADDRESS IN BYTES) * ON EXIT: * TIME IS A FOUR WORD ARRAY: HRS:MIN:SEC:TMS * CNVTO NOP STA COSCR SET UP DESTINATION ADDRESS LDA M4 SET UP LOOP COUNTER STA BCNT CNVT1 LDA M2 SET UP NEG. BYTE COUNT FOR CNVOC STA CVLEN LDA COSCR POINT A BACK TO DEST. ADDRESS JSB CNVOC AND CALL CONVERT ROUTINE JMP PMERR NOT A NUMBER--ERROR ISZ BCNT THROUGH WITH CONVERSION? RSS JMP CNVT3 YES--FINAL PARAM. CHECK * LDA COSCR,I GET NUMBERIC VALUE SSA NEGATIVE? JMP PMERR .YES, ERROR LDA COADD GET TABLE ADDR ADA BCNT ADD CURRENT INDEX LDA 0,I GET LIMIT ADA COSCR,I ADD TO VALUE SSA,RSS OVER LIMIT? JMP PMERR .YES, ERROR LDA .COLN MAKE SURE NEXT CHAR A ":" JSB .CBT DEF D1 ONE AND THE SAME? NOP JMP CNVT2 YES--CONTINUE JMP PMERR NO-- JMP PMERR ERROR CNVT2 ISZ COSCR UPDATE DESTINATION ADDRESS JMP CNVT1 CNVT3 LDA M2 SET UP VALUES TO CHECK STA BCNT FOR TRAILING BLANK OR COMMA LDA B WHICH MUST BE THERE JSB IBLNK JMP PMERR ISN'T-}-ERROR JMP CNVTO,I IS--RETURN SPC 2 D1 DEC 1 COSCR NOP * PARAMETER LIMIT TABLE DEC -24 LIMIT FOR HOUR DEC -60 LIMIT FOR MINUTE DEC -60 LIMIT FOR SECOND COADD DEF * SPC 2 * * ROUTINE TO CONVERT A VALUE FROM ASCII TO OCTAL * ON ENTRY: * A->DESTINATION ADDRESS * B->ASCII VALUE (ADDRESS IN BYTES) * CVLEN=NEG. LENGTH OF PARAMETER IN BYTES * ON EXIT: * RETURN POINTS: * CNVOC,I IF ASCII STRING NOT A NUMBER * CNVOC,I+1 NORMAL RETURN * CNVOC NOP STA CCSCR SAVE DESTINATION ADDRESS CLA STA CCSCR,I STA NFLAG CLEAR NEGATIVE FLAG STA SFLAG AND SIGN BIT FLAG CNVO1 JSB .LBT GET FIRST BYTE ADA M48 CONVERT TO OCTAL SSA,RSS IS THIS A NUMBER JMP CNVO2 YES--CONVERT TO AN OCTAL DIGIT ADA D3 NO--A NEGATIVE SIGN? SZA JMP CNVOC,I NO--ERROR CMA YES--SET NEGATIVE FLAG STA NFLAG ISZ CVLEN JMP CNVO1 CNVO2 ADA M10 IS THIS GREATER THAN AN ASCII NUMBER? SSA,RSS JMP CNVOC,I YES--GT NINE ASCII CHAR ADA D10 NO--GET NUMBER BACK ADA CCSCR,I AND ADD TO PREVIOUS VALUE STA CCSCR,I ISZ CVLEN INCREMENT COUNT RSS DONE? JMP CNVO3 YES--BRANCH OUT STB CCSC1 NO--SAVE PLACE IN ASCII STRING CLB SET UP FOR MULTIPLY MPY D10 AND CORRECT FOR POWER OF 10 CLB,CLE SET E REG. TO BIT 15 ELA,RAR OF REG. A STA CCSCR,I ERB THEN SET SFLAG FOR IOR AT END OF CONVERSION STB SFLAG LDB CCSC1 RESTORE REG. B JMP CNVO1 AND CONTINUE CNVO3 IOR SFLAG RESET BIT 15, IF NECESSARY STA CCSCR,I ISZ NFLAG WAS NEGATIVE FLAG SET? JMP CNVO4 NO--BRANCH AROUND LDA CCSCR,I YES--NEGkATE CALCULATED NUMBER CMA,INA STA CCSCR,I CNVO4 ISZ CNVOC BUMP ADDRESS JMP CNVOC,I AND RETURN+1 SPC 2 D10 DEC 10 M10 DEC -10 M48 DEC -48 CVLEN NOP CCSCR NOP CCSC1 NOP NFLAG NOP SFLAG NOP SPC 2 * * ROUTINE TO SEND OUTPUT TO LIST DEVICE * ON ENTRY: * A->LINE TO BE PRINTED ON LIST DEVICE * B=LENGTH OF LINE, IN WORDS, TO BE PRINTED * ON EXIT: * RETURN POINTS = * LIST,I IF AN ERROR IN EXEC CALL * LIST,I+1 NORMAL RETURN * LIST NOP STA .LSLN STORE OUTPUT LINE ADDRESS STB LSLEN AND ITS LENGTH IN CALL JSB EXEC DEF *+1+4 RETURN ADDRESS DEF NA2 WRITE, NO ABORT DEF LSTLU OUTPUT LU NUMBER .LSLN NOP OUTPUT LINE ADDRESS DEF LSLEN OUTPUT LINE LENGTH JMP LIST,I ERROR RETURN LDA .LSLN RESET A & B REGS. LDB LSLEN ISZ LIST JMP LIST,I NORMAL RETURN LSLEN NOP SPC 2 * * ROUTINE TO PRINT MESSAGE ON INPUT DEVICE * ON ENTRY: * A->LINE TO BE PRINTED ON INPUT DEVICE * B=LENGTH OF LINE, IN WORDS, TO BE PRINTED * ON EXIT: * RETURN POINTS: * CONSL,I IF AN ERROR IN EXEC CALL * CONSL,I+1 NORMAL RETURN * CONSL NOP STA .CSLN STORE OUTPUT LINE ADDRESS STB CSLEN AND ITS LENGTH IN CALL LDA PRMT? IS DEVICE INTERACTIVE? SZA,RSS JMP CONS1 NO--JUST RETURN JSB EXEC YES--MAKE CALL DEF *+1+4 RETURN ADDRESS DEF NA2 WRITE, NO ABORT DEF INLU INPUT LU .CSLN NOP OUTPUT LINE ADDRESS DEF CSLEN OUTPUT LINE LENGTH JMP CONSL,I ERROR RETURN CONS1 LDA .CSLN RESTORE A & B REGS. LDB CSLEN ISZ CONSL BUMP RETURN ADDRESS JMP CONSL,I NORMAL RETURN CSLEN NOP SPC 2 * * ROUTINE TO READ THE NEXT LOG RECORD INTO BUFFR * ON EXIT: *  RETURN POINTS = * FBUFR,I AT THE END OF THE LOG DATA * FBUFR,I+1 NORMAL RETURN * FBUFR NOP FBUFA JSB IFBRK SEE IF USER WANTS TO BREAK COMMAND DEF *+1 SZA JMP FBUF5 YES--RESET VALUES & BRANCH TO COMD * LDA HALT SEE IF FBUFR CALLED TO END COMAND SZA OR AT LAST RECORD JMP FBUF6 YES--BRANCH TO END * CCA EMPTY WINDOW? CPA WSTRT JMP FBUFR,I YES--RETURN END OF DATA * LDA TTYPE FILE OR TAPE LOG? SSA JMP FBUF3 FILE--BRANCH TO READF * JSB EXEC TAPE--CALL EXEC FOR READ DEF *+1+4 RETURN ADDRESS DEF NA1 READ, NO ABORT DEF LOGBI LOG DEVICE LU # DEF BUFFR LOG BUFFER STORAGE DEF RECSZ LOG RECORD SIZE JMP EXERR ERROR RETURN AND B240 REG. A = STATUS SZA EOT OR EOF SENSED? JMP FBUF1 YES--RESET TAPE & RETURN * LDB TTYPE SEE IF WINDOW SET BLF SSB,RSS JMP FBUF0 NO--JUST CONTINUE * JSB BCHEK YES--SEE IF RECORD FALLS WITHIN BOUNDS JMP FBUFA NOT WITHIN LOWER BOUND--RE-READ JMP FBUF1 NOT WITHIN UPPER BOUND--RESET FBUF0 ISZ FBUFR OKAY--RETURN+1 JMP FBUFR,I * FBUF1 LDA LOGLU SET CONTROL BITS WITH MAG TAPE LU IOR B400 FOR REWIND STA FBSCR JSB EXEC DEF *+1+2 RETURN ADDRESS DEF NA3 CONTROL, NO ABORT DEF FBSCR REWIND JMP EXERR ERROR RETURN LDA LOGLU SET CONTROL BITS FOR RECORD SKIP IOR B300 STA FBSCR JSB EXEC AND SKIP FIRST RECORD (TWO WORDS) DEF *+1+2 RETURN ADDRESS DEF NA3 CONTROL, NO ABORT DEF FBSCR FORWARD SPACE ONE RECORD JMP EXERR ERROR RETURN JMP FBUFR,I RETURN,END OF DATA * FBUF3 LDA .DCB GET CURRENT DCB ADDRESS JSB TRoEAD AND READ NEXT RECORD SSA,RSS ANY ERRORS RETURNED? JMP FBUF4 NO--BRANCH AROUND CPA M12 EOF? JMP *+3 YES--BRANCH AROUND LDB .NAM NO--TERMINAL ERROR JMP FIERR LDA D2 RESET CURRENT RECORD STA CURNT TO 2 JMP FBUF3 AND RETRY READ * FBUF4 LDA CURNT WAS THIS LAST RECORD? CPA WLAST STA HALT YES--SET HALT FLAG ISZ CURNT BUMP CURRENT RECORD # ISZ FBUFR AND RETURN ADDRESS JMP FBUFR,I AND RETURN NORMAL * FBUF5 LDA .ADDR ALTER RETURN ADDRESS TO THAT OF COMMD STA FBUFR LDA .PTAB RESET PARAMETER TABLE ADDRESS STA .NEXT FBUF6 CLA STA HALT LDA TTYPE FILE OR TAPE LOG? SSA,RSS JMP FBUF1 TAPE--BRANCH TO REWIND LDA WSTRT FILE--RESET CURRENT RECORD # STA CURNT JMP FBUFR,I AND RETURN END OF DATA SPC 2 FBSCR NOP .ADDR DEF COMMD SPC 2 * * ROUTINE TO CHECK RECORD FOR VALIDITY WITHIN WINDOW BOUNDS * ON ENTRY: * BUFFR = RECORD TO BE CHECKED * ON EXIT: * RETURN POINTS = * BCHEK,I IF NOT WITHIN LOWER BOUND * BCHEK,I+1 IF NOT WITHIN UPPER BOUND * BCHEK,I+2 IF VALID * BCHEK NOP LDA D4 TIME--4 WORD COMPARE STA CMPLN JSB TMVAL CONVERT FROM TMS TO TMS:SEC:MIN:HRS DEF *+1+2 DEF BUFFR+1 DEF MS LDA MS CONVERT FROM STA CTIME+3 TMS:SEC:MIN:HRS LDA MS+1 TO STA CTIME+2 HRS:MIN:SEC:TMS LDA MS+2 STA CTIME+1 LDA MS+3 STA CTIME LDA .CTIM * LDB .LOBD GET ADDRESS OF LOWER BOUND VALUE JSB .CMW DEF CMPLN DO COMPARISON--SHOULD BE GE NOP JMP BCHK1 EQ--THIS RECORD OKAY JMP BCHEK,I LT--INVALID,RETURN NOP GT--THIS RECORD OKAY * BCHK1 LDA .CTIM  LDB .UPBD JSB .CMW DEF CMPLN AND DO COMPARISON--SHOULD BE LE NOP JMP BCHK2 EQ--OKAY JMP BCHK2 LT--OKAY JMP BCHK3 GT--RETURN+1 BCHK2 ISZ BCHEK RECORD OKAY, RETURN+2 BCHK3 ISZ BCHEK JMP BCHEK,I SPC 2 D3 DEC 3 B240 OCT 000240 B400 OCT 000400 NA2 OCT 100002 NA3 OCT 100003 LOWBT OCT 000377 CTIME BSS 4 .CTIM DEF CTIME LOBND BSS 4 .LOBD DEF LOBND UPBND BSS 4 .UPBD DEF UPBND CMPLN NOP SPC 2 * * ROUTINE TO PRINT A LINE ON THE LIST DEVICE, AND IF NOT THE SAME DEVICE * THE INPUT DEVICE. * TELL NOP JSB LIST PRINT MESSAGE ON LIST DEVICE JMP TELL,I ERROR RETURN STA TESCR IF LIST AND INPUT LUS LDA INLU CPA LSTLU NOT THE SAME, JMP TELL2 LDA TESCR ON INPUT DEVICE ALSO. JSB CONSL JMP TELL,I ERROR RETURN TELL2 ISZ TELL NORMAL RETURN JMP TELL,I SPC 2 TESCR NOP SPC 2 * * THE FOLLOWING ROUTINES CALL FMP ROUNTINES: * OPEN, CLOSE, PURGE, AND READF * ON ENTRY: * A->DCB FOR FILE * B->FILE NAME ARRAY * ON EXIT: * A = STATUS * TOPEN NOP STA .DCBO STORE DCB ADDRESS & FILE NAME ARRAY STB .NAMO ADDRESS IN OPEN CALL JSB OPEN PERFORM OPEN CALL DEF *+1+6 .DCBO NOP DEF IERR .NAMO NOP DEF D3 OPTIONS ALWAYS UPDATE, NON-EXCLUSIVE DEF LOSEC DEF LOCRN JMP TOPEN,I * TCLOS NOP STA .DCBC STORE DCB ADDRESS IN CLOSE CALL JSB CLOSE PERFORM CLOSE CALL DEF *+1+2 .DCBC NOP DEF IERR JMP TCLOS,I * TPURG NOP STA .DCBP SAVE DCB ADDRESS & FILE NAME ARRAY STB .NAMP ADDRESS IN PURGE CALL JSB PURGE PERFORM PURGE CALL DEF *+1+5 .DCBP NOP DEF IERR .NAMP NOP DEF LOSEC DEF LOCRN JMP TPURG,I * TREAD NOP STA .DCBR SAVE D=CB ADDRESS IN READF CALL JSB READF PERFORM READ DEF *+1+6 .DCBR NOP DEF IERR DEF BUFFR LOG INPUT BUFFER (1 RECORD) DEF RECSZ LOG RECORD SIZE DEF LEN UNUSED--PLACE HOLDER DEF CURNT RECORD # TO BE READ JMP TREAD,I * * ROUTINE TO PRINT OUT REQUEST/REPLY BUFFERS AS SPECIFIED BY PRFLG * ON ENTRY: * BUFFR = REQUEST/REPLY BUFFER TO BE LISTED * PBUF NOP LDA PRFLG GET PRINT FLAG CPA OFFFG IS "OFF" BIT SET? JMP PBUF,I YES--JUST RETURN LDA .CML2 NO--PRINT A BLANK LINE LDB D1 JSB LIST JMP EXERR * CLA LDB .BFAD DO WE HAVE A REQUEST OR REPLY? ADB D3 LDB B,I RBL SSB LDA D2 REPLY--SET UP TO MOVE 2 BLANKS BEFORE EACH STA BLKCT LINE, REQUESTS MOVE 0 BLANKS LDA .BLNK SET UP OUTPUT LINE ADDRESS WITH LDB .CMLN PROPER INDENTATION JSB .MBT DEF BLKCT NOP STB .OUTL * * THIS PORTION PRINTS OUT THE HEADER * LDA .RQST LDB BLKCT IS THIS A REQUEST OR REPLY, AGAIN? SZB ADA D14 REPLY--GET REPLY HEADER LDB .OUTL ELSE--ALREADY HAVE REQUEST HEADER JSB .MBT DEF D14 PUT INTO OUTPUT LINE NOP * LDA .TMHD GET "TIME:" STRING JSB .MBT DEF D8 AND PUT INTO OUTPUT LINE NOP STB .OUTL SAVE PLACE IN OUTPUT LINE JSB TMVAL REFORMAT SYSTEM TIME INTO DEF *+1+2 ITS COMPONENTS DEF BUFFR+1 DEF MS JSB .LDY DEF D4 SET UP COUNTER FOR CONVERSION PBUF1 JSB .LAY DEF TIMAR GET NEXT TIME VALUE COMPONENT CLE JSB CVTOA AND CONVERT TO ASCII DECIMAL LDB .OUTL PUT VALUE INTO OUTPUT LINE JSB .MBT DEF BCNT NOP JSB .DSY END OF TIME VALUE? RSS JMP PBUF2 YES--BRANCH AROUND COLON MOVE LDA .COLN NO--GET BYTE ADDRESS OF ":" JSB .MBT DEF D1 AND PUT IN OUTPUT LINE NOP STB .OUTL SAVE PLACE IN LINE AND REPEAT JMP PBUF1 FOR ALL TIME COMPONENTS * PBUF2 JSB FBLNK FILL REST OF LINE WITH BLANKS LDA .CML2 GET OUTPUT LINE WORD ADDRESS LDB D37 AND ITS LENGTH JSB LIST THEN PRINT IT JMP EXERR ERROR RETURN LDB .CMLN RESTORE OUTPUT LINE ADDRESS LDA .BLNK MAKING SURE OF INDENTATION JSB .MBT DEF BLKCT NOP STB .OUTL * * THIS PORTION PRINTS OUT THE FIRST 4 WORDS OF THE BUFFER * LDA BUFFR LOAD # OF HEADER WORDS ADA M4 SSA LESS THAN 4? JMP PBF14 .YES, JUST DUMP OUT THE BUFFER LDA M4 SET UP THE COUNTER FOR THE FIRST STA PTEMP FOR WORDS LDA .TITL SAVE PLACE IN TITLE LIST STA PTEM1 LDB .BFAD SAVE PLACE IN BUFFR ADB D3 STB PTEM2 LDB .OUTL PUT TITLE IN OUTPUT LINE PBUF3 JSB .MBT DEF D14 NOP STB .OUTL STA PTEM1 LDA PTEM2,I GET NEXT WORD IN BUFFR CLE LDB M4 IF ON FIRST WORD, CPB PTEMP CME CONVERT TO ASCII OCTAL JSB CVTOA ELSE ITS ASCII DECIMAL LDB .OUTL MOVE VALUE INTO OUTPUT LINE JSB .MBT DEF BCNT NOP LDA M4 IF ON FIRST WORD, CPA PTEMP GET STREAM TYPE AND ADD TO LINE JMP PBUF5 * PBUF4 JSB FBLNK FILL REST OF LINE WITH BLANKS LDA .CML2 GET WORD ADDRESS OF OUTPUT LINE LDB D37 AND ITS LENGTH JSB LIST THEN PRINT IT JMP EXERR LDB .CMLN RESTORE .OUTL LDA .BLNK MAKING SURE OF INDENTATION JSB .MBT DEF BLKCT NOP STB .OUTL ISZ PTEM2 UPDATE WORD ADDRESS POINTER LDA PTEM1 4GET NEXT TITLE ADDRESS ISZ PTEMP CHECK COUNTER JMP PBUF3 NON-ZERO--MORE TO DO JMP PBF14 ZERO--BRANCH TO CHECK FOR ERROR CODE * * HERE TO ADD STREAM TYPE IN ASCII * PBUF5 LDA .BLNK ADD TWO BLANKS TO LINE JSB .MBT DEF D2 NOP LDA .LPAR ADD A LEFT PARENTHESIS JSB .MBT DEF D1 NOP * LDA PTEM2,I ISOLATE STREAM TYPE IN STREAM WORD AND B77 STA PTEM3 SAVE FOR COMPARISONS JSB .LDY DEF D6 SET UP INDEX PBUF6 JSB .LAY DEF NUMTB GET NUMBER FOR COMPARISON CPA PTEM3 AND COMPARE JMP PBUF7 FOUND--BRANCH OUT OF LOOP JSB .DSY DIFFERENT--DECREMENT INDEX JMP PBUF6 JMP PBUF8 IF NOT FOUND--IGNORE * PBUF7 JSB .LAY DEF NATLN GET BYTE LENGTH OF STREAM WORD STA BCNT JSB .LAY DEF CVTAB AND ITS BYTE ADDRESS JSB .MBT DEF BCNT THEN PUT INTO OUTPUT LINE NOP PBUF8 LDA .RPAR ADD RIGHT PARENTHESIS JSB .MBT DEF D1 NOP JMP PBUF4 AND BRANCH BACK UP * * THIS PORTION PRINTS OUT THE REST OF THE BUFFER * PBF14 LDA PRFLG CHECK BITS IN PRFLG CPA NORFG IS NORMAL SET? JMP PBF20 YES--BRANCH TO FINISH CPA BUFFG BUFFER BIT SET? JMP *+4 CPA BOTFG BOTH BIT SET? JMP *+2 JMP PBF17 NOT SET--BRANCH TO DATA BIT CHECK * LDA BUFFR LOAD # OF HEADER WORDS CMA,INA = NEG. # OF WORDS LEFT STA PTEM1 LDA .BFAD GET NEXT WORD IN BUFFER ADA D3 STA PTEM2 * LDA .BTLE PUT "HEADER:" STRING IN OUTPUT LINE LDB .OUTL JSB .MBT DEF D8 NOP STB .OUTL * PBF15 JSB PTWDS PUT NEXT 6 WORDS IN LINE JSB FBLNK FILL REST OF LINE WITH BLANKS LDA .CML2 AND PRINT IT LDB D37 JSB LIST JMP EXERR * LDB .CMLN RESET OUTPUT LINE ADDRESS LDA .BLNK MAKING SURE OF INDENTATION JSB .MBT DEF BLKCT NOP STB .OUTL LDA PTEM1 ARE WE THROUGH? SZA,RSS JMP PBF17 YES--BRANCH TO DATA BIT CHECK LDA M4 NO--PUT 8 BLANKS AT BEGINNING OF LINE STA PTEM3 PBF16 LDA .BLNK JSB .MBT DEF D2 NOP ISZ PTEM3 JMP PBF16 STB .OUTL THEN BRANCH BACK UP JMP PBF15 * * THIS PORTION PRINTS OUT ANY DATA WITH THE BUFFER * PBF17 LDA PRFLG CPA DATFG DATA BIT SET? JMP *+4 CPA BOTFG BOTH BIT SET? JMP *+2 JMP PBF20 NO--BRANCH TO FINISH LDA TTYPE YES--WAS DATA LOGGED WITH REQUEST/ ALF,ALF REPLY BUFFERS? SLA,RSS JMP PBUF,I NO--JUST RETURN * LDA .DAAD YES--GET DATA LENGTH LDB A,I FROM BUFFR AND NEGATE FOR COUNTER LDB A,I CMB,INB STB PTEM1 INA GET ADDRESS OF FIRST DATA WORD STA PTEM2 * LDA .DTLE PUT "DATA:" STRING IN OUTPUT LINE LDB .OUTL JSB .MBT DEF D8 NOP STB .OUTL * PBF18 JSB PTWDS PUT NEXT 6 WORDS IN LINE JSB FBLNK FILL REST OF LINE WITH BLANKS LDA .CML2 AND PRINT IT LDB D37 JSB LIST JMP EXERR * LDB .CMLN RESET OUTPUT LINE ADDRESS LDA .BLNK MAKING SURE OF INDENTATION JSB .MBT DEF BLKCT NOP STB .OUTL LDA PTEM1 ARE WE THROUGH? SZA,RSS JMP PBF20 YES--BRANCH TO FINISH * LDA M4 NO--PUT 8 BLANKS AT BEGINNING STA PTEM3 OF LINE PBF19 LDA .BLNK JSB .MBT DEF D2 NOP ISZ PTEM3 JMP PBF19 STB .OUTL THEN BRANCH BACK UP JMP PBF18 * PBF20 LDA .CML2 PRINT A BLANK LINE AT END LDxCB D1 JSB LIST JMP EXERR JMP PBUF,I THEN RETURN SPC 2 * * ROUTINE TO TAKE 6 WORDS FROM THE BUFFER OR DATA, TRANSLATE THEM TO * ASCII OCTAL AND PUT THE WORDS IN THE OUTPUT LINE. * ON ENTRY: * PTEM1 = NEG. # OF WORDS IN BUFFER OR DATA TO BE MOVED * PTEM2 = NEXT WORD IN BUFFER OR DATA * .OUTL->NEXT WORD IN OUTPUT LINE * PTWDS NOP LDA PTEM1 ANY WORDS TO MOVE? SZA,RSS JMP PTWDS,I NO--JUST RETURN LDA M6 YES--SET COUNTER FOR 6 WORDS STA PTEM3 * PTW1 LDA PTEM2,I GET NEXT WORD CCE JSB CVTOA AND CONVERT TO ASCII OCTAL LDB .OUTL PUT WORD IN OUTPUT LINE JSB .MBT DEF D6 NOP LDA .BLNK JSB .MBT DEF D1 FOLLOW IT BY A BLANK NOP STB .OUTL * CLA STA BCNT ISZ PTEM2 ISZ PTEM1 ARE WE OUT OF WORDS? RSS JMP PTW2 YES--BRANCH TO ADD ASCII ISZ PTEM3 DONE WITH 6 WORDS? JMP PTW1 NO--CONTINUE JMP PTW5 YES--ADD ASCII * PTW2 ISZ PTEM3 WAS THIS LAST OF 6 WORDS ALSO? RSS JMP PTW5 YES--JUST ADD ASCII PTW3 LDA D3 NO--PUT BLANKS IN LINE FOR CMA,INA EVERY WORD MISSING STA PTEM4 LDB .OUTL PTW4 LDA .BLNK JSB .MBT DEF D2 NOP ISZ PTEM4 JMP PTW4 LDA .BLNK AND A BLANK FOLLOWING EVERY WORD JSB .MBT DEF D1 NOP STB .OUTL ISZ BCNT BUMP REPLACED WORD COUNT ISZ PTEM3 AND REMAINING WORDS OUT OF 6 COUNT JMP PTW3 IF MORE, CONTINUE * PTW5 LDA .ASTK PUT AN ASTERISK IN LINE LDB .OUTL JSB .MBT DEF D1 NOP LDA .BLNK THEN ANOTHER BLANK JSB .MBT DEF D1 NOP STB .OUTL * LDA BCNT DETERMINE # OF WORDS OF OCTAL TO MOVE CMA,INA ADA D6 h CMA,INA MAKE # NEGATIVE & SAVE AS COUNTER STA BCNT ADA PTEM2 GET ADDRESS OF FIRST WORD TO MOVE STA PTEM3 PTW6 CCA SET FIRST BYTE COUNTER STA CNVNM LDA PTEM3,I GET NEXT WORD AND HIBYT GET FIRST BYTE ALF,ALF PUT IT INTO FIRST WORD OF REG. A PTW7 STA CNVAR SAVE FOR LATER ADA BM140 SEE IF IT FALLS WITHIN RANGE OF SSA,RSS PRINTABLE CHARACTERS JMP *+4 TOO LARGE--GET A BLANK ADA B100 SSA,RSS JMP *+3 LDA CHARS TOO SMALL--PICK UP A BLANK RSS LDA CNVAR JSB .SBT PUT BYTE INTO OUTPUT LINE ISZ CNVNM ON FIRST BYTE? JMP *+4 NO--BRANCH TO CHECK FOR NEXT WORD LDA PTEM3,I YES--GET 2ND BYTE IN WORD AND LOWBT AND DO SAME JMP PTW7 ISZ PTEM3 BUMP ADDRESS OF WORD IN BUFFER OR DATA ISZ BCNT ANY LEFT? JMP PTW6 YES--CONTINUE STB .OUTL NO--SET PLACE IN OUTPUT LINE JMP PTWDS,I AND RETURN SPC 2 HEADR ASC 7,REQUEST LOG ASC 7,REPLY LOG .RQST DBL HEADR .OUTL DBL CMLIN TIMHD ASC 4, TIME: .TMHD DBL TIMHD TIMAR EQU *-1 MS BSS 5 CNVAR BSS 3 CNVNM NOP .CNAR DBL CNVAR BLKCT NOP .TITL DBL *+1 ASC 7,STREAM WORD: ASC 7,SEQUENCE NO.: ASC 7,SOURCE NODE: ASC 7,DEST. NODE: .BTLE DBL *+1 ASC 4,HEADER: .DTLE DBL *+1 ASC 4,DATA: PTEMP EQU MS PTEM1 EQU MS+1 PTEM2 EQU MS+2 PTEM3 EQU MS+3 PTEM4 EQU MS+4 .LPAR DBL *+2 .RPAR DBR *+1 ASC 1,() CVTAB NOP DBR NATAB+9 DBL NATAB+7 DBR NATAB+4 DBR NATAB+3 DBR NATAB+1 DBL NATAB D14 DEC 14 D37 DEC 37 B100 OCT 000100 BM140 DEC -96 * SPC 2 * ROUTINE TO FILL REMAINDER OF OUTPUT LINE WITH BLANKS * ON ENTRY: * B->NEXT BYTE IN OUTPUT LINE * .CMLN = BYTE ADDRESS OF OUTPUT LINE * FBLNK NOP LDA .CMLN GET ADDRESS OF END OF OUTPUT LINE CMA,INA PLUS 1 IN NEGATIVE BYTES ADA M72 ADA B ADD TO CURRENT PLACE IN LINE STA FTEMP = NEG. # OF BLANKS TO MOVE SZA,RSS IF ZERO, WE ARE DONE JMP FBLNK,I FBLK1 LDA .BLNK MOVE BLANK TO LINE JSB .MBT DEF D1 NOP ISZ FTEMP DONE? JMP FBLK1 NO--REPEAT JMP FBLNK,I YES--RETURN SPC 2 FTEMP NOP SPC 2 * * ROUTINE TO CONVERT AN OCTAL NUMBER TO ASCII DECIMAL OR OCTAL * ON ENTRY: * A = VALUE TO CONVERT * E = 0, IF DECIMAL CONVERSION * 1, IF OCTAL CONVERSION * ON EXIT: * BCNT = BYTE LENGTH OF ASCII VALUE * A->FIRST BYTE IN ASCII STRING * * LEADING ZEROES ARE SUPPRESSED ON DECIMAL CONVERSION BUT NOT ON OCTAL * CONVERSION. * CVTOA NOP STA CNVNM SAVE VALUE IN CNUMD(O) CALL SEZ SEE WHICH TYPE OF CONVERSION WANTED JMP CVTA2 OCTAL--BRANCH TO IT SSA CMA,INA IF NEGATIVE, MAKE IT POSITIVE STA POSIT JSB CNUMD CALL CNUMD DEF *+1+2 RETURN ADDRESS DEF POSIT BINARY NUMBER DEF CNVAR RETURNED ASCII EQUIVALENT LDA .CNAR GET BYTE ADDRESS OF CONVERSION ARRAY LDB M6 GET BYTE LENGTH STB BCNT AND SAVE FOR NBLNK CALL JSB NBLNK FIND FIRST NON-BLANK CHARACTER JMP CVTA1 ALL BLANK--SUPPLY A ZERO NOP (SHOULDN'T HAPPEN) LDB BCNT CONVERT CHAR. COUNT TO POSITIVE CMB,INB STB BCNT AND RETURN LDB CNVNM CHECK NEGATIVE CNVNM SSB,RSS POSITIVE? JMP CVTOA,I .YES, RETURN ADA M1 .NO, ADD MINUS SIGN LDB 0 LDA DASH JSB .SBT LDA 1 ADA M1 ISZ BCNT JMP CVTOA,I * CVTA1 LDB .CNAR GET LAST BYTE IN CONVERSION ARRAY ADB D5 LDA .ZERO JSB .MBT DEF D1  MAKE IT AN ASCII ZERO NOP LDA D1 SET BCNT TO 1 STA BCNT LDA B GET ADDRESS OF ZERO BYTE ADA M1 JMP CVTOA,I AND RETURN * CVTA2 JSB CNUMO CALL CNUMO TO CONVERT TO ASCII OCTAL DEF *+1+2 RETURN ADDRESS DEF CNVNM BINARY VALUE DEF CNVAR RETURNED ASCII ARRAY LDA .CNAR GET BYTE ADDRESS OF CONVERSION ARRAY LDB M6 SET LENGTH TO -6 BYTES STB BCNT CVTA3 JSB IBLNK FIND ALL PRECEEDING BLANKS JMP CVTA4 LDB A AND CHANGE TO ZEROES LDA .ZERO JSB .MBT DEF D1 NOP LDA B JMP CVTA3 CVTA4 LDB D6 SET BCNT TO FULL 6 BYTE NUMBER STB BCNT LDA .CNAR GET ARRAY ADDRESS IN BYTES JMP CVTOA,I AND RETURN SPC 2 DASH ASC 1,-- POSIT NOP .ZERO DBL *+4 .COLN DBR *+3 .MNUS DBL *+3 .ASTK DBR *+2 ASC 2,0:-* SPC 2 * * HERE ON AN ERROR * EOCMD LDA .EOF GET EOF BEFORE EXIT COMMAND MESSAGE LDB D24 AND ITS LENGTH JSB TELL PRINT IT AND NOP JMP EXIT1 EXIT W/ SAVE PLERR LDA .PLER GET PLOG STILL RUNNING MESSAGE LDB D27 AND ITS LENGTH JSB TELL PRINT IT AND TERMINATE NOP JMP EXIT2 TLERR LDA .TLER GET 'TLOG ALREADY EXISTS MESSAGE LDB D27 AND ITS LENGTH JSB TELL PRINT IT AND TERMINATE NOP JMP EXIT1 COERR LDA .COER GET UNSUCCESSFUL COPY MESSAGE LDB D27 AND ITS LENGTH JSB TELL PRINT IT AND TERMINATE NOP JMP EXIT1 LUERR EQU * LDA =AIO DUMMY UP A EXEC ERROR CODE LDB =A02 DST EXER+13 DEFPR JSB EXEC DEF *+5 DEF NA2 DEF DEFLU PRINT ON DEFLU DEF EXER DEF D25 NOP JMP EXIT1 EXERR DST EXER+13 STORE EXEC ERROR CODES LDA .EXER GET EXEC ERROR MESSAGE LDB D25 AND ITS LENGTH, JSB TELL PRINT THE CODES AND TERMINATE JMP DEFPR IF ERROR ON LIST LU, TRY DEFLU JMP EXIT1 LOERR LDA .LOER LDB D18 JSB TELL NOP JMP EXIT1 * * ROUTINE TO PRINT OUT FILE ERRORS * ON ENTRY: * A = ERROR CODE * B -> FILE NAME * FIERR CMA,INA SET ERROR CODE POSITIVE STA TEMP LDA B PUT FILE NAME IN MESSAGE LDB .FIER ADB D14 JSB .MVW DEF D3 NOP JSB KCVT CONVERT ERROR CODE TO ASCII DEF *+1+1 DEF TEMP STA FIER+8 SET ERROR CODE IN MESSAGE LDA .FIER GET ADDRESS OF MESSAGE LDB D27 AND ITS LENGTH JSB TELL PRINT IT AND TERMINATE NOP JMP EXIT1 CMERR LDA .PTAB RESET PARAMETER TABLE ADDRESS STA .NEXT LDA .CMER GET THE COMMAND ERROR MESSAGE LDB D10 AND ITS LENGTH JSB TELL PRINT IT AND GO GET NEXT COMMAND JMP EXERR JMP COMMD PMERR LDA .PTAB RESET PARAMETER TABLE ADDRESS STA .NEXT LDA .PMER GET PARAMETER ERROR MESSAGE LDB D16 AND ITS LENGTH JSB TELL PRINT IT AND GO GET NEXT COMMAND JMP EXERR JMP COMMD BAERR LDA .BAMS GET TOO MANY UNBALANCED MESSAGE LDB D16 AND ITS LENGTH JSB TELL PRINT IT CCA STA HALT SET HALT FLAG JMP BAC1 AND LET FBLCK END BALANCE COMMAND SPC 2 * * ERROR MESSAGES * PLER ASC 27, ** MT LOG AND PLOG STILL RUNNING -- TLOG TERMINATING .PLER DEF PLER LOER ASC 18, ** BAD LOG FILE -- TLOG TERMINATING .LOER DEF LOER EXER ASC 25, ** EXEC OR DEXEC ERROR: -- TLOG TERMINATING .EXER DEF EXER FIER ASC 27, ** FMP ERROR - ON FILE: -- TLOG TERMINATING .FIER DEF FIER CMER ASC 10, ** ILLEGAL COMMAND .CMER DEF CMER TLER ASC 27, ** TLOG CANNOT CREATE NEEDED FILE -- OLD 'TLOG EXISTS. .TLER DEF TLER COER ASC 27, ** UNABLE TO COPY 'PLOYG TO 'TLOG -- TLOG TERMINATING .COER DEF COER PMER ASC 16, ** ILLEGAL OR MISSING PARAMETER .PMER DEF PMER EOFMS ASC 24, ** EOF BEFORE EXIT COMMAND -- EXITING WITH SAVE. .EOF DEF EOFMS CMMSG ASC 20, REQUEST/REPLY BUFFERS QUALIFIED .CMSG DEF CMMSG BAMSG ASC 16, ** OVER 10 UNBALANCED REQUESTS .BAMS DEF BAMSG SPC 2 * * TLOG WORK AREAS AND CONSTANTS * D2 DEC 2 DECIMAL CONSTANTS D8 DEC 8 D16 DEC 16 D24 DEC 24 D25 DEC 25 D27 DEC 27 PTAB BSS 7 .PTAB DEF PTAB .NEXT DEF PTAB PROMT ASC 4,TLOG? _ PRMT? NOP INTERACTIVE LU FLAG LEN NOP TTYPE NOP COPY OF #TYPE STAT NOP STATUS WORD FOR EXEC CALLS BCNT NOP BUFFER COUNT RQCNT NOP SIZE NOP BLOCK SIZE OF LOG FILE RECSZ DEC 96 LOG RECORD SIZE, INITIALLY 96 WORDS CURNT NOP CURRENT RECORD # LAST NOP LAST RECORD # FOR WINDOWS WLAST NOP HALT NOP .BFAD DEF BUFFR .DAAD DEF BUFFR+3+#MXR+#LSZ BUFFR BSS 128 LOG BUFFER STORAGE AREA BSS 0 END TLOG F p* 91750-18178 2013 S C0122 &TRC3K              H0101 pASMB,Q,C HED PRINT TRACE OF DS/3000 LOG * (C) HEWLETT-PACKARD CO. NAM TRC3K,4,90 91750-16178 REV.2013 800604 MEF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: TRC3K *SOURCE: 91750-18178 * RELOC: 91750-16178 * PGMR: DMT LST ************************** TRC3K ************************* * * * SOURCE: 91750-18178 * * * * BINARY: 91750-16178 * * * * PROGRAMMER: DAVE TRIBBY * * * * OCTOBER 13, 1978 * * * ************************************************************** SPC 1 EXT NAMR,IFTTY,IFBRK,.DFER,#PKUP EXT EXEC,CNUMD,KCVT,CNUMO,REIO,TMVAL EXT OPEN,READF,WRITF,POSNT,RWNDF,CLOSE * A EQU 0 A-REGISTER B EQU 1 B-REGISTER SUP SKP * TRC3K JSB #PKUP PICK UP PARAMETERS DEF *+4 DEF PMASK DEF NCMDI DEF DEFLU SPC 1 * * PROCESS FIRST PARAMETER--COMMAND INPUT * GTCMI LDA @CMDI JSB OPNDV OPEN THE COMMAND DEVICE. DEF CMDIN JMP GTRCI NORMAL RETURN...GET TRACE INPUT. LDA DEFLU ERROR RETURN...USE DEFAULT LU. LDB M@CMDI STA B,I CLA CLEAR OTHER NAMR WORDS. INB STA B,I INB STA B,I INB STA B,I JMP GTCMI SPC 1 * * PROCESS SECOND PARAMETER--LOGGING INPUT * GTRCI CLA,INA SET RECORD STA RECNO NUMBER TO 1. LDA @TRCI JSB OPNDV OPEN THE TRACE INPUT DEVICE. DEF TRCIN JMP CHKFL NORMAL RETURN...CHECK FILE TYPE. PRTCI JSB ERMSG PROMPT FOR TRACE INPUT. DEF TIPRM DEC -15 LDA DEFLU SET "ECHO IOR B600 INPUT" STA TEMP BIT. JSB REIO READ FROM DEFAULT LU. DEF *+5 DEF SD1 DEF TEMP DEF INBUF DEF D40 JMP EXCMD ON ERROR, TERMINATE. CLE,ELB STB INLEN SAVE NO OF CHARACTERS. CLA,INA RESET PARSE STA PNTR POINTER. JSB PNAMR PARSE INTO TRACE INPUT ARRAY. LDA NAME,I IF NEGATIVE SSA VALUE ENTERED, JMP EXCMD TERMINATE! JMP GTRCI OPEN IT. * MAKE SURE LOGGING INPUT ISN'T A FIXED LENGTH FILE CHKFL LDA TRCIN IF IT'S NOT CPA "FI" A FILE, RSS IT'S OK. JMP GTROT LDA ERROR GET FILE TYPE FROM OPEN. CPA D1 TYPE = 1? JMP FIXDL YES...ERROR. CPA D2 TYPE = 2? JMP FIXDL YES...ERROR. JMP GTROT NOT TYPE 1 OR 2, SO IT'S OK. FIXDL JSB ERMSG PRINT ERROR DEF BADTY MESSAGE FOR DEC 15 BAD FILE TYPE. JSB CLOSE CLOSE THE DEF *+2 FILE. DEF TRCIN+1 JMP PRTCI GET NEW FILE NAME. SPC 1 * * PROCESS THIRD PARAMETER--TRACE OUTPUT * GTROT JSB OPNTO SPC 1 * PRINT HEADING... JSB PRINT DEF HEAD1 DEC 25 SPC 1 * JSB PRINT PRINT DEF BLANK BLANK D1 DEC 1 LINE. * * SET FORMAT AND PRINTING DEFAULTS.  LDA DEFFG SET HEADING STA PRFLG AND DRIVER BITS. RESTO CCA SET OTHER OPTIONS OFF. STA !CLAS STA !EREC STA !RTE# STA !SREC STA !STRM * *** MAIN LOOP FOR COMMAND PROCESSING BEGINS HERE *** COMMD LDA DN6 SET 0-LEN COUNTER STA L0CNT TO SIX. COMD1 JSB READ READ COMMAND. DEF "?" (PROMPT) D4 DEC 4 SZB,RSS IF 0-LEN RECORD, JMP LEN0 CHECK FOR 6 IN A ROW. SSB IF NEGATIVE LENGTH, JMP EXCMD ALL DONE. CMB,INB SAVE NEGATIVE NUMBER OF STB BCNT CHARACTERS FOR COUNTER. * LDA .CMLN GET BYTE ADDRESS OF COMMAND. JSB NBLNK FIND FIRST NON-BLANK CHARACTER. JMP CMERR ALL BLANK COMMAND--ERROR JMP CMERR CHARACTER LT A BLANK--ERROR STA CMSAV LDY D6 CHAR > BLANK--OK, SET UP INDEX FOR LDB .CLEN COMMAND SEARCH & GET ADDRESS OF LENGTH STB TBLN OF NEXT COMMAND TABLE AND SAVE. LDB .CMTB GET BYTE ADDRESS OF COMMAND TABLE JSB SERCH AND PERFORM SEARCH JMP CMERR ERROR RETURN SPC 2 * * COMMAND WORD OK--NOW GET PARAMETERS * CLA ZERO PARAMETER COUNT STA FICNT LDA .PTAB RESET PARAMETER STA .NEXT TABLE ADDRESS LDA .ETAB RESET END STA .NXTE TABLE ADDR. LDA CMSAV GET ADDRESS OF COMMAND GTPAR JSB IBLNK FIND NEXT BLANK OR COMMA JMP RTAB1 NONE--JUMP TO COMMAND ROUTINE STA .NXTE,I SAVE ENDING ADDRESS. ISZ .NXTE JSB NBLNK FIND NEXT NON-DELIMITING CHARACTER. JMP RTAB2 NONE--JUMP TO COMMAND ROUTINE. JMP PMERR LT--ILLEGAL CHARACTER STA .NEXT,I GT--IT'S POSSIBLE SAVE PARAM ADDR. ISZ .NEXT AND INCREMENT TABLE ADDRESS ISZ FICNT INCREMENT PARAMETER COUNT LDB FICNT MAKE SURE NO MORE THAN MAX CPB MXPRM JMP PMERR MORE--AN ERROR JMP GTPAR OK--CONTINUE SEARCH SPC 2 * * HERE ON END OF PARSE. COMMAND ROUTINE TABLE. * RTAB1 STA .NXTE,I SAVE LAST END POINTER. ISZ .NXTE RTAB2 JPY RTAB3 YES--JUMP TO COMMAND ROUTINE RTAB3 EQU *-1 JMP HECMD ?? (HELP) COMMAND ROUTINE JMP EXCMD EXIT COMMAND ROUTINE JMP FOCMD FORMAT COMMAND ROUTINE JMP LICMD LIST COMMAND ROUTINE JMP PRCMD PRINT COMMAND ROUTINE JMP SECMD SET COMMAND ROUTINE SPC 3 * * HERE WHEN 0-LENGTH RECORD IS READ. BUMP COUNTER (INITIALIZED TO -6). * WHEN IT ROLLS OVER, TERMINATE THE PROGRAM. * LEN0 ISZ L0CNT JMP COMD1 JMP EXCMD SPC 5 * * DATA AREA FOR COMMAND PARSING * CMTB ASC 12,SETPRINTLISTFORMATEXIT?? .CMTB DBL CMTB * COMMAND LENGTHS (BYTES) IN REVERSE ORDER-- .CLEN DEF * D2 DEC 2 DEC 4 DEC 6 DEC 4 D5 DEC 5 D3 DEC 3 * L0CNT NOP CMSAV NOP .CMLN DBL INBUF BCNT NOP FICNT NOP RECNO NOP "?" ASC 4,/TRC3K:_ * SPC 3 * * ERRORS-- * PMERR JSB ERMSG REPORT DEF PMER PARAMETER DEC 17 ERROR. JMP COMMD GET NEXT COMMAND. PMER ASC 17,** ILLEGAL OR MISSING PARAMETER ** * CMERR JSB ERMSG REPORT DEF CMER ILLEGAL DEC 11 COMMAND. JMP COMMD GET NEXT ONE. CMER ASC 11,** ILLEGAL COMMAND ** SKP * * ROUTINE TO FIND NEXT BLANK, COMMA, OR EQUAL SIGN IN STRING * ON ENTRY: * A->STRING (BYTE ADDRESS) * BCNT = -(# CHARACTERS IN STRING) * ON EXIT: * A->NEXT BLANK, COMMA, OR EQUAL SIGN (IF ANY) IN STRING * RETURN POINTS = * IBLNK,I IF NO BLANKS, COMMAS, OR EQUAL SIGNS * IBLNK,I+1 IF BLANK OR COMMA FOUND * IBLNK NOP IBL1 LDB .BLNK GET ADDRESS OF CHAR. BLANK CBT D1 COMPARE BYTE JMP IBL3 EQ--RETURN+1 JMP IBL2 LT--CONT(INUE SEARCH LDB .COMA GT--SEE IF COMMA CBT D1 JMP IBL3 EQ--RETURN+1 JMP IBL2 LT--CONTINUE SEARCH LDB .EQSN GT--SEE IF AN EQUAL SIGN CBT D1 JMP IBL3 EQ--RETURN+1 NOP LT, OR GT,--CONTINUE SEARCH IBL2 INA GET NEXT CHAR. IN STRING ISZ BCNT DECREMENT LENGTH JMP IBL1 JMP IBLNK,I END-OF-STRING--RETURN IBL3 ADA DN1 ISZ IBLNK INCREMENT RETURN JMP IBLNK,I POINT AND RETURN SPC 2 * * ROUTINE TO FIND NEXT CHARACTER THAT IS NOT A BLANK, COMMA, OR * EQUAL SIGN * ON ENTRY: * A->STRING (BYTE ADDRESS) * BCNT = -(# CHARACTERS IN STRING) * ON EXIT: * A->CHAR. OTHER THAN BLANK, COMMA, OR EQUAL SIGN (IF FOUND) * RETURN POINTS = * NBLNK,I IF ALL BLANK(S), COMMA(S), OR EQUAL SIGN(S) * NBLNK,I+1 IF CHARACTER LT A BLANK * OR LT A COMMA AND GT A BLANK * NBLNK,I+2 IF CHARACTER GT A COMMA * NBLNK NOP NBL1 LDB .BLNK GET BLANK CHAR. ADDRESS CBT D1 DO COMPARISON JMP NBL2 EQ--TRY NEXT JMP NBL4 LT--RETURN+1 LDB .COMA GT--SEE IF A COMMA CBT D1 JMP NBL2 EQ--TRY NEXT JMP NBL4 LT--RETURN+1 LDB .EQSN GT--SEE IF AN EQUAL SIGN CBT D1 JMP NBL2 EQ--TRY NEXT NOP JMP NBL3 LT, OR GT,--RETURN+2 NBL2 ISZ BCNT DECREMENT STRING LENGTH JMP NBL1 AND CONTINUE SEARCH JMP NBLNK,I END OF STRING--RETURN NBL3 ISZ NBLNK RETURN+2 NBL4 ISZ NBLNK RETURN+1 JMP NBLNK,I SPC 2 * * ROUTINE TO SEARCH FOR COMMAND OR KEYWORD IN TABLE * ON ENTRY: * A->BYTE IN STRING FOR COMPARISON * B->COMMAND OR KEYWORD TABLE * TBLN->COMMAND OR KEYWORD LENGTHS TABLE * Y=# OF COMMANDS OR KEYWORDS IN TABLE * ON EXIT: * A->LAST CHARACTER IN STRING COMPARED * Y=INDEX FOR COMMAND, IF FOUND, ELSE 0 * RETURN POINTS = * SERCH,I IF WORD IN STRING DOES NOT MATCH A COMMAND * OR KEYWORD * SERCH,I+1 IF MATCH FOUND * SERCH NOP SRCH1 STA VALUE STB SESCR SAVE COMMAND TABLE ADDRESS TEMPORARILY LBY TBLN,I GET LENGTH FOR COMPARISON STB CMPLN LDB SESCR PICK BACK UP THE TABLE ADDRESS CBT CMPLN DO COMPARISON JMP SRCH2 SAME--RETURN+1 NOP LT--AN ABBREVIATION? STB SESCR SAVE PLACE IN COMMAND TABLE TEMPORARILY LDB .BLNK GET BYTE ADDRESS OF CHAR. BLANK CBT D1 COMPARE BLANK AND BYTE IN COMMAND STRING JMP SRCH2 EQ--AN ABBREVIATION, RETURN+1 JMP SERCH,I LT--ILLEGAL CHAR., ERROR RETURN LDB .COMA GT--SEE IF CHAR. A COMMA CBT D1 JMP SRCH2 EQ--AN ABBREVIATION JMP SERCH,I LT--ILLEGAL CHAR, ERROR RETURN LDB .EQSN GT--SEE IF CHAR. AN EQUAL SIGN CBT D1 JMP SRCH2 EQ--AN ABBREVIATION JMP SERCH,I LT--ILLEGAL CHAR, ERROR RETURN DSY GT--CHECK NEXT CMMD OR KEYWORD RSS IN TABLE IF ANY LEFT JMP SERCH,I NO MORE, ERROR RETURN LDA VALUE LDB SESCR JMP SRCH1 ELSE, TRY AGAIN SRCH2 ISZ SERCH JMP SERCH,I SPC 2 CHARS ASC 2, ,= BLANK EQU CHARS .BLNK DBL CHARS .COMA DBL CHARS+1 .EQSN DBR CHARS+1 CMPLN NOP TBLN NOP VALUE NOP SESCR NOP SKP * * ?? (HELP) COMMAND ROUTINE * HECMD EQU * LDA TRCOT IF TRACE OUTPUT SSA,RSS IS NOT INTERACTIVE, JMP COMMD SKIP COMMAND. JSB PRINT PRINT DEF CMLST COMMAND ABS CMLND-CMLST LIST. JMP COMMD RETURN TO PROMPT. * CMLST ASC 14, COMMAND DESCRIPTION BYT 15,12 ASC 15, ?? DISPLAY COMMANDS BYT 15,12 ASC 11, EXIT A END TRC3K BYT 15,12 ASC 19, FORMAT SET OUTPUT LISTING FORMAT BYT 15,12 ASC 12, LIST SET LISTING BYT 15,12 ASC 18, PRINT PRINT SELECTED BUFFERS BYT 15,12 ASC 20, SET LIMIT RECORDS TO BE PRINTED BYT 15,12 CMLND EQU * SKP * * PRINT COMMAND ROUTINE * PRCMD EQU * LDA .PTAB ANY PARAMETER GIVEN? CPA .NEXT JMP PRNXT NO--DEFAULT TO NEXT. LDB .PRLN CHECK KEYWORD. STB TBLN LDY D3 LDB .PRKY LDA A,I JSB SERCH JMP PMERR LDA .PTAB ONLY PARAMETER GIVEN? INA CPA .NEXT JPY PRTAB YES. GO DO IT. JMP PMERR NO. ERROR. * PRTAB EQU *-1 JMP PRNXT JMP PRFIR JMP PRALL * * PRINT FIRST RECORD PRFIR JSB RWTRI POSITION TO FIRST RECORD. * PRNXT JSB PBUFR PRINT NEXT QUALIFYING BUFFER. JMP NOQAL EOF: PRINT WARNING. JMP COMMD * NOQAL JSB PRINT PRINT THE DEF QALMS "NONE QUALIFIED" DEC 10 WARNING. JMP COMMD GET NEXT COMMAND. QALMS ASC 10,** NONE QUALIFIED ** * PRALL JSB RWTRI REWIND FILE TO START RECORD. JSB PBUFR PRINT NEXT QUALIFYING BUFFER. JMP COMMD NO MORE--END OF COMMAND JMP PRALL+1 GET NEXT BUFFER. SPC 2 PRKEY ASC 6,ALLFIRSTNEXT .PRKY DBL PRKEY .PRLN DEF * DEC 4 DEC 5 DEC 3 SKP * SUBROUTINE TO POSITION TRACE INPUT TO STARTING RECORD. * CALLING SEQUENCE: JSB RWTRI * RWTRI NOP ENTRY. LDA !SREC GET STARTING RECORD. SZA IF ZERO SSA OR NEGATIVE, CLA,INA USE 1. STA DRECN STORE FOR POSITIONING. * LDA RECNO CALCULATE DIFFERENCE CMA,INA BETWEEN CURRENT ADA DRECN POSITION AND STA CNTR DESTINATION. SZA,RSS IF CURRENTLY THERE, JMP RWTRI,I RETURN. * LDB TRCIN IF TRACE INPUT CPB "FI" IS FROM A FILE, JMP RWFIL GO POSITION IT. * LDA TRCIN SET UP EXEC AND B77 CONTROL WORD IOR STCOD FOR I/O STATUS. STA STWRD * SSA IF COUNTER < 0, JMP BSPAC IT'S A BACKWARD SPACE. * CMA,INA MAKE COUNTER STA CNTR NEGATIVE. LDA TRCIN+1 SET UP AND B77 CONWD FOR IOR FSCOD FORWARD SPACE. STA CONWD * SPCMT JSB EXEC FORWARD/BACKWARD DEF *+3 SPACE DEF SD3 ONE DEF CONWD RECORD. JMP TIER ERROR. JSB EXEC CHECK FOR DEF *+3 DYNAMIC DEF SD3 STATUS DEF STWRD EOF. JMP TIER AND B240 SZA JMP EOFER EOF--WARN USER. ISZ CNTR BUMP COUNTER. JMP SPCMT STAY IN LOOP UNTIL DONE. JMP RWRTN GO TO RETURN. * BSPAC LDA TRCIN+1 SET UP AND B77 CONWD FOR IOR BSCOD BACKSPACE. STA CONWD JMP SPCMT GO POSITION IT. * * WARN USER OF END-OF-FILE ENDOF ASC 9,** END OF FILE ** EOFER JSB ERMSG DEF ENDOF DEC 9 RSS PRINT RECORD NUMBER. * * REPORT ERROR POSITIONING TRACE INPUT FROM LU. TIER JSB RTERR PRINT A- & B-REG. LDA DRECN CALCULATE ADA CNTR ACTUAL RECORD STA RECNO NUMBER. JSB CNUMD CONVERT DEF *+3 TO DEF RECNO ASCII DEF FRMCP+3 (DECIMAL). JSB ERMSG PRINT. DEF FRMCP DEC 6 JMP RWTRI,I RETURN. * * RWFIL JSB POSNT POSITION FILE. DEF *+4 DEF TRCIN+1 DEF ERROR DEF CNTR LDA ERROR IF ERROR, SSA,RSS JMP RWRTN LDB @TRCI POINT TO TRACE INPUT STB NAME JSB FILER AND REPORT ERROR. JSB RWNDBF REWIND DEF *+2 TRACE INPUT. DEF TRCIN+1 CLA,INA SET RECORD STA RECNO NUMBER = 1. CCA SET STARTING STA !SREC REC TO DEFAULT. JMP RWTRI,I RETURN. * RWRTN LDA DRECN SET RECORD STA RECNO NUMBER. JMP RWTRI,I RETURN. DRECN NOP CONWD NOP STWRD NOP FSCOD OCT 300 FORWARD SPACE CODE FOR EXEC. BSCOD OCT 200 BACKSPACE CODE FOR EXEC. STCOD OCT 600 DYNAMIC STATUS CODE FOR EXEC. CNTR NOP SD3 DEF 3,I B77 OCT 77 B240 OCT 240 SKP * * FORMAT COMMAND ROUTINE * FOCMD EQU * LDA .PTAB GET PARAMETER POINTER. CPA .NEXT NONE? JMP FODEF USE DEFAULT. LDB FICNT MAKE SURE ADB DN3 ONLY TWO SSB,RSS PARAMETERS JMP PMERR WERE GIVEN. * LDA A,I LDB .FOLN STB TBLN LDY D4 LDB .FOKY JSB SERCH SEARCH FOR FORMAT TYPE. JMP PMERR (ERROR.) JPY FOTAB SET OPTION BIT. OPT2 LDA .PTAB IF ONLY ONE INA OPTION CPA .NEXT PROVIDED, JMP COMMD DONE. * CHECK OUT SECOND PARAMETER (MUST BE DRIVER). LDA A,I POINT TO 2ND PARAMETER. LDY D4 LDB .FOKY JSB SERCH SEARCH. JMP PMERR NOT FOUND--ERROR. CYA IF NOT CPA D3 THIRD IN RSS TABLE, JMP PMERR ERROR. LDA PRFLG ADD DRIVER IOR DRVFG FLAG TO STA PRFLG PRINT OPTIONS. JMP COMMD GET NEXT COMMAND. FOTAB EQU *-1 JMP FOAPP JMP FODAT JMP FODRV JMP FOHED * FOAPP LDA APPFG SET APPENDAGE BITS STA PRFLG JMP OPT2 * FODAT LDA DATFG SET DATA BITS STA PRFLG JMP OPT2 * FODRV LDA DRVFG SET DRIVER BIT STA PRFLG JMP OPT2 * FOHED LDA HEDFG SET HEADING BIT STA PRFLG = JMP OPT2 * FODEF LDA DEFFG DEFAULT--SET HEADING AND DRIVER BITS STA PRFLG JMP COMMD SPC 2 FOKEY ASC 13,HEADERDRIVERDATAAPPENDAGE .FOKY DBL FOKEY .FOLN DEF * DEC 9 DEC 4 DEC 6 DEC 6 * FLAGS FOR TYPE OF PRINTING: HEDFG OCT 1 APPFG OCT 3 DATFG OCT 7 DRVFG OCT 10 DEFFG OCT 11 * BIT POSITIONS: HEBIT EQU HEDFG APBIT OCT 2 DABIT OCT 4 DRBIT EQU DRVFG PRFLG NOP LISTING FLAG SKP * * LIST COMMAND ROUTINE * LICMD LDA FICNT MAKE SURE CPA D1 ONLY ONE PARAMETER RSS WAS PROVIDED. JMP PMERR * CALCULATE COLUMN NUMBER OF PARAMETER. LDA .CMLN SUBTRACE BYTE ADDRESS CMA,INA OF COMMAND START FROM ADA PTAB PARAMETER POSITION. INA ADD 1 AND SAVE AS STA PNTR NAMR POINTER. LDA @TRCO CALL NAMR STA NAME FOR PARSE INTO JSB PNAMR TRACE OUTPUT AREA. JSB OPNTO OPEN IT UP. * JMP COMMD GET NEXT COMMAND. SKP * * SET COMMAND ROUTINE * SECMD LDA .PTAB GET POINTER TO KEYWORD ADDRESS CPA .NEXT WAS IT SPECIFIED? JMP CUOPT NO--PRINT CURRENT OPTIONS. STA SETAB YES--SAVE ADDRESS FOR LATER LDB FICNT CPB D1 IF ONE PARAM, JMP CHK@ CHECK FOR "@". SLB EVEN NUMBER OF PARAMETERS? JMP PMERR NO--ERROR. * LDA .ETAB SET INA LOCAL STA ENPTR END POINTER. CLE,ERB SET UP NEG. CMB,INB COUNTER FOR STB PCNTR VALUES. * SLOOP LDA SETAB,I GET: KEYWORD ADDRESS, LDY D5 # OF LEGAL KEYWORDS, LDB .SKYL ADDR OF KEYWORD LENGTHS TABLE, STB TBLN AND LDB .SKEY ADDR OF KEYWORD TABLE JSB SERCH DO COMPARISON OF KEYWORDS JMP PMERR NO MATCH--INFORM USER OF ERROR * * STY CMDNO SAVE COMMAND NUMBER. ISZ SETAB LDA .CMLN CALCULATE START CMA,INA COLUMN OF ADA SETAB,I VALUE. INA STA PNTR STORE NAMR'S PNTR. ISZ ENPTR LDA .CMLN CALCULATE LAST CMA,INA COLUMN OF ADA ENPTR,I VALUE. INA STA INLEN STORE LENGTH. LDA @PARM CALL NAMR STA NAME FOR PARSE JSB PNAMR INTO "PARM". CPA "@" IF "@" SPECIFIED, JMP USDEF USE THE DEFAULT. SSA IF NEGATIVE, JMP PMERR ERROR! LDY CMDNO IS VALUE JPY CHKTB IN BOUNDS? * USDEF CCA,RSS SET TO -1 TO DEFAULT. CKRTN LDA PARM WITHIN BOUNDS-- SAY !VALU STORE VALUE. LDA CMDNO IF STARTING RECORD CPA D4 WAS RESET, JSB RWTRI REWIND TRACE INPUT. ISZ SETAB BUMP ISZ ENPTR POINTERS. ISZ PCNTR MORE? JMP SLOOP YES! STAY IN LOOP. JMP COMMD NO--GET NEXT COMMAND. * * ROUTINES TO CHECK WHETHER VALUES ARE WITHIN BOUNDS. * * CHECK MESSAGE CLASS CCLAS ADA DN9 IF CLASS IS SSA,RSS < 8, JMP PMERR ERROR! JMP CKRTN * * CHECK ENDING RECORD CEREC LDB !SREC IF STARTING REC SSB NOT SPECIFIED, JMP CKRTN OK. CMB,INB SUBTRACT END ADA B FROM START. SSA IF < 0, JMP PMERR ERROR. JMP CKRTN * * CHECK RTE NUMBER CRTE# AND HB377 IF > 255, SZA JMP PMERR ERROR. JMP CKRTN * * CHECK STARTING RECORD CSREC LDB !EREC IF ENDING REC SSB NOT SPECIFIED, JMP CKRTN OK. CMA,INA SUBTRACT START ADA B FROM END. SSA IF < 0, JMP PMERR ERROR. JMP CKRTN * * CHECK STREAM CSTRM ADA DN4 CONVERT FROM STA NAME^,I DECIMAL TO OCTAL. ADA BN20 IF < OCTAL 20, SSA JMP PMERR ERROR. ADA BN10 IF > OCTAL 27, SSA,RSS JMP PMERR ERROR. JMP CKRTN * * TABLE OF PARAMETER CHECK ROUTINES CHKTB EQU *-1 JMP CCLAS JMP CEREC JMP CRTE# JMP CSREC JMP CSTRM * * * ONE PARAMETER GIVEN. IF "@", RESET ALL. CHK@ LDA .CMLN CALCULATE START CMA,INA COLUMN OF ADA .PTAB,I PARAMETER. INA STA PNTR STORE NAMR'S PNTR. LDA @PARM CALL NAMR STA NAME FOR PARSE JSB PNAMR INTO "PARM". CPA "@" IF "@" SPECIFIED, JMP RESTO GO RESET ALL. JMP PMERR OTHERWISE, ERROR. * * * NO PARAMETER GIVEN. PRINT CURRENT OPTIONS. CUOPT LDA !CLAS CONVERT CLASS. SSA IF NEGATIVE, JMP NCLS USE "@". JSB CNUMO CONVERT TO DEF *+3 ASCII OCTAL. DEF !CLAS DEF ASCII DLD ASCII+1 STCLS DST OCLAS * LDA !STRM CONVERT STREAM. SSA JMP NSTM AND D7 IOR "20" STSTM STA OSTRM * LDA !RTE# CONVERT RTE NUMBER. SSA JMP NRT# JSB CNUMD DEF *+3 DEF !RTE# DEF ASCII DLD ASCII+1 STRT# DST ORTE# * LDA !SREC CONVERT STARTING RECORD. SSA JMP NSRC JSB CNUMD DEF *+3 DEF !SREC DEF OSREC * TSTER LDA !EREC CONVERT ENDING RECORD. SSA JMP NERC JSB CNUMD DEF *+3 DEF !EREC DEF OEREC * PROPT JSB PRINT PRINT DEF OPTNS THE ABS OPEND-OPTNS OPTIONS. JMP COMMD GET NEXT COMMAND. * * USE "@" WHEN CLASS, STREAM, OR RTE# NOT PROVIDED... NCLS LDB "@" LDA BLANK JMP STCLS NSTM LDA "@" JMP STSTM NRT# LDB "@" LDA BLANK JMP STRT# NSRC JSB .DFER DEF OSREC DE!,F "FRST JMP TSTER "FRST ASC 3, FIRST NERC JSB .DFER DEF OEREC DEF "LAST JMP PROPT "LAST ASC 3, LAST * OPTNS ASC 3,CLASS= OCLAS ASC 7,XXXX STREAM= OSTRM ASC 6,XX RTE NO.= ORTE# ASC 7,XXXX RECORDS OSREC ASC 5,XXXXXX TO OEREC ASC 3,XXXXXX OPEND EQU * * SETAB NOP * OPTIONS: !VALU EQU *-1 !CLAS NOP DS/3000 MESSAGE CLASS. !EREC NOP ENDING RECORD. !RTE# NOP RTE PROCESS NUMBER. !SREC NOP STARTING RECORD. !STRM NOP DS/3000 MESSAGE STREAM. SKEYT ASC 15,STREAMSTARTRECRTENOENDRECCLASS .SKEY DBL SKEYT .SKYL DEF * DEC 5 DEC 6 DEC 5 DEC 8 DEC 6 * @PARM DEF PARM PARM BSS 10 "@" ASC 1,@ "20" ASC 1,20 CMDNO NOP COMMAND NUMBER PCNTR NOP PARAMETER COUNTER ENPTR NOP END TABLE POINTER SKP SKP ** EXIT COMMAND ** EXCMD JSB CLOSE CLOSE ALL FILES. DEF *+2 DEF CMDIN+1 JSB CLOSE DEF *+2 DEF TRCIN+1 JSB CLOSE DEF *+2 DEF TRCOT+1 * JSB EXEC TERMINATE. DEF *+2 DEF D6 SPC 2 HEAD1 ASC 10, ASC 15,***** DS/1000-3000 TRACE ***** SPC 4 * SUBROUTINE TO CHECK WHETHER USER WANTS TO "BREAK" * CALLING SEQUENCE: JSB BRCHK * * BRCHK NOP ENTRY. JSB IFBRK IF BREAK DEF *+1 FLAG IS SSA,RSS SET, JMP BRCHK,I * JSB READ ASK: DEF CONT? CONTINUE? DEC 5 LDA INBUF GET RESPONSE. CPA "NO" IF NO, JMP COMMD GET NEXT COMMAND. * JMP BRCHK,I OTHERWISE, RETURN. * CONT? ASC 5,CONTINUE?_* SKP ** SUBROUTINE TO PRINT NEXT QUALIFYING BUFFER ** PBUFR NOP ENTRY. RDREC JSB BRCHK CHECK FOR USER'S BREAK. LDA !EREC ENDING RECORD SSA SPECIFIED? JMP DOGET NO--GET_ RECORD. INA CMA,INA ADA RECNO CURRENT RECORD CMA,SSA < ENDING? JMP PBUFR,I NO--EOF RETURN. * DOGET JSB GETRC READ A TRACE RECORD. SZB IF LENGTH IS SSB <= 0, JMP PBUFR,I TAKE EOF RETURN. * LDB INBUF GET FIRST WORD. SSB,RSS IF >= 0, JMP RQRP REQUEST OR REPLY. LDA PRFLG IS DRIVER BIT AND DRBIT SET IN PRINT SZA,RSS FLAG? JMP RDREC NO--READ AGAIN. CPB DN1 -1? JMP EVTRC YES--EVENT TRACE. CPB DN2 -2? JMP LTSTS YES--LONG TERM STATS. SPC 1 * REPORT BAD TRACE FILE LGFER JSB ERMSG PRINT MESSAGE. DEF BADLG DEC 12 JMP EXCMD TERMINATE. * BADLG ASC 12,** BAD LOGGING RECORD ** SPC 2 * PRINT LONG TERM STATISTICS * LTSTS JSB PRINT PRINT DEF BLANK BLANK DEC 1 LINE. * CCA ADA RECNO STA TEMP JSB CNUMD PUT RECORD DEF *+3 NUMBER IN DEF TEMP HEADING. DEF SHEAD+3 JSB PRINT PRINT DEF SHEAD HEADING. DEC 20 LDA DN11 SET UP COUNTER STA CNT1 FOR 11 LINES. LDA @WRD2 INITIALIZE ADA DN1 STA VPNT VALUE POINTER. LDA MSGTB INITIALIZE STA MPNT MESSAGE POINTER. LDA D14 SET OUTPUT STA BUMP BUMP TO 14. * LOOPA LDA AW3 SET OUTPUT STA OPNTR POINTER. LDA BLANK CLEAR JSB FILL BUFFER. * LOOPB ISZ VPNT BUMP STAT POINTER. LDA MPNT,I GET # OF STA CNT2 CHARACTERS. ISZ MPNT LDA MPNT MESSAGE SOURCE ADDR. LDB OPNTR MESSAGE DESTINATION FIELD. ADB D3 MVW CNT2 MOVE MESSAGE. STA MPNT POINT TO NEXT MESSAGE. LDB VPNT,I CONVERT THE JSB TO10 VALUEf. ISZ CNT1 LAST MESSAGE? RSS JMP LPRNT YES--GO DO LAST PRINT. LDA OPNTR IF PRINTLINE CPA AW17 NOT FULL, JMP LOOPB MOVE 2ND MESSAGE. * JSB PRINT PRINT DEF BUFR MESSAGES. DEC 30 JMP LOOPA NO--STAY IN LOOP. SPC 1 LPRNT JSB PRINT PRINT DEF BUFR FINAL D14 DEC 14 STATISTIC. * JSB PRINT PRINT DEF BLANK BLANK DEC 1 LINE. * JMP GDRTN TAKE "GOOD" RETURN. SKP * PRINT EVENT TRACE * EVTRC LDB D4 SET PRINT STB BUMP BUMP TO 4. * LDB @WRD6 B:=FIRST ENTRY ADDRESS. STB BPNTR LDA @INBF CALCULATE ADA TRCLN LAST ENTRY STA @EOR ADDRESS. * CCA ADA RECNO STA TEMP JSB CNUMD PUT RECORD DEF *+3 NUMBER IN DEF TEMP HEADING. DEF FRMCP+3 JSB PRINT PRINT DEF FRMCP IT. DEC 6 * LOOP LDA BLANK CLEAR JSB FILL PRINTLINE. JSB NXTWD PICK UP WORD 2. STA WRD2 CLB LSL 8 B:=COMPLETION STATUS. STB STATS CLB LSL 2 B:=REQUEST CODE. STB REQCD STORE. CLB LSL 6 B:=FUNCTION CODE. STB FUNCD STORE. * DECODE FUNCTION LDA REQCD LOAD REQUEST CODE. CPA D1 IF = 1, JMP RDFUN DECODE FOR READ. CPA D2 IF = 2, JMP WRITE DECODE FOR WRITE. CPA D3 IF = 3, JMP CNTRL DECODE FOR CONTROL. * BAD FUNCTION BAD LDB AW3 SET UP OUTPUT STB OPNTR POINTER. LDB REQCD CONVERT REQUEST JSB TO8 CODE AND LDB REQCD FUNCTION TO JSB TO8 OCTAL. JMP WRD3 GO GET WORD 3. * RDFUN LDA FUNCD ** PROCESS READ FUNCTION ** CPA D2 ϳ ONLY GOOD ONE RSS IS 2. JMP BAD DLD STA05+1 MOVE DST BUFR+7 "READ". LDA FUNCD ADA @RTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW10 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. JMP WRD3 GO GET WORD 3. * WRITE LDA FUNCD ** PROCESS WRITE FUNCTION ** SZA,RSS CHECK JMP BAD FOR CPA D7 BAD JMP BAD FUNCTION. LDB AW8 MOVE LDA @WRIT "WRITE". MVW D3 LDA FUNCD DON'T USE AND D7 FUNCTION BITS 9-11. ADA @WTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW11 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. JMP WRD3 GO GET WORD 3. * CNTRL LDA FUNCD ** PROCESS CONTROL FUNCTION ** CPA D5 CHECK FOR JMP BAD BAD FUNCTION AND D7 AND LDB D11 MAP CPA FUNCD 40-43 LDB D6 TO ADA DN6 5-10. SSA,RSS JMP BAD ADA B ADA @CTBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW8 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * WRD3 JSB NXTWD PICK UP WORD 3. CPA DN1 NEXT ENTRY? JMP SPCAS YES--SPECIAL CASE! * LOOP2 CLB LSL 8 B:=EVENT #. STB EVENT STORE. CLB LSL 8 B:=STATE #. STB STATE STORE. * LDA EVENT DECODE EVENT. ADA DN33 CHECK SSA,RSS FOR JMP BADE BAD LDA EVENT EVENT. ADA @ETBL  GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW17 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * DESTA LDA STATE DECODE STATE. ADA DN25 CHECK SSA,RSS FOR JMP BADS BAD LDA STATE STATE. ADA @STBL GET TABLE ADDRESS. LDA A,I LDB A,I STORE STB CNT1 LENGTH. INA A-REG POINTS TO MESSAGE. LDB AW26 B-REG POINTS TO DESTINATION. MVW CNT1 MOVE MESSAGE. * PRTEV JSB PRINT PRINT EVENT ENTRY. DEF BUFR D33 DEC 33 LDA BLANK JSB FILL FILL OUTPUT BUFFER WITH BLANKS. JSB NXTWD GET NEXT WORD. CPA DN1 DONE WITH THIS ENTRY? JMP PRSTA YES--PRINT STATUS INFORMATION. LDB AW18 NO-- STB OPNTR SET OUTPUT POINTER JMP LOOP2 AND PRINT THEM. * * SPECIAL CASE--NO EVENT/STATE WORDS SPCAS JSB PRINT PRINT DEF BUFR FIRST WORD DEC 15 INFO ONLY. * PRSTA LDA STATS GET STATUS. CLB CONVERT RRR 3 TO ALF,RAL ASCII RRL 3 (OCTAL). IOR "00" STA STASC LDA D18 STATUS MESSAGE STA STMLN LENGTH = 12. LDA STATS IF STATUS IS ADA BN22 LESS THAN 22 (OCTAL) SSA,RSS JMP PSTAT LDA STATS MOVE STATUS MESSAGE. ADA @STAT LDA A,I LDB A,I STB TEMP ADB STMLN SET STATUS MESSAGE LEN. STB STMLN INA LDB @STMS MVW TEMP PSTAT JSB PRINT PRINT STATUS MESSAGE. DEF STMSG STMLN NOP * LDB BPNTR CPB @EOR LAST ENTRY IN RECORD? RSS YES! JMP LOOP NO--LOOP AGAIN. SPC 1 JSB TMVAL CONVERT DEF *+3 TIIME INTO DEF INBUF+1 INDIVIDUAL DEF CENTS PARTS. * JSB KCVT CONVERT DEF *+2 HOURS. DEF HOURS STA ASTIM * JSB KCVT CONVERT DEF *+2 MINUTES. DEF MINTS IOR "00" LDB COLON RRR 8 DST ASTIM+1 * JSB KCVT CONVERT DEF *+2 SECONDS. DEF SECND IOR "00" STA ASTIM+3 * JSB KCVT CONVERT DEF *+2 TENS OF DEF CENTS MILLISECONDS. IOR "00" LDB DOT RRR 8 DST ASTIM+4 * LDA D16 TMLEN := 16. STA TMLEN LDA WRD2 SET WRD2 TO AND B377 CALL TYPE. STA WRD2 CPA RDINI READ INITIAL? JMP CNVRD GO CONVERT READ LEN. CPA WRCON WRITE CONVERSATIONAL? JMP CNVRD GO CONVERT READ LEN. JMP PRTIM NEITHER--PRINT TIME. * CNVRD LDA INBUF+4 CONVERT RECEIVE SSA LENGTH (WORDS). CLA,RSS IF NEGATIVE, USE 0. CLE,ERA STA INBUF+4 JSB CNUMD DEF *+3 DEF INBUF+4 DEF RCVLN LDA D24 TMLEN := 24. STA TMLEN * LDA WRD2 IF FUNCTION IS CPA RDINI READ INITIAL, JMP PRTIM GO PRINT. * LDA INBUF+3 CONVERT CMA,INA SEND CLE,ERA LENGTH STA INBUF+3 (WORDS). JSB CNUMD DEF *+3 DEF INBUF+3 DEF SNDLN LDA D33 TMLEN = 33. STA TMLEN * PRTIM JSB PRINT PRINT DEF TMLIN INFORMATION. TMLEN NOP * JMP GDRTN TAKE "GOOD" RETURN. SPC 3 * VARIABLES USED IN EVENT TRACE * EVENT NOP STATE NOP REQCD NOP FUNCD NOP SPC 2 BADE LDA AW17 BAD EVENT-- STA OPNTR CONVERT LDB EVENT TO JSB TO10 DECIMAL. JMP DESTA SPC 2 BADS LDA AW26 BAD STATE-- ; STA OPNTR CONVERT LDB STATE TO JSB TO10 DECIMAL. JMP PRTEV SPC 3 TMLIN ASC 10, TIME ASTIM ASC 11,XX:XX:XX.XXX RECV LEN RCVLN ASC 9,XXXXXX SEND LEN SNDLN ASC 3,XXXXXX SPC 1 DOT ASC 1, . COLON ASC 1,:: SPC 1 * TIME ARRAY CENTS NOP SECND NOP MINTS NOP HOURS NOP CDAY NOP SKP * VERIFY AUTHENTICITY OF AND PRINT REQUESTS AND REPLIES * ** SMALL SUBROUTINE TO PRINT RECORD HEADING ** PBHED NOP ENTRY. JSB PRINT PRINT DEF BLANK BLANK DEC 1 LINE. * LDB "30" DETERMINE LDA INBUF WHETHER MESSAGE SZA,RSS IS FROM LDB "10" 1000 STB FRMCP+14 OR 3000. CCA ADA RECNO STA TEMP JSB CNUMD CONVERT DEF *+3 RECORD DEF TEMP NUMBER. DEF FRMCP+3 JSB PRINT PRINT DEF FRMCP IT. DEC 17 JMP PBHED,I RETURN. * FRMCP ASC 17,RECORDXXXXXX, MESSAGE FROM XX00: SPC 2 * RQRP LDA PRFLG IF PRING FLAG AND HEBIT DOESN'T HAVE HEADING SZA,RSS BIT SET, JMP RDREC READ NEXT RECORD. * CPB D1 CHECK WORD 0: JMP CKWD1 MUST BE 1 SZB OR ZERO. JMP LGFER OTHERWISE, LOGGING FILE ERROR. * CKWD1 LDA LNCLS CHECK WORD 1: SZA,RSS JMP BADBF ERROR IF ZERO. AND B377 ISOLATE MESSAGE CLASS. STA CLASS SAVE IT. ADA DN9 SSA,RSS JMP BADBF ERROR IF MESSAGE CLASS > 8. * LDA LNCLS GET APPENDAGE LENGTH. ALF,ALF AND B377 ADA DN8 STA APLEN * LDA STMWD CHECK WORD 3: AND B377 ISOLATE STREAM TYPE. STA STREM SAVE IT. ADA BN20 SSA JMP BADBF ERROR IF < OCTAL 20. ADA BN10 SSA,RSS JMP -6BADBF ERROR IF > OCTAL 27. * LDA FRMTO GET WORD 4: AND B377 STA TO# SAVE TO #. LDA FRMTO ALF,ALF AND B377 STA FRM# SAVE FROM #. * LDA DTLEN CHECK WORD 8: SSA JMP BADBF ERROR IF NEGATIVE. * LDB DTLEN INB CLE,ERB ADB D8 STB BUFL SAVE WORD COUNT. INB CMB,INB LDA LNCLS ALF,ALF AND B377 ADA B SSA,RSS JMP BADBF ERROR. * * DO ALL THE OPTIONS MATCH? LDA !CLAS CLASS SSA,RSS CPA CLASS RSS JMP RDREC LDA !STRM STREAM SSA,RSS CPA STREM RSS JMP RDREC LDB FRM# RTE NUMBER LDA INBUF (USE FROM # OR SZA TO # DEPENDING LDB TO# UPON DIRECTION.) LDA !RTE# SSA,RSS CPA B RSS JMP RDREC ** ALL SYSTEMS ARE GO! * JSB PBHED PRINT HEADING. * * CONVERT VALUES TO ASCII. JSB CNUMO STREAM. DEF *+3 DEF STREM DEF ASCII LDA ASCII+2 STA PSTM# * JSB CNUMD CLASS. DEF *+3 DEF CLASS DEF ASCII DLD ASCII+1 RRL 8 DST PCLS# * JSB CNUMD FROM PROCESS # DEF *+3 DEF FRM# DEF ASCII DLD ASCII+1 DST PFRM# * JSB CNUMD TO PROCESS # DEF *+3 DEF TO# DEF ASCII DLD ASCII+1 DST PTO# * JSB CNUMO SEQUENCE # DEF *+3 DEF RTSQ# DEF PSEQ# * JSB CNUMD TOTAL LENGTH. DEF *+3 DEF BUFL DEF PTLEN * JSB PRINT PRINT INFORMATION. DEF MSHED ABS MSEND-MSHED SPC 1 LDA BLANK FILL BUFFER JSB FILL WITH BLANKS. * LDA CLASS MERGE CLASS ALF,ALF AND STREAM. IOR STREM STA UCLSTR * CPA POPCL POPEN/PCLOSE/BREAK? JMP C7S21 YES. SPECIAL CASE. * LDA @CLST A-REG CONTAINS ENTRY ADDRESS. SRLOP LDB A,I GET CONTENTS. CPB CLSTR MATCH? JMP FOUND YES! INA NO. BUMP POINTER AND JMP SRLOP STAY IN SEARCH LOOP. * * CLASS 7, STREAM 21 FOUND. C7S21 LDB APLEN GET APPENDAGE LENGTH. LDA @PCLO ASSUME PCLOSE. ADB DN7 GREATER THAN 6? SSB,RSS LDA @POPN POPEN. CPB DN7 ZERO? LDA @PCBR COULD BE BREAK. JMP MVLB MOVE LABEL. * FOUND LDB @CLST GET OFFSET INTO CMB,INB INTO ARRAY. ADA B MPY D7 CALCULATE LABEL ADA @LBLS ADDRESS. MVLB LDB AW3 MOVE LABEL TO MVW D7 WORDS 3-9. * LDA @REQ LDB STMWD CHECK BIT 15 OF STREAM WD. SSB LDA @REP LDB AW10 MVW D3 MOVE "REQST" OR "REPLY". * LDA STMWD AND BIT14 IF BIT 14 IS SET, SZA,RSS JMP CKB13 LDA @REJ LDB AW13 MVW D4 MOVE "/REJECT". * CKB13 LDA STMWD AND BIT13 IF BIT 13 IS SET, SZA,RSS JMP CKSUB DLD CONT MOVE "CONT". DST BUFR+16 * * CHECK TO SEE IF FURTHER BREAKDOWN OF CALL IS POSSIBLE. CKSUB LDA CLSTR IF MESSAGE CPA INTCL IS INITIALIZATION, JMP MVBFL MOVE BUFFER LENGTH. LDA STMWD IF REPLY AND B140K OR REJECT SZA BIT IS SET, JMP PRINF GO PRINT. LDA APLEN IF APPENDAGE LEN SZA,RSS IS ZERO, JMP PRINF GO PRINT. LDA CLSTR GET CLASS/STREAM. CPA C7S20 3000 RFA? JMP RFA3K YES. CPA C8S20 1000 RFA? JMP RFA1K YES. CPA C8S21 1000 DEXEC? JMP DEX1K YES. JMP PRINF GO PRINT. * * INITIALIZATION R_EQUEST OR REPLY. CONVERT BUFFER SIZE. * MVBFL LDA IBFLN GET BUFFER INDICATOR AND B377 FROM REQUEST/REPLY. INA ADD 1 AND MULTIPLY MPY D16 BY 16 TO GET # WORDS. STA IBFLN STORE BACK. JSB CNUMD CONVERT TO DECIMAL. DEF *+3 DEF IBFLN DEF BUFR+15 LDA @"BUF MOVE MESSAGE LDB AW19 TO OUTPUT LINE. MVW D4 JMP PRINF PRINT INFORMATION. * @"BUF DEF *+1 ASC 4, BUFFER * * 3000 REMOTE FILE ACCESS CALL RFA3K LDA RF3KW GET SUBROUTINE INDICATOR. SZA ZERO OR SSA NEGATIVE? JMP PRINF YES--GO PRINT. ADA BN25 > OCTAL 25? SSA,RSS YES--GO PRINT. JMP PRINF LDA TRF3K GET BASE ADDRESS. ADA RF3KW ADD INDEX ADA RF3KW THREE TIMES. ADA RF3KW JMP MVSUB GO MOVE NAME. * * 1000 REMOTE FILE ACCESS CALL RFA1K LDA RF1KW GET SUBROUTINE INDICATOR. SSA NEGATIVE? JMP PRINF YES--GO PRINT. ADA DN150 < DECIMAL 150? SSA JMP PRINF YES--GO PRINT. STA TEMP ADA DN13 > DECIMAL 162? SSA,RSS JMP PRINF YES--GO PRINT. LDA TRF1K GET BASE ADDRESS. ADA TEMP ADD INDEX ADA TEMP THREE TIMES. ADA TEMP JMP MVSUB MOVE NAME AND PRINT. * * 1000 DISTRIBUTED EXECUTIVE CALL DEX1K LDA DX1KW GET TYPE OF CALL. STA B SAVE. SZA ZERO OR SSA NEGATIVE? JMP PRINF YES--GO PRINT. ADA DN4 < 4? SSA JMP EXOK YES--IT'S OK. ADA DN6 BETWEEN 3 AND 6? SSA JMP PRINF YES--GO PRINT. ADA DN4 > 13? SSA,RSS JMP PRINF YES--GO PRINT. LDB DX1KW MAP CODES 10-13 ADB DN6 TO 4-7. EXOK LDA TDX1K GET BASE ADDRESS. ADA B  ADD INDEX ADA B THREE TIMES. ADA B MVSUB STA SADDR STORE SOURCE ADDRESS. JSB .DFER MOVE SUBROUTINE NAME. DEF BUFR+19 SADDR DEF *-* * PRINF JSB PRINT PRINT INFORMATION. DEF BUFR DEC 22 * * DUMP HEADER IN OCTAL * JSB PRINT PRINT DEF HDHED "HEADER". DEC 3 LDA DN8 SET UP FOR STA NOBUF 8 WORDS LDA @WRD2 BEGINNING STA PTBUF AT HEADER. JSB PTWDS PRINT IT * * * THIS PORTION PRINTS THE APPENDAGE. * LDA PRFLG CHECK BITS IN PRFLG AND APBIT APPENDAGE BIT SET? SZA,RSS JMP PBF20 NO--GET NEXT COMMAND. * JSB CNUMD CONVERT DEF *+3 APPENDAGE DEF APLEN LENGTH. DEF APHED+8 JSB PRINT PRINT DEF APHED APPENDAGE DEC 14 HEADER. LDA APLEN IF LENGTH SZA,RSS IS ZERO, JMP PBF17 GO DO DATA. CMA,INA STORE NEGATIVE STA NOBUF LENGTH. ADA DN8 IS APPENDAGE ADA TRCLN RECORDED? CMA,SSA,RSS JMP PBF17 NO--GO DO DATA. * LDA @WRD2 POINT TO ADA D8 APPENDAGE STA PTBUF IN BUFFER. JSB PTWDS PRINT IT. * * THIS PORTION PRINTS ANY DATA WITH THE BUFFER * PBF17 LDA PRFLG AND DABIT DATA BIT SET? SZA,RSS JMP PBF20 NO--RETURN. * LDB APLEN CALCULATE NUMBER OF CLE,ELB BYTES IN APPENDAGE. CMB,INB LDA DTLEN SUBTRACT FROM HEADER ADA B WORD 8. SSA IF NEGATIVE, IT'S CLA REALLY ZERO. STA DABYT SAVE # DATA BYTES. INA CLE,ERA STA DAWRD SAVE # DATA WORDS. * JSB CNUMD CONVERT DEF *+3 DATA DEF DABYT LENGTH. DEF DAHED+6 JSB PRINT PRINT  DEF DAHED DATA DEC 12 HEADER. LDA DAWRD IF LENGTH IS 0, SZA,RSS JMP PBF20 DONE. CCA ADA TRCLN CALCULATE # OF CMA,INA DATA WORDS ADA APLEN ACTUALLY IN ADA D8 BUFFER. STA NOBUF SAVE NEG. WORD COUNT. SSA,RSS IF NONE, JMP PBF20 DONE. * LDA @WRD2 POINT TO ADA D8 DATA ADA APLEN IN BUFFER. STA PTBUF JSB PTWDS PRINT IT. * PBF20 JSB PRINT PRINT DEF BLANK BLANK DEC 1 LINE. GDRTN ISZ PBUFR TAKE "GOOD" JMP PBUFR,I RETURN. SPC 2 DABYT NOP DAWRD NOP HDHED ASC 3,HEADER APHED ASC 14,APPENDAGE LENGTHXXXXXX WORDS DAHED ASC 12,DATA LENGTH XXXXXX BYTES SPC 2 * * ROUTINE TO TAKE WORDS FROM THE BUFFER, TRANSLATE THEM TO * ASCII OCTAL, AND PRINT THEM. * ON ENTRY: * NOBUF = NEG. # OF WORDS IN BUFFER TO BE MOVED * PTBUF = NEXT WORD IN BUFFER * PTWDS NOP LDA NOBUF ANY WORDS TO MOVE? SZA,RSS JMP PTWDS,I NO--RETURN. * STA PTEM1 SAVE TEMP COUNTER. JSB BRCHK CHECK FOR USER BREAK. LDA PTBUF SAVE TEMPORARY STA PTEM2 POINTER. LDA DN8 SET COUNTER FOR 8 WORDS. STA PTEM3 LDA BLANK FILL BUFFER JSB FILL WITH BLANKS. LDA ASTK STORE ASTERISK STA BUFR+28 AT WORD 29. LDA .BYT2 SET OUTPUT STA .OUTL POINTER. PTW1 JSB CNUMO CONVERT DEF *+3 TO ASCII DEF PTEM2,I OCTAL. DEF ASCII LDA ASCII ADD IOR "00" LEADING STA ASCII ZEROES LDA ASCII+1 TO IOR "00" ASCII STA ASCII+1 OCTAL. LDA ASCII+2 IOR "00" STA ASCII+2 LDB .OUTL B-REG := DEST. ADDR. INB (LEAVE LEADING BLANK) LDA .ASCI SOURCE ADDR. MBT D6 MOVE NUMBER. STB .OUTL SAVE DEST. ADDR. ISZ PTEM2 BUMP SOURCE POINTER. * ISZ PTEM1 ARE WE OUT OF WORDS? RSS JMP PTW5 YES--BRANCH TO ADD ASCII. ISZ PTEM3 DONE WITH 8 WORDS? JMP PTW1 NO--CONTINUE * * PREPARE THE ASCII SECTION. * PTW5 LDA DN8 SET UP COUNTER STA PTEM3 FOR 8 WORDS. LDA AW30 SET UP POINTER INTO STA .OUTL ASCII AREA OF BUFFER. PTW6 LDA PTBUF,I GET NEXT WORD ALF,ALF JSB CHKAS CHECK LEFT BYTE. STB PTEM4 LDA PTBUF,I JSB CHKAS CHECK RIGHT BYTE. LDA PTEM4 ALF,ALF IOR B COMBINE BYTES. STA .OUTL,I STORE IN ASCII AREA. ISZ .OUTL BUMP POINTER. ISZ PTBUF BUMP SOURCE POINTER. ISZ NOBUF OUT OF WORDS? RSS JMP PROCT YES. PRINT. ISZ PTEM3 DONE WITH 8 WORDS? JMP PTW6 NO--CONTINUE. * PROCT JSB PRINT PRINT. DEF BUFR D37 DEC 37 JMP PTWDS+1 GO TO START OF LOOP. SPC 3 * * SUBROUTINE TO CHECK ASCII CHARACTER. SET CHARACTER TO BLANK IF * IT IS LESS THAN OCTAL 40 OR GREATER THAN OCTAL 177. * CALLING SEQUENCE: * * JSB CHKAS * * CHKAS NOP ENTRY. AND B377 ISOLATE RIGHT BYTE. STA B SAVE IT. AND B340 CHECK FOR ASCII SZA,RSS CONTROL CHAR (<40). JMP LDSPC YES! LOAD SPACE. AND B200 CHECK FOR NON-ASCII SZA (200B BIT SET). LDSPC LDB SPACE YES! LOAD SPACE. JMP CHKAS,I RETURN. SPC 2 .OUTL NOP SPACE BYT 0,40 B200 OCT 200 B340 OCT 340 NOBUF NOP PTBUF NOP PTEM1 NOP PTEM2 NOP PTEM3 NOP PTEM4 NOP ASTK ASC 1, * * * BADBF JSB PBHED PRINT HEAD. JSB PRINT DISPLAY -0 DEF BDBUF BAD BUFFER MESSAGE. DEC 6 * LDA @WRD2 PRINT OCTAL. STA PTBUF CCA ADA TRCLN CMA,INA STA NOBUF JSB PTWDS * JMP PBF20 RETURN. * BDBUF ASC 6, BAD BUFFER ASCII BSS 3 .ASCI DBL ASCII "30" ASC 1,30 "10" ASC 1,10 * MSHED ASC 3, CLASS PCLS# ASC 6, XX STREAM PSTM# ASC 4,XX FROM PFRM# ASC 4, XXX TO PTO# ASC 5, XXX SEQ# PSEQ# ASC 9,XXXXXX TOTAL LEN PTLEN ASC 3,XXXXXX MSEND EQU * * * * VALUES SET: BUFL NOP WORD COUNT. CLASS NOP DS/3000 MESSAGE CLASS. STREM NOP DS/3000 MESSAGE STREAM. APLEN NOP APPENDAGE LENGTH. FRM# NOP FROM PROCESS NUMBER. TO# NOP TO PROCESS NUMBER. SKP * SUBROUTINE TO OPEN THE TRACE OUTPUT DEVICE. * CALLING SEQUENCE: JSB OPNTO * OPNTO NOP ENTRY. LDA @TRCO JSB OPNDV OPEN THE TRACE OUTPUT DEVICE. DEF TRCOT JMP OPNTO,I NORMAL OPEN...RETURN. * LDB CMDIN+1 LDA CMDIN USE COMMAND INPUT SSA,RSS IF INTERACTIVE. OTHERWISE LDB DEFLU USE DEFAULT LU. STB TRCOT+1 STORE. CCA SET DEVICE TYPE STA TRCOT TO INTERACTIVE. JMP OPNTO,I RETURN. SPC 4 * * SUBROUTINE TO PRINT A RECORD ON TRACE OUTPUT DEVICE. * CALLING SEQUENCE: JSB PRINT * DEF * DEC * PRINT NOP ENTRY POINT LDA PRINT,I PICK STA MSG UP ISZ PRINT PARAMETERS. LDA PRINT STA MSLEN ISZ PRINT SET RETURN ADDR. LDA TRCOT IF OUTPUT IS CPA "FI" TO A FILE, JMP PRNT1 DO FILE WRITE. * JSB REIO WRITE ON LU. DEF *+5 DEF SD2 DEF TRCOT+1 MSG DEF *-* MSLEN DEF *-* JMP RTERR ERROR RETURN. JMP PRINT,I RETURN. * PRNT1 JSB WRITF WRITE ON FILE. DEF 5*+5 DEF TRCOT+1 DEF ERROR DEF MSG,I DEF MSLEN,I LDA ERROR CHECK FOR FILE ERROR. SSA,RSS JMP PRINT,I RETURN. * LDB @TRCO SET UP STB NAME NAME POINTER. JSB FILER REPORT ERROR. JMP EXCMD TERMINATE. SPC 3 * SUBROUTINE TO PRINT ERROR MESSAGE ON DEFAULT LU. * CALLING SEQUENCE: JSB ERMSG * DEF * DEC * ERMSG NOP ENTRY. LDA ERMSG,I PICK STA EMSG UP ISZ ERMSG PARAMETERS. LDA ERMSG STA EMSLN ISZ ERMSG SET RETURN ADDR. JSB REIO WRITE ON DEF *+5 DEFAULT DEF SD2 LU. DEF DEFLU EMSG DEF *-* EMSLN DEF *-* D0 NOP IGNORE ERRORS. JMP ERMSG,I RETURN. SKP * SUBROUTINE TO PROMPT AND READ ON COMMAND INPUT DEVICE. * CALLING SEQUENCE: JSB READ * DEF * DEC * READ NOP ENTRY. LDA READ,I PICK UP STA PMSG PARAMETERS. ISZ READ LDA READ STA PLEN ISZ READ SET RETURN ADDR. LDA CMDIN IF COMMAND INPUT IS CPA "FI" A FILE, JMP READ1 DO FILE READ. SSA,RSS IF NON-INTERACTIVE, JMP INPUT SKIP PROMPT. * JSB REIO CALL SYSTEM FOR WRITE. DEF *+5 DEF SD2 DEF CMDIN+1 PMSG DEF *-* PLEN DEF *-* JSB RTERR ERROR RETURN. * INPUT JSB REIO READ FROM LU. DEF *+5 DEF SD1 DEF CMDIN+1 DEF INBUF DEF D40 JSB RTERR ERROR RETURN. JMP ECHO ECHO. * READ1 JSB READF READ FROM FILE. DEF *+6 DEF CMDIN+1 DEF ERROR DEF INBUF DEF D40 DEF INLEN LDB INLEN SET B-REG TO LENGTH. LDA ERROR CHECK FOE.R ERROR. SSA,RSS JMP ECHO ECHO. * LDB @CMDI POINT TO STB NAME FILE NAME. JSB FILER REPORT ERROR. JMP EXCMD TERMINATE. SPC 2 ECHO STB ECHLN SAVE WORD LENGTH. SSB,RSS UNLESS NEGATIVE, CLE,ELB DOUBLE FOR STB INLEN BYTE LENGTH. SSB IF NOT EOF, JMP RDRTN CLE,ERB PUSH BLANK ADB @INBF ONTO END LDA BLANK OF LINE. STA B,I * LDA CMDIN+1 IF COMMAND INPUT IS CPA TRCOT+1 SAME AS TRACE OUTPUT, JMP RDRTN NO NEED TO ECHO. JSB PRINT PRINT DEF INBUF INPUT. ECHLN DEF *-* RDRTN LDB INLEN B-REG := # OF CHARS. JMP READ,I RETURN. SKP * SUBROUTINE TO "OPEN" A DEVICE. * CALLING SEQUENCE: LDA * JSB OPNDV * DEF (RETURNED) * * * ERRTN NOP ERROR RETURN ADDR. DTYPE NOP DEVICE DTYPEADDR. OPNDV NOP ENTRY. STA NAME SAVE NAME POINTER. ADA D4 ADDRESSES STA SECU OF SECURITY INA AND CARTRIDGE. STA CRN LDA OPNDV,I PICK UP STA DTYPE PARAMETER ADDR. LDA OPNDV SET INA NORMAL STA OPNDV RETURN. INA SET ERROR STA ERRTN RETURN. LDA NAME,I GET DEVICE NAME SZA,RSS IF 0, JMP ERRTN,I TAKE ERROR RETURN. LDA NAME GET ADA D3 STATUS LDA A,I BITS. AND D3 ISOLATE 1ST PARAM. CPA D3 ASCII? JMP OPNFL YES. GO OPEN FILE. LDA NAME,I IF LU > 64, AND NTB77 SZA JMP ERRTN,I ERROR! JSB IFTTY MUST BE AN LU. DEF *+2 CALL SYS ROUTINE TO DEF NAME,I g CHECK TYPE. STA DTYPE,I STORE INTERACTIVE FLAG. LDA NAME,I ADD CONTROL BITS IOR B600 AND STORE LU NUMBER. ISZ DTYPE STA DTYPE,I JMP OPNDV,I RETURN. * OPNFL LDA "FI" SET DEVICE TYPE STA DTYPE,I AS FILE. LDA DTYPE GET ADDRESS INA OF DCB. STA DCB JSB OPEN OPEN FILE. DEF *+7 DCB DEF *-* DEF ERROR DEF NAME,I DEF D0 SECU DEF *-* CRN DEF *-* LDA ERROR ERROR? SSA,RSS JMP OPNDV,I NO. NORMAL RETURN. * JSB FILER REPORT ERROR. JMP ERRTN,I TAKE ERROR RETURN. SPC 3 * SUBROUTINE TO REPORT ERROR MESSAGE. * CALLING SEQUENCE: * * JSB FILER * FILER NOP ENTRY. CMA,INA MAKE ERROR STA TEMP POSITIVE. JSB KCVT CONVERT DEF *+2 TO ASCII DEF TEMP (DECIMAL). IOR "00" ADD LEADING 0. STA FLER# STORE IN MESSAGE. JSB .DFER MOVE DEF FLNM FILE NAME DEF *-* NAME. JSB ERMSG PRINT DEF FERMG ERROR D16 DEC 16 MESSAGE. JMP FILER,I RETURN. * FERMG ASC 5,** ERROR - FLER# ASC 6,XX ON FILE FLNM ASC 5, ** * ERROR NOP SPC 3 * SUBROUTINE TO REPORT RTE SYSTEM ERROR. * CALLING SEQUENCE: JSB RTERR * * RTERR NOP ENTRY. DST RTEMS+7 STORE ASCII MESSAGE. JSB ERMSG PRINT DEF RTEMS ERROR DEC 11 MESSAGE. CLB SET LENGTH TO 0. JMP RTERR,I RETURN. * RTEMS ASC 11,** RTE ERROR: XXXX ** SPC 3 * SUBROUTINE TO READ A TRACE RECORD. * CALLING SEQUENCE: JSB GETRC * * GETRC NOP ENTRY. LDA TRCIN IF DbIEVICE CPA "FI" TYPE IS FILE, JMP GTRC1 GO DO READF. * JSB REIO READ FROM LU. DEF *+5 DEF SD1 DEF TRCIN+1 DEF INBUF DEF D304 JMP TLUER ERROR RETURN. STB TRCLN SAVE LENGTH. GRETN ISZ RECNO BUMP RECORD COUNTER. NOP JMP GETRC,I * TLUER JSB RTERR PRINT RTE ERROR MESSAGE. JMP GRETN RETURN. * * GTRC1 JSB READF READ FROM FILE. DEF *+6 DEF TRCIN+1 DEF ERROR DEF INBUF DEF D304 DEF TRCLN LDB TRCLN LOAD # OF WORDS READ. LDA ERROR CHECK FOR ERROR. SSA,RSS JMP GRETN RETURN. * LDB @TRCI POINT TO STB NAME FILE NAME. JSB FILER REPORT ERROR. CLB READ LEN = 0. JMP GRETN RETURN. * TRCLN NOP SKP * SUBROUTINE TO CALL NAMR PARSE ROUTINE * CALLING SEQUENCE: * * JSB PNAMR * PNAMR NOP ENTRY POINT JSB NAMR CALL DEF *+5 NAMR DEF NAME,I ROUTINE. DEF INBUF DEF INLEN DEF PNTR LDA NAME,I LOAD PARAMETER. JMP PNAMR,I RETURN. SPC 2 PNTR NOP COLUMN POINTER SPC 5 * CONVERT B-REG CONTENTS TO ASCII (OCTAL) TO8 NOP STB TEMP STORE NUMBER. STA AREG SAVE A-REG. JSB CNUMO GO CONVERT. DEF *+3 DEF TEMP DEF OPNTR,I LDA AREG RESTORE A-REG. LDB OPNTR BUMP ADB BUMP OUTPUT STB OPNTR POINTER. CLB CLEAR B-REG. JMP TO8,I RETURN. SPC 5 * CONVERT B-REG CONTENTS TO ASCII (DECIMAL) * TO10 NOP STB TEMP STORE NUMBER. STA AREG SAVE A-REG. JSB CNUMD GO CONVERT. DEF *+3 DEF TEMP DEF OPNTR,I q LDA AREG RESTORE A-REG. LDB OPNTR BUMP ADB BUMP OUTPUT STB OPNTR POINTER. CLB CLEAR B-REG. JMP TO10,I RETURN. SPC 3 * GET NEXT WORD IN BUFFER AND BUMP POINTER. * NXTWD NOP LDA BPNTR,I PICK UP WORD. ISZ BPNTR BUMP POINTER. JMP NXTWD,I RETURN. SPC 3 * FILL OUTPUT BUFFER WITH CHAR IN A-REG * FILL NOP LDX D37 INITIALIZE COUNTER. FLOOP SAX BUFR-1 STORE A-REG. DSX DECREMENT X-REG AND JMP FLOOP STAY IN LOOP UNTIL 0. * JMP FILL,I RETURN. SPC 3 SPC 6 * CONSTANTS AND STORAGE SPC 1 "NO" ASC 1,NO "FI" ASC 1,FI "00" ASC 1,00 @INBF DEF INBUF @WRD2 DEF INBUF+1 @WRD6 DEF INBUF+5 @EOR NOP VPNT NOP MPNT NOP BUMP NOP CNT1 NOP CNT2 NOP TEMP NOP AW3 DEF BUFR+2 AW8 DEF BUFR+7 AW10 DEF BUFR+9 AW11 DEF BUFR+10 AW13 DEF BUFR+12 AW17 DEF BUFR+16 AW18 DEF BUFR+17 AW19 DEF BUFR+18 AW26 DEF BUFR+25 AW30 DEF BUFR+29 .BYT2 DBR BUFR OPNTR NOP BUFR ASC 20, ASC 17, SHEAD ASC 20,RECORDXXXXXX, SLC LONG TERM STATISTICS: TIPRM ASC 8,LOGGING INPUT:_ * BADTY ASC 15,LOG FILE CANNOT BE TYPE 1 OR 2 DEFLU NOP WRD2 NOP STATS NOP INLEN NOP READ LENGTH BPNTR NOP BUFFER POINTER AREG NOP RDINI OCT 102 READ INITIAL FUNCTION CODE. WRCON OCT 203 WRITE CONVERSATIONAL CODE. BN25 OCT -25 BN22 OCT -22 BN20 OCT -20 BN10 OCT -10 DN150 DEC -150 DN33 DEC -33 DN25 DEC -25 DN13 DEC -13 DN11 DEC -11 DN9 DEC -9 DN8 EQU BN10 DN7 DEC -7 DN6 DEC -6 DN4 DEC -4 DN3 DEC -3 DN2 DEC -2 DN1 DEC -1 SD1 DEF 1,I SD2 DEF 2,I D18 DEC 18 D24 DEC 24 D40 DEC 40 D304 DEC 304 B600 OCT 600 B377 OCT 377 B140K OCT 140000 HB377 BYT 377,0 BIT14 OCT 40000 BIT13 OCT 20000 NTB77 OCT 177700 SPC 3 * LONG TERM STATS HEADINGS * MSGTB DEF *+1 MESSAGE TABLE  D7 DEC 7 ASC 7, READ REQUESTS D8 DEC 8 ASC 8, WRITE REQUESTS D11 DEC 11 ASC 11, MESSAGES TRANSMITTED DEC 10 ASC 10, SPURIOUS INTERRUPTS D6 DEC 6 ASC 6, LINE ERRORS DEC 7 ASC 7, NAKS RECEIVED DEC 9 ASC 9, BCC/PARITY ERRORS DEC 7 ASC 7, LONG TIMEOUTS DEC 8 ASC 8, RESPONSE ERRORS DEC 7 ASC 7, RESPONSE REJ DEC 9 ASC 9, WACK/TTD RECEIVED SPC 3 * POINTERS INTO TABLES * @RTBL DEF RTBL-1 @WRIT DEF STA12+1 @WTBL DEF WTBL-1 @CTBL DEF CTBL @ETBL DEF ETBL @STBL DEF STBL @STAT DEF STATT SPC 3 * READ FUNCTION TABLE * RTBL DEF RMSG1 DEF RMSG2 RMSG1 DEC 4 ASC 4, INQUIRY RMSG2 DEC 4 ASC 4, INITIAL SPC 2 * WRITE FUNCTION TABLE * WTBL DEF WMSG1 DEF WMSG2 DEF WMSG3 DEF WMSG4 DEF WMSG5 WMSG1 DEC 4 ASC 4,INQUIRY WMSG2 DEC 1 ASC 1,2 WMSG3 DEC 5 ASC 5,CONVERSTNL WMSG4 DEC 3 ASC 3,RESET WMSG5 DEC 5 ASC 5,DISCONNECT SPC 2 * CONTROL FUNCTION TABLE * CTBL DEF CMSG0 DEF CMSG1 DEF CMSG2 DEF CMSG3 DEF CMS40 DEF CMS41 DEF CMS42 DEF CMS43 CMSG0 DEC 3 ASC 3,CLEAR CMSG1 DEC 5 ASC 5,INITIALIZE CMSG2 DEC 5 ASC 5,LINE OPEN CMSG3 DEC 5 ASC 5,LINE CLOSE CMS40 DEC 8 ASC 8,ESTABLISH LOC ID CMS41 DEC 8 ASC 8,ESTBL REM ID LST CMS42 DEC 8 ASC 8,CHNG ERROR PRAMS CMS43 DEC 8 ASC 8,ZERO COMM STATS SPC 2 * EVENT TABLE * ETBL DEF EVT00 DEF EVT01 DEF EVT02 DEF EVT03 DEF EVT04 DEF EVT05 DEF EVT06 DEF EVT07 DEF EVT08 DEF EVT09 DEF EVT10 DEF EVT11 DEF EVT12 DEF EVT13 DEF EVT14 DEF EVT15 DEF EVT16 DEF EVT17 DEF EVT18 DEF EVT19 DEF EVT20 DEF EVT21 DEF EVT22 DEF EVT23 DEF EVT24 DEF EVT25 DEF EVT26 DEF EVT27 DEF EVT28 DEF EVT29 DEF EVT30 DEF EVT31 DEF EVT32 EVT00 DEC 7 ASC 7,LINE OPEN REQ EVT01 DEC 7 ASC 7,LINE CLOSE REQ EVT02 DEC 8 ASC 8,READ INQUIRY REQ EVT03 DEC 8 ASC 8,READ INITIAL REQ EVT04 DEC 1 ASC 1,4 EVT05 DEC 1 ASC 1,5 EVT06 DEC 1 ASC 1,6 EVT07 DEC 1 ASC 1,7 EVT08 DEC 8 ASC 8,WRITE INQURY REQ EVT09 DEC 1 ASC 1,9 EVT10 DEC 7 ASC 7,WRITE CONV REQ EVT11 DEC 8 ASC 8,WRT RESET(EOT)RQ EVT12 DEC 8 ASC 8,WRITE DISCON REQ EVT13 DEC 1 ASC 1,13 EVT14 DEC 7 ASC 7,ACK0 RECEIVED EVT15 DEC 7 ASC 7,ACK1 RECEIVED EVT16 DEC 7 ASC 7,WACK RECEIVED EVT17 DEC 7 ASC 7,RVI RECV/SENT EVT18 DEC 6 ASC 6,ENQ RECEIVED EVT19 DEC 6 ASC 6,NAK RECEIVED EVT20 DEC 6 ASC 6,EOT RECEIVED EVT21 DEC 8 ASC 8,DLE EOT RECEIVED EVT22 DEC 6 ASC 6,TTD RECEIVED EVT23 DEC 7 ASC 7,TEXT RECEIVED EVT24 DEC 8 ASC 8,BCC PRTY/FMT ERR EVT25 DEC 6 ASC 6,TEXT OVERRUN EVT26 DEC 8 ASC 8,GARBAGE RECEIVED EVT27 DEC 8 ASC 8,BAD ID SEQUENCE EVT28 DEC 7 ASC 7,SHORT TIMEOUT EVT29 DEC 6 ASC 6,LONG TIMEOUT EVT30 DEC 2 ASC 2,LOW EVT31 DEC 2 ASC 2,HIGH EVT32 DEC 2 ASC 2,MID SPC 2 * STATE TABLE * STBL DEF STA00 DEF STA01 DEF STA02 DEF STA03 DEF STA04 DEF STA05 DEF STA06 DEF STA07 DEF STA08 DEF STA09 DEF STA10 DEF STA11 DEF STA12 DEF STA13 DEF STA14 DEF STA15 DEF STA16 DEF STA17 DEF STA18 DEF STA19 DEF STA20 DEF STA21 DEF STA22 DEF STA23 DEF STA24 STA00 DEC 4 ASC 4,UNOPENED STA01 DEC 4 AS0C 4,CONTROL STA02 DEC 4 ASC 4,READ ENQ STA03 DEC 7 ASC 7,READ ENQ ERROR STA04 DEC 7 ASC 7,CHECK READ REQ STA05 DEC 2 ASC 2,READ STA06 DEC 5 ASC 5,READ TEXT STA07 DEC 4 ASC 4,READ RVI STA08 DEC 8 ASC 8,RESTRICTED READ STA09 DEC 5 ASC 5,WRITE ENQ STA10 DEC 8 ASC 8,WRITE ENQ ERROR STA11 DEC 8 ASC 8,ENQ-ENQ CONTENTN STA12 DEC 3 ASC 3,WRITE STA13 DEC 5 ASC 5,WRITE TEXT STA14 DEC 8 ASC 8,WRITE RESPNS ENQ STA15 DEC 7 ASC 7,CHECK RESPONSE STA16 DEC 8 ASC 8,BAD ACK RECEIVED STA17 DEC 6 ASC 6,WRITE RETRY STA18 DEC 8 ASC 8,ENQ RCV IN WRITE STA19 DEC 8 ASC 8,ENQ RCRD IN WRIT STA20 DEC 8 ASC 8,WRITE CONVERSTNL STA21 DEC 5 ASC 5,WRITE EOT STA22 DEC 8 ASC 8,READ EOT RSPONSE STA23 EQU WMSG5 STA24 DEC 5 ASC 5,WRITE TTD SPC 2 STATT DEF ST00 DEF ST01 DEF ST02 DEF ST03 DEF ST04 DEF ST05 DEF ST06 DEF ST07 DEF ST10 DEF ST11 DEF ST12 DEF ST13 DEF ST14 DEF ST15 DEF ST16 DEF ST17 DEF ST20 DEF ST21 ST00 DEC 9 ASC 9,NORMAL COMPLETION ST01 DEC 8 ASC 8,INVALID REQUEST ST02 DEC 16 ASC 16,REQST INCOMPATIBLE W/ LINE STATE ST03 DEC 1 ASC 1, [BAD ID SEQUENCE] ST04 DEC 11 ASC 11,LOCAL HARDWARE FAILURE ST05 DEC 6 ASC 6,EOT RECEIVED ST06 DEC 15 ASC 15,DISCONNECT (DLE EOT) RECEIVED ST07 DEC 6 ASC 6,LONG TIMEOUT ST10 DEC 11 ASC 11,EOT SENT, ENQ RECEIVED ST11 DEC 6 ASC 6,DATA OVERRUN ST12 DEC 9 ASC 9,MAX NAKS RECEIVED ST13 DEC 7 ASC 7,MAX ENQS SENT ST14 DEC 6 ASC 6,RVI RECEIVED ST15 DEC 11 ASC 11,ENQ SENT, ENQ RECEIVED ST16 DEC 11 ASC 11,ENQ SENT, NAK RECEIVED ST17 DEC 9 ASC 9,MAX ENQS RECEIVED ST20 DEC 1 ASC 1, [TTD SENT, NAK RECEIVED] ST21i DEC 10 ASC 10,IMPOSSIBLE SITUATION * STMSG ASC 16, COMPLETION STATUS STASC ASC 18,XX: @STMS DEF STASC+2 * DS/3000 CLASS/STREAM TYPES @CLST DEF *+1 INTCL BYT 0,20 BYT 0,21 BYT 3,20 BYT 3,22 BYT 4,22 BYT 4,23 BYT 4,24 BYT 4,25 BYT 4,26 BYT 4,27 BYT 5,20 BYT 5,21 BYT 5,22 BYT 5,23 BYT 5,24 BYT 6,20 BYT 6,21 BYT 6,22 BYT 6,23 BYT 6,24 BYT 6,25 BYT 6,27 C7S20 BYT 7,20 BYT 7,22 BYT 7,26 BYT 7,27 C8S20 BYT 10,20 C8S21 BYT 10,21 CLSTR NOP SEARCH KEY STORED HERE. @LBLS DEF *+1 ASC 7,INITIALIZATION ASC 7,TERMINATION ASC 7,SYSTEM COMMAND ASC 7,DSLINE ASC 7,PREAD ASC 7,PWRITE ASC 7,PCONTROL PCLOS ASC 7,PCLOSE ASC 7,ACCEPT ASC 7,REJECT ASC 7,TERMINAL PRINT ASC 7,TERMINAL READ ASC 7,TERMINAL READX ASC 7,TERMINAL CNTRL ASC 7,ABORT I/O ASC 7,HELLO ASC 7,BYE ASC 7,BREAK ASC 7,ABORT PROGRAM ASC 7,RESUME ASC 7,CNTRL-Y ASC 7,KILL JOB ASC 7,DS/3000 RFA ASC 7,DSLINE ASC 7,ACCEPT POPEN ASC 7,REJECT POPEN ASC 7,DS/1000 RFA ASC 7,REMOTE EXEC ASC 7, * POPCL BYT 7,21 POPEN/PCLOSE/BREAK @POPN DEF *+1 ASC 7,POPEN @PCLO DEF PCLOS @PCBR DEF *+1 ASC 7,PCLOSE/BREAK * @REQ DEF *+1 ASC 3, REQST @REP DEF *+1 ASC 3, REPLY @REJ DEF *+1 ASC 4,/REJECT CONT ASC 2,CONT SPC 2 TRF3K DEF *-2 TABLE FOR 3000 RFA ASC 3,FOPEN ASC 3,FCLOS ASC 3,FREAD ASC 3,FRDIR ASC 3,FRDSK ASC 3,FWRIT ASC 3,FWDIR ASC 3,FRLAB ASC 3,FWLAB ASC 3,FUPDT ASC 3,FSPAC ASC 3,FPOIN ASC 3,FINFO ASC 3,FCHEK ASC 3,FCNTL ASC 3,FSTMD ASC 3,FRNAM ASC 3,FRLAT ASC 3,FLOOK ASC 3,FUNLK * TRF1K DEF *+1 TABLE FOR 1000 RFA ASC 3,DCRET ASC 3,DPURG ASC 3,DOPEN ASC 3,DWRIT ASC 3,DREAD ASC 3,DPOSN ASC 3,DWIND ASC 3,DCLOS ASC 3,DNAME ASC 3,DCONT ASC 3,DLOCF ASC 3,DAPOS ASC 3,DSTAT * TDX1K DEF *-2 TABLE FOR 1000 DISTRIBUTED EXECUTIVE ASC 3,READ ASC 3,WRITE ASC 3,CONTRL ASC 3,SCHEDL ASC 3,TIME ASC 3,X TIME ASC 3,STATUS SPC 2 * MAXPR EQU 10 UP TO 10 PARAMETERS/COMMAND MXPRM ABS MAXPR+1 PTAB BSS MAXPR PARAMETER ADDRESS ARRAY. .PTAB DEF PTAB .NEXT NOP ETAB BSS MAXPR+1 .ETAB DEF ETAB .NXTE NOP SPC 2 * ARRAY FOR PICKING UP SCHEDULING PARAMETERS: NCMDI BSS 10 FIRST: COMMAND INPUT. NTRCI BSS 10 SECOND: TRACE INPUT. NTRCO BSS 10 THIRD: TRACE OUTPUT. PMASK BYT 3,7 3 PARAMETERS, ALL NAMR @CMDI DEF NCMDI @TRCO DEF NTRCO @TRCI DEF NTRCI SPC 1 ** DEVICE "OPEN" BUFFERS ** CMDIN NOP TYPE OF COMMAND INPUT. BSS 144 DCB OR LU #. TRCIN NOP TYPE OF TRACE INPUT. BSS 144 DCB OR LU #. TRCOT NOP TYPE OF TRACE OUTPUT. BSS 144 DCB OR LU #. SPC 1 ** READ BUFFER ** INBUF BSS 304 SPC 1 * LABELS FOR DS/3000 HEADER: LNCLS EQU INBUF+1 STMWD EQU INBUF+3 IBFLN EQU INBUF+4 FRMTO EQU INBUF+5 RTSQ# EQU INBUF+6 DTLEN EQU INBUF+8 RF1KW EQU INBUF+9 APPENDAGE WORD 1 RF3KW EQU INBUF+11 APPENDAGE WORD 3 DX1KW EQU INBUF+13 APPENDAGE WORD 4 SPC 1 BSS 0 SIZE OF TRC3K. SPC 1 END TRC3K ~ q( 91750-18179 2013 S C0122 &UPLIN              H0101 ASMB,Q,R,C HED 91750-16179 REV.2013 (C) HEWLETT-PACKARD CO. 1980 NAM UPLIN,17,3 91750-16179 REV.2013 801013 ALL SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 4 * * UPLIN * -------------- * SOURCE PART # 91750-18179 * REL PART # 91750-16179 * WRITTEN BY: TOM MILNER * DATE WRITTEN DEC 1979 * * MODIFIED: * 801013 BY FF TO IMPLEMENT FUNCTION 9, AND TO CHANGE * FUNCTION 4 SUCH THAT A LONG TIME OUT DOES NOT * MASK A DORMANT OR "BAD" MASTER TCB CONDITION. * SPC 3 * EXTERNAL REFERENCES EXT EXEC,$LIBR,$LIBX,PGMAD,RNRQ,CLRQ,.MVW,#FWAM EXT MESSS,#RSAX,#UPSM,DTACH * EXT #OTCV,#INCV,$OPSY,#MCTR EXT #RPCV,#LUMP,#RSM EXT #BUSY,#QRN,#LDEF EXT #GRPM,#LU3K,#QXCL,#TST EXT #PNLH,#MRTH,#CLRN EXT #OFF,#PLOG SUP SPC 3 * UPLIN FOR DS/1000 UPLIN IS SCHEDULED EVERY 5 SECONDS TO PERFORM * THE FOLLOWING FUNCTIONS: * 1. CHECKS/WAITS FOR SYSTEM QUIESCENCE. PRINTS OPERATOR MESSAGE * WHEN QUIESCENCE IS ACHIEVED. * 2. UPDATES SLAVE "TCB" TIMEOUT VALUES, AND IF A TRANSACTION HAS * TIMED OUT, THE TCB IS PURGED, AND IF THE MONITOR ABORT * FLAG IS SET, THE MONITOR IS ABORTED. * 3. AFTER PROCESSING EACH SLAVE TCB LIST, UPLIN CHECKS TO SEE IF * THE CORRESPONDING MONITOR IS DORMANT, AND IF SO, RESCHEDULES IT. * 4. UPDATES MASTER TCB TIMEOUT VALUES, IF A MASTER TCB TIMES-OUT, * OR IF IT IS DORMANT OR IF THE "BAD * CONTENTS" FLAG IN THE TCB IS SET, THE MASTER CLASS NUMBER * AND THE` TCB ARE CLEARED. IF IN A "WAIT" STATE, IT WRITES * A NULL REQUEST TO THE MASTER REQUESTERS CLASS. * 5. SCANS THE HP3000 PROCESS NUMBER LIST AND SENDS A "KILL" * REQUEST FOR ABANDONED PROCESS NUMBERS. * 6. IF QUEX SIGNALS HP3000 LINE DOWN (BY SETTING #CLRN RESOURCE * NUMBER), UPLIN CLEANS UP HP3000 TABLES: * * DELETES ALL PROCESS NUMBER LIST ENTRIES (PNL) * * SIMULATES TIME-OUT ON ALL HP3000 MASTER TCBS * * CLEARS ALL TST ENTRIES & CORRESPONDING SLAVE TCBS * 7. RELEASE ANY "DEAD" 1K #POOL ENTRIES IN THE PNL. * 8. RESCHEDULES "GRPM","RTRY", OR "QCLM" IF THEY ARE DORMANT. * 9. IF PLOG IS DORMANT BUT CLASS & SAM BUFFERS ARE ALLOCATED, * THEN BOTH ARE DEALLOCATED. * * * S#MAX EQU 12 MAX STREAM NUMBER + 1 A EQU 0 B EQU 1 SKP UPLIN EQU * JSB DTACH DETACH FROM SESSION CONTROL DEF *+1 LDA #FWAM CHECK TO SEE THAT DS IS INITIALIZED SZA,RSS JMP EXIT DS IS NOT INITIALIZED -- EXIT * LDA $OPSY RAR,SLA IS THIS AN RTE-III OR RTE-IV? RSSI RSS YES JMP *+4 NO LDB RSSI GET "RSS" STB MODI1 MODIFY TO DO CROSS-MAP STORE STB MODI2 MODIFY TO DO CROSS-MAP LOAD * * * (1.) CHECK FOR SYSTEM QUIESCENCE * LDA GLCW GET GLOBAL RN LOCK/CLEAR COMMAND RAL,ARS SET THE NO-WAIT BIT QRNWT STA RNCW SAVE CONFIGURED CONTROL WORD * JSB RNRQ GO TO RTE TO REQUEST DEF *+4 RESOURCE NUMBER STATUS, DEF RNCW OR TO AWAIT CLEARING OF THE RN. DEF #QRN ADDR OF QUIESCENT RN DEF TEMP RETURN STATUS JMP #1. IGNORE ERRORS * LDA RNCW IF PROGRAM HAS BEEN AWAITING CPA GLCW THE CLEARING OF #QRN, THEN JMP #1. BYPASS THE MESSAGE CODE. * LDA TEMP QRN STATUS LDB #BUSY ACTIVE TCB COUNT CPA K7 IF QRN WASZd LOCKED GLOBALLY, SZB AND NO ACTIVE TCB'S EXIST, SKIP JMP #1. ELSE BYPASS QUIESCENT CODE. * LDA GLCW RETURN TO IMMOBILIZE UPLIN JMP QRNWT * #1. EQU * END OF STEP 1 SKP * * (2.) THIS SECTION PROCESSES SLAVE TRANSACTIONS & MONITORS * LDA K2 ADA #LDEF STA PTR PNTR TO SLAVE LIST HEADER ADDRS IN RES CLA STA STREM SET STREAM # CKLST LDA PTR,I GET ADDRESS OF HEADER INA STA @CLAS SAVE ADDR OF MONITOR CLASS # INA ADDRESS OF SLAVE MONITOR NAME LDB @MON MOVE NAME TO LOCAL BUFFER JSB .MVW DEF K3 NOP LDA @MON,I GET FIRST 2 BYTES OF NAME STA ABORT AND SAVE ABORT BIT (BIT15) ELA,CLE,ERA THEN STRIP IT OFF STA @MON,I AND RESTORE 2 BYTES OF NAME SZA,RSS DOES MONITOR EXIST? JMP NXLST . NO TRY NEXT SLAVE LDB PTR,I NXTCB STB NXADR SAVE ADDR OF ADDR OF NEXT TCB * * ENTER HERE TO CHECK EACH SLAVE TCB FOR TIMEOUT * CKTCB LDB NXADR PICK UP ADDR OF ADDR OF TCB JSB LODWD (CROSS)LOAD ADDR OF TCB SZA,RSS IS IT THERE? JMP CKMON NO, END OF THIS LIST LDB A --> TCB JSB TIMER BUMP TIMER IN TCB JMP NXTCB DIDN'T TIMEOUT, CHECK NEXT TCB * * SLAVE TRANSACTION HAS TIMED OUT * INB --> TIMEOUT & 3K BIT (TCB+1) JSB LODWD RAL 3K BIT TO SIGN STA TEMP AND SAVE IT FOR LATER INB --> SEQUENCE NUMBER (TCB+2) JSB LODWD (CROSS)LOAD 1ST TIME TAG WORD STA SEQ# * JSB #RSAX DELETE SLAVE TCB DEF *+4 DEF K7 DEF SEQ# SLAVE SEQ # DEF STREM STREAM SSB SKIP IF ENTRY DELETED JMP NXLST WHOOPS! IGNORE THIS LIST * LDA TEMP CHECK IF THIS IS A 3K REQUEST SSdA,RSS JMP CONT . NO 1K REQUEST ... CONTINUE * JSB EXEC CLASS WRITE A 1-WORD MESSAGE DEF *+8 TO RPCNV SO IT WILL SEND REJECT DEF K20N TO 3K AND CLEAN UP TST. DEF K0 DEF SEQ# DEF K1 DEF K1 DEF K0 DEF #RPCV NOP * CONT EQU * CONTINUE * * CHECK MONITOR ABORT FLAG LDA ABORT SSA,RSS SKIP IF SET JMP CKTCB NOT SET, DON'T ABORT IT, CHECK NEXT TCB * * ABORT THE MONITOR BY GENERATING AN "OF,(NAME),1" MESSAGE * LDA @OFME --> 'OFF,XXXXXX,FL' LDB @OFBU --> STORAGE JSB .MVW MOVE MSG SO 'MESSS' WON'T DEF K7 WIPE IT OUT (DUMB ROUTINE) NOP LDA @MON --> SLAVE MONITOR NAME LDB @NAM --> 'MESSS' BUFFER JSB .MVW DEF K3 NOP * JSB MESSS CALL RTE MESSAGE PROCESSOR DEF *+3 @OFBU DEF OFBUF "OFF,XXXXXX,FL" (FL FOR 'L' COMPATIBILITY) DEF K13 JMP UPMON GO TO RE-SCHEDULE THE MONITOR. * * (3.) THIS CODE CHECKS MONITOR STATUS TO SEE IF IT HAS ABORTED CKMON LDA @MON,I 1ST WORD OF MONITOR NAME SZA,RSS DOES MONITOR EXIST? JMP NXLST . NO * JSB PGMAD CHECK SLAVES STATUS DEF *+2 @MON DEF MON SLAVE NAME SZA,RSS IF SLAVE NO LONGER EXISTS JMP NXLST THEN CHECK NEXT SLAVE (NEEDS WORK)... SZB RESCHEDULE IF DORMANT JMP NXLST ELSE MONITOR IS STILL GOING * * RESCHEDULE MONITOR UPMON LDA @CLAS,I GET CLASS NUMBER OF MONITOR RAL,CLE,ERA CLEAR SIGN BIT STA PARAM PARAMETER TO SCHEDULED ROUTINE * JSB SCHDL SCHEDULE MONITOR, PASS CLASS NUMBER MON BSS 3 * * DONE WITH THIS SLAVE LIST, START ON NEXT NXLST ISZ PTR POINT TO NEXT LIST HEADER ADDRESS ISZ STREM BUMP STREAM NUMBER LDA STREM CPA MAXS"# DONE? RSS . YES NOW CHECK MASTER TCBS JMP CKLST PROCESS NEXT LIST * * DONE WITH SLAVE MONITOR/TRANSACTION PROCESSING * #3. EQU * END OF STEP 3. SKP * (4.) PROCESS MASTER TCBS * LDB #MRTH MASTER TCB HEADER STB NXADR CCA STREM = -1 INDICATES STA STREM A MASTER TCB IN 'TIMER' CKMST LDB NXADR NEXT TCB ADDRESS SZB,RSS ANOTHER TCB? JMP #4. . NO JSB LODWD . YES, PROCESS IT STA NXADR SAVE LINK WORD (TO NEXT TCB) JSB TIMER DID THIS TCB TIME OUT? RSS . NO JSB TMOUT . YES CLEAN UP TABLES JMP CKMST * #4. EQU * END OF STEP 4. SKP * (5.) CLEANUP THE PROCESS NUMBER LIST (PNL). * LDB #PNLH PROCESS NUMBER LIST (PNL) HEADER STB NXADR CKPNL LDB NXADR NEXT PROCESS NUMBER ADDRESS STB PTR (SAVE FOR LATER) SZB,RSS ANOTHER ENTRY? JMP #5. . NO JSB LODWD . YES, GET LINK WORD STA NXADR NEXT PN ENTRY ADDRESS * INB --> HP3000 BIT (PNL+1) JSB LODWD STA TEMP SAVE BIT FOR LATER CHECK INB --> NODE NUMBER (PNL+2) JSB LODWD STA NODE ADB K2 --> ID SEG ADDRS (PNL+4) JSB STATE GET PGM STATE SZA DORMANT? SSA BAD ID SEGMENT? RSS . YES, SEND "KILL" MSG JMP CKPNL . NO LOOK AT NEXT ENTRY * INB --> PROCESS # (PNL+5) JSB LODWD (CROSS)LOAD PROCESS # STA KLBUF+4 SAVE FOR POSSIBLE "KILL". LDA TEMP CHECK FOR HP3000 PROCESS RAL SSA JMP OFF3K LOGOFF THE 3000 PNL * LDA PTR --> 1000 PNL ENTRY JSB #UPSM LOGOFF THE 1000 PNL JMP DELET * * SEND A "KILL" REQUEST TO THE 3000 DIRECTLY THROUGH QUEX. * SINCE THE "FROM PROCESS #" IN THE REQUEST IS ZERO (NORMALLY THE * MASTER CLASS NUMBER), QUEX WILL SEND $STDLIST TO "CNSLM" AND * IGNORE THE FINAL REPLY. * OFF3K LDA #QXCL I/O CLASS # FOR QUEX SZA,RSS IS HP3000 INCLUDED IN DS? JMP DELET NO. LEAVE PNL AS IS. SSA IS HP3000 DISCONNECTED? JMP DELET . YES, IGNORE 'KILL', JUST DELETE PNL * JSB EXEC CLASS WRITE "KILL" REQUEST TO QUEX. DEF *+8 DEF K20N DEF K0 DEF KLBUF DEF K8 DEF K8 DEF K0 DEF #QXCL NOP IGNORE ERRORS. * DELET JSB #RSAX DELETE PNL ENTRY. DEF *+4 DEF K10 CODE FOR "REMOVE". DEF KLBUF+4 SMP NUMBER. DEF NODE NODE NUMBER (-1 FOR HP3000) JMP CKPNL GO CHECK NEXT ENTRY. * KLBUF BYT 10,6 LENGTH,CLASS OCT 0 OCT 27 STREAM OCT 0,0,0,0,0 * #5. EQU * END OF STEP 5. SKP * (6.) IF QUEX HAS SET RN INDICATING HP3000 LINK DOWN CLEAN * UP ALL OF THE HP3000 TABLES IN SAM. * JSB RNRQ IS DEF *+4 HP3000 DEF LKCLR RESOURCE DEF #CLRN NUMBER DEF TEMP SET? NOP LDA TEMP CPA K7 LOCKED? RSS . YES CLEAN UP HP3000 BLOCKS JMP #6. . NO CONTINUE * * SCAN THRU PNL AND DELETE ALL HP3000 ENTRIES. * LDB #PNLH PNL HEADER STB NXADR CLPNL LDB NXADR SZB,RSS ANY MORE ENTRIES JMP MTCBS . NO CHECK MASTER TCBS JSB LODWD GET LINK WORD STA NXADR NEXT ENTRY INB --> 3000 BIT (PNL+1) JSB LODWD RAL CHECK FOR 1000 PNL SSA,RSS JMP CLPNL THIS IS A 1000 PNL, IGNORE IT ADB K4 POINT TO PROCESS # (PNL+5) JSB LODWD LOAD PROCESS # FOR SEARCH STA TEMP * JSB #RSAX DELETE PROCESS # LIST ENTRY DEF *+4 t DEF K10 CODE FOR "REMOVE" DEF TEMP SEARCH, USING PROCESS # DEF N1 NODE NUMBER (-1 FOR HP3000) JMP CLPNL * * SCAN THRU TCBS & SIMULATE TIMEOUT FOR ANY HP3000 * MASTER TCB. * MTCBS LDB #MRTH MASTER TCB HEADER STB NXADR NEXT LDB NXADR NEXT TCB ADDRESS SZB,RSS ANY MORE ENTRIES? JMP CLTST . NO CLEAR TST NOW JSB LODWD GET LINK WORD STA NXADR SAVE NEXT TCB ADDRESS * INB JSB LODWD GET TIMEOUT WORD (TCB+1) RAL GET TO BIT14 (HP3000 BIT) SSA,RSS HP3000 TCB? JMP NEXT . NO ADB N1 . YES, POINT B TO START OF TCB JSB TMOUT SIMULATE TCB TIMEOUT ACTION JMP NEXT * * CLEAR EACH ACTIVE TST ENTRY, ITS CORRESPONDING SLAVE TCB, * AND ITS CLASS (IF ALLOCATED). * CLTST EQU * LDA #TST+1 NUMBER OF ENTRIES SZA,RSS JMP UNLOK ALL DONE, UNLOCK QUEX CMA,INA STA CTR * LDB #TST ADDRESS OF TST TLOOP STB NXADR JSB LODWD (CROSS) LOAD STREAM WORD SZA,RSS JMP TBUMP STREAM ZERO MEANS ENTRY INACTIVE STA STREM SET UP STREAM NUMBER FOR RSAX CALL CLA JSB STRWD INACTIVATE ENTRY INB JSB LODWD STA SEQ# SEQUENCE NUMBER INB JSB LODWD CLASS # JSB DEFLU DEALLOCATE CLASS (IF ALLOCATED) * JSB #RSAX DELETE SLAVE TCB DEF *+4 DEF K7 DEF SEQ# DEF STREM * TBUMP LDB NXADR ADB K14 ISZ CTR JMP TLOOP * * UNLOCK RESOURCE NUMBER ACTIVATING QUEX UNLOK JSB RNRQ DEF *+4 DEF CLRRN (OCT 14004) DEF #CLRN DEF TEMP * #6. EQU * END OF STEP 6 SKP * (7.) INCREMENT IDLE TIMERS ON REMOTELY CREATED SESSIONS * CLA JSB #UPSM SPC 3 * (8.) RESCHEDULE HP1000 AND/OR HP3000 MONITORS IF THEY vARE DORMANT * LDA #LU3K IF NO HP3000 SZA,RSS CONNECTED, JMP RE1K GO RESCHEDULE HP1000 MONITORS. * * RESCHEDULE "QUEX", "RQCNV", OR "RPCNV" IF THEY ARE DORMANT * CLA STA PARAM SET UP SCHEDULING PARAMETER JSB SCHDL TRY TO SCHEDULE QUEX (IF DORMANT) ASC 3,QUEX JSB SCHDL TRY TO SCHEDULE RQCNV (IF DORMANT) ASC 3,RQCNV JSB SCHDL TRY TO SCHEDULE RPCNV (IF DORMANT) ASC 3,RPCNV * LDA #GRPM IF NO HP1000 SZA,RSS CONNECTED, JMP #8. ALL DONE! SPC 1 * * RESCHEDULE "GRPM", "RTRY", OR "QCLM" IF THEY ARE DORMANT * RE1K JSB SCHDL TRY TO SCHEDULE GRPM (IF DORMANT) ASC 3,GRPM JSB SCHDL TRY TO SCHEDULE RTRY (IF DORMANT) ASC 3,RTRY JSB SCHDL TRY TO SCHEDULE QCLM (IF DORMANT) ASC 3,QCLM * * SCHEDULE LU MAPPING IF FLAG SET * LDA #LUMP SZA,RSS JMP *+5 JSB SCHDL TRY TO SCHEDULE LUMAP (IF DORMANT) ASC 3,LUMAP * * SCHEDULE REMOTE SESSION MONITOR IF FLAG SET * LDA #RSM SZA,RSS JMP *+5 JSB SCHDL ASC 3,RSM * * CHECK IF REQUEST/REPLY CONVERTERS NEED BE SCHEDULED. * LDA #OTCV OUTPUT CONVERTERS CLASS # SZA,RSS CLASS ALLOCATED? JMP RE1K2 . NO TRY INPUT CONVERTER JSB PGMAD CHECK STATUS DEF *+2 OF OUTPUT DEF OTCNV CONVERTER SZB DORMANT? JMP RE1K2 . NO JSB SCHDL . YES SCHEDULE IT OTCNV ASC 3,OTCNV * RE1K2 EQU * LDA #INCV INPUT CONVERTERS CLASS # SZA,RSS CLASS ALLOCATED? JMP CHKMA . NO ALL DONE JSB PGMAD CHECK STATUS DEF *+2 OF INPUT DEF INCNV CONVERTER SZB DORMANT? JMP CHKMA . NO JSB SCHDL . YES SCHEDULE IT INCNV ASC 3,INCNV * * CHECK IF 'MATIC' NEElDS TO BE SCHEDULED * CHKMA LDA #MCTR SZA,RSS MA IN SYSTEM? JMP #8. . NO ALL DONE * JSB PGMAD GET MATIC'S STATUS DEF *+3 DEF MATIC DEF IDSEG * SSB MATIC IN TIME LIST? (STATUS < 0) JMP #8. . YES OK * JSB EXEC . NO PUT MATIC IN TIME LIST DEF *+6 DEF K12N INITIAL OFFSET SCHEDULE DEF MATIC PROGRAM NAME DEF K2 RESOLUTION (2=SECS) DEF K1 MULTIPLE (1=EVERY SECOND) DEF N2 RUN AFTER 2 SECONDS NOP WE DON'T CARE ABOUT ERRORS HERE. #8. EQU * END OF STEP 8 SKP * (9.) IF PLOG IS DORMANT BUT CLASS & SAM BUFFERS ARE ALLOCATED, * CLEAN & DEALLOCATE CLASS AND DEALLOCATE RESOURCE NUMBER * * LDA #PLOG CLASS ALLOCATED SZA,RSS FOR PLOG? JMP #9. . NO, ALL DONE * JSB PGMAD FIND STATE OF PLOG DEF *+2 DEF PLOG * CPB K6 STATE = 6? JMP OFFP . YES, OFF PLOG CMB,INB STATE > 0? SSB JMP #9. .YES, ALL DONE * OFFP JSB #OFF MAKE SURE PLOG DEF *+2 IS DORMANT DEF PLOG * LDA #PLOG+1 MAKE LOCAL COPY STA TEMP OF RESOURCE NUMBER LDA #PLOG HOLD CLASS NUMBER (FOR DEFLU) CLB CLEAR CLASS # AND STB #PLOG RESOURCE # IS RES STB #PLOG+1 * JSB DEFLU DEALLOCATE CLASS * LDA TEMP IS RESOURCE NUMBER SZA,RSS ALLOCATED? JMP #9. . NO ALL DONE * JSB RNRQ DEALLOCATE DEF *+4 RESOURCE NUMBER DEF RN32 DEF TEMP DEF TEMP NOP IGNORE ERROR * #9. EQU * END OF STEP 9 SKP *----------------------------------------------------------+ * EXIT UPLIN | *-----------------------------------------h%-----------------+ EXIT JSB EXEC DEF *+4 DEF K6 DEF K0 DEF N1 SKP * SUBROUTINES SPC 3 * ROUTINE TO TIME OUT MASTER TCB'S (B --> TCB) * * IF BAD ID SEGMENT OR MASTER IS DORMANT THEN CLEAR * CLASS # AND DEALLOCATE TCB. IF (MASTER) WAITING SEND * HIM A NULL MESSAGE TO INDICATE TIMEOUT. * BSS 1 (STORAGE) TMOUT NOP ADB K2 POINT TO SEQUENCE NUMBER (TCB+2) JSB LODWD LOAD SEQUENCE NUMBER STA SEQ# SAVE SEQUENCE NUMBER * INB POINT TO TCB+3 JSB LODWD AND GET CLASS STA TMOUT-1 AND SAVE IT AND =B77777 ISOLATE CLASS # SZA,RSS CLASS # = 0? JMP CLTCB .YES, JUST CLEAR THE TCB * INB POINT TO ID SEGMENT (TCB+4) JSB STATE GET PGM STATE RAL,CLE,SLA,ERA CLEAR OFF SIGN BIT JMP CLEAR "BAD CONTENTS", CLR CLASS & TCB SZA,RSS DORMANT? JMP CLEAR . YES, CLEAR CLASS AND TCB CPA K3 THIS MASTER IN WAIT STATE? RSS . YES, SEND HIM A NULL MESSAGE JMP TMOUT,I . NO ALL DONE * * WRITE A NULL REQUEST INTO THE MASTER REQUESTERS CLASS JSB EXEC DEF *+8 DEF K20N CLASS WRITE/READ, NO ABORT DEF K0 DEF K0 DEF K0 ZERO DATA LENGTH DEF SEQ# SEND SEQUENCE NUMBER TO WAITER DEF K0 ZERO REQUEST LENGTH DEF TMOUT-1 CLASS NUMBER * K0 NOP JMP TMOUT,I RETURN * * MASTER REQUESTER IS DORMANT, CLEAR CLASS AND TCB * CLEAR LDA TMOUT-1 JSB DEFLU CLEAR CLASS CLTCB EQU * JSB #RSAX CALL #RSAX TO PURGE MASTER TCB DEF *+3 DEF K6 DEF SEQ# SEQUENCE NUMBER OF MASTER TCB JMP TMOUT,I RETURN SPC 2 * THIS ROUTINE BUMPS THE TIMEOUT IN A TCB (B --> TCB) * AND CHECKS FOR BAD ID SEGMENTS IN MASTER TCBS. * 'STREM' MUST BE SET (-,1=MASTER TCB) * ON RETURN (P+1) IF TCB STILL ACTIVE * (P+2) IF TCB HAS TIMED OUT. * BSS 1 (STORAGE) TIMER NOP STB TIMER-1 SAVE ADDRESS OF THIS TCB LDA STREM GET STREAM SSA MASTER TCB? JMP TMTCB YES INB POINT TO 2ND WORD OF TCB (TCB+1) JSB LODWD (CROSS)LOAD TIMER SSA LONG TIMEOUT SET (SEE 'LTIME')? JMP TIME1+1 . YES, TIMEOUT ALREADY RESET AND FLMSK SAVE FLAG BITS (14-8) STA FLBYT LDA STREM GET STREAM CPA K3 SLAVE EXECW REQUEST? JMP LONGT YES, SET LONG TIMEOUT JMP TIME1 . NO JUST DO A TICK TMTCB ADB K4 POINT TO ID SEG ADDRS (TCB+4) JSB STATE GET PGM STATE SZA DORMANT? SSA BAD ID? (FLAG SET BY #RSAX) JMP TIME5 . YES RETURN AS TIMEOUT LDB TIMER-1 NO, POINT TO 2ND WORD INB OF TCB (TCB+1) JSB LODWD (CROSS)LOAD TIMER SSA LONG TIMEOUT SET? JMP TIME1+1 YES, INC TIMEOUT CNTR AND FLMSK SAVE FLAG BITS (14-8) STA FLBYT ADB K2 POINT TO CLASS (TCB+3) JSB LODWD GET CLASS WD/ TIMEOUT FLAG ADB N2 POINT TO TIMEOUT (TCB+1) SSA,RSS LONG TIMEOUT FOR THIS TCB? JMP TIME1 NO, JUST DO A TICK * LONGT LDA LTIME 20 MINUTE TIMEOUT IOR FLBYT RESTORE FLAG BITS (14-8) JMP TIME2 * TIME1 JSB LODWD RELOAD TIMER AND B377 ISOLATE IT CPA B377 IS IT ABOUT TO ROLL OVER? JMP TIME5 YES, DON'T BUMP IT, RETURN + 2 * JSB LODWD (CROSS)LOAD TIMER AGAIN INA BUMP TIMER TIME2 JSB STRWD (CROSS)STORE RSS RETURN +1 FOR NOT TIMED-OUT TIME5 ISZ TIMER RETURN +2 FOR TCB TIMED-OUT LDB TIMER-1 TCB ADDR INTO JMP TIMER,I RETURN SPC 3 * SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV) * LODWD NOP MODI2 LDA B,I GET WORD FROM TCB (RSS IF DMS SYSTEM) JMP LODWD,I RETURN IF RTE-II XLA B,I LOAD WORD FROM ALTERNATE MAP JMP LODWD,I SPC 3 * SUBROUTINE TO STORE A WORD IN ALTERNATE MAP (IF RTE-III OR IV) * STRWD NOP JSB $LIBR LOWER FENCE NOP MODI1 NOP RSS HERE IF DMS SYSTEM JMP TIME3 XSA B,I STORE INTO SYSTEM MAPPED LOCATION RSS * BELOW INSTRUCTION IS EXECUTED FOR NON-DMS SYSTEMS ONLY TIME3 STA B,I STORE UPDATED TIMER IN TCB JSB $LIBX RAISE FENCE DEF STRWD RETURN SPC 3 * STATE- GETS PROGRAM STATE (STATUS) * ON ENTRY --> [.] --> ID SEGMENT * ON RETURN = PGM STATE(>0) OR ID SEG ADR(<0) * BSS 1 (STORAGE) STATE NOP JSB LODWD GET ID SEG ADDRESS SSA BAD ID SEGMENT? (-) JMP STATE,I . YES RETURN STB STATE-1 SAVE CMA,INA NEGATIVE ID SEG ADDRESS STA IDSEG TELLS PGMAD TO USE IT (NOT NAME) JSB PGMAD GET PGM STATUS DEF *+3 DEF OFBUF (DUMMY BUFFER FOR NAME) DEF IDSEG LDA B RETURN STATUS IN SSA CHECK FOR TIME LIST ( < 0) LDA TL AND USE ALTERNATE STATUS CODE LDB STATE-1 JMP STATE,I RETURN W/ STATUS IDSEG BSS 1 SPC 3 * DEFLU - DEALLOCATES A CLASS (AND FLUSHES BUFFERS) * ( CONTAINS CLASS NUMBER) * BSS 1 (STORAGE) DEFLU NOP AND CLMSK ISOLATE CLASS NUMBER (BITS 12-0) SZA,RSS CLASS ALLOCATED? JMP DEFLU,I . NO JUST RETURN STA DEFLU-1 * JSB CLRQ DEALLOCATE CLASS DEF *+3 DEF CLRQ2 DEF DEFLU-1 NOP JMP DEFLU,I SPC 3 * SUBROUTINE TO SCHEDULE A PROGRAM (IF DORMANT) * SCHDL NOP JSB EXEC SCHEDULE DEF *+4 DEF K10N NLH DEF SCHDL,I DEF PARAM PRAM TO KEEP RPCNV/PLOG HAPPY NOP LDB SCHDL SET RETURN ADB K3 ADDRESS JMP B,I RETURN PARAM NOP P1 SKP *----------------------------------------------------------+ * CONSTANTS | *----------------------------------------------------------+ @NAM DEF OFBUF+2 N1 DEC -1 N2 DEC -2 K1 DEC 1 K2 DEC 2 K3 DEC 3 K4 DEC 4 K6 DEC 6 K7 DEC 7 K8 DEC 8 K10 DEC 10 TL EQU K10 ALTERNATE STATUS -- TIME LIST K13 DEC 13 K14 DEC 14 CLRQ2 OCT 140002 MAXS# ABS S#MAX MAXIMUM NUMBER OF STREAMS + 1 B377 OCT 377 FLMSK OCT 077400 CLMSK OCT 017777 LTIME OCT 100020 K10N DEF 10,I K12N DEF 12,I K20N DEF 20,I GLCW OCT 040006 GLOBAL RN LOCK/CLEAR - NO ABORT CLRRN OCT 140004 LKCLR OCT 140006 @OFME DEF *+1 ASC 7,OFF,XXXXXX,FL MATIC ASC 3,MATIC PLOG ASC 3,PLOG RN32 OCT 040040 UNS *----------------------------------------------------------+ * STORAGE | *----------------------------------------------------------+ FLBYT BSS 1 OFBUF BSS 6 RNCW BSS 1 STREM BSS 1 NXADR BSS 1 TEMP BSS 1 SEQ# BSS 1 PTR BSS 1 CTR BSS 1 ABORT BSS 1 @CLAS BSS 1 NODE BSS 1 * SIZE EQU * END UPLIN BN r 91750-18180 2013 S C0122 &VCPMN +              H0101 sASMB,R,L,C * * NAME: VCPMN * SOURCE: 91750-18180 * RELOC: 91750-16180 * PRGMR: D. L. M. * *********************************************************** * COPYRIGHT HEWLETT-PACKARD CO 1980. ALL RIGHTS RESERVED. * * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED * * OR TRANSLATED INTO ANOTHER PROGRAM LANGUAGE WITHOUT THE * * PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD CO. * *********************************************************** * NAM VCPMN,19,30 91750-16180 REV.2013 800328 M,4B,L ENT VCPMN EXT FTIME,EXEC,KCVT,SYCON,#NRVS,RMPAR,DTACH,CNUMD * * THIS IS THE INITIAL CLASS GET SUSPENDS THE PROGRAM UNTIL * THE PROGRAM QUEUE PUTS SOMETHING INTO THE CLASS. * SUP PRESS EXTRA LISTING VCPMN JSB RMPAR GET CLASS NUMBER FOR SYSTEM DEF *+2 DEF CLSS# LOCATION * JSB DTACH DETACH FROM SESSION DEF *+1 RETURN READ LDA CLSS# GET NUMBER AND =B37777 MASK OUT ALL UNNEEDED BITS IOR =B20000 DON'T DE-ALLOCATE STA CLSS# AND STORE IN THE BUFFER JSB EXEC DO READ ON THE CLASS DEF R1 DEF CLGET DEF CLSS# DEF MSGBF DEF MSGLN DEF LU# DEF MTYPE R1 EQU * * STB PRNLN SAVE LENGTH * JSB FTIME GET CURRENT TIME IN A STRING DEF R2 DEF TIMBF R2 EQU * SKP * LDA LU# GET LU NUMBER CMA,INA MAKE NEGATIVE STA NODE# RESTORE * JSB KCVT CONVERT TO ASCII DEF *+2 DEF LU# THE LU NUMBER * STA LU# RESTORE * JSB #NRVS GET NODE NUMBER FROM LU. DEF R3 DEF NODE# NEGATIVE LU NUMBER DEF NAYBR+1 DUMMY LOCATIONS DEF NAYBR+2 FOR THE CALL DEF NAYBR DUMMY LOCATION DEF NODE CORRECT NODE NUMBER R3 EQU * * JMP NFND NO ERROR SHOULD OCCUR JSB CNUMD CONVERT TO AN ASCII NUMBER %   DEF *+3 DEF NODE DEF NODE# * FOUND JSB SYCON NOW WRITE MESSAGE!!! DEF *+3 DEF BUF DEF TIMLN * LDA PRNLN GET LENGTH AGAIN CPA B1 ONE WORD ONLY? JMP PDUMP YES - POSSIBLE DUMP REQUEST PRINT JSB SYCON WRITE THE DS MESSAGE DEF *+3 DEF MSGBF MESSAGE RECEIVED AND LENGTH DEF PRNLN * R4 JMP READ DO IT ALL OVER AGAIN!! * NFND LDA =A?? DON'T KNOW WHAT NODE IT IS STA NODE# STA NODE#+1 STA NODE#+2 JMP FOUND * SKP PDUMP LDA MSGBF GET THE WORD ALF,ALF LOOK AT UPPER BYTE AND =B377 MASK OFF ALL OTHERS CPA B1 IS IT A DUMP? JMP PRINT NO - PRINT IT * JSB SYCON DEF *+3 DEF DPMSG DEF DPMSL * JMP READ GO BACK TO READING DS * BUF ASC 9,**BREAK** ON NODE NODE# BSS 3 ASC 3,, LU LU# NOP ASC 2, AT TIMBF ASC 15, TIMLN DEF *-BUF MSGBF ASC 28, DPMSG ASC 17,DUMP REQUEST PENDING ON THIS NODE DPMSL DEF *-DPMSG CLSS# BSS 5 CLGET DEC 21 WRITE OCT 2 WCTRL OCT 201 MSGLN ABS -56 MTYPE NOP RDCNT NOP LEN NOP M2 DEC -2 B1 OCT 1 PRNLN BSS 1 NAYBR BSS 3 DUMMY LOCATION NODE NOP END VCPMN  sz 91750-18181 2013 S C0122 &XDV00 +              H0101 XASMB,R,Q,C HED "VIRTUAL TERMINAL" DRIVER FOR RTE-L REV 800327 NAM XDV00,0 91750-16181 REV.2013 800327 (L) * * SPC 2 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 *************************************************************** * * "VIRTUAL TERMINAL" DRIVER FOR DS/1000 * SIMULATES DVR00/DVR05 TO SOURCE SYSTEM. ALL I/O REQUESTS * SENT TO PROGRAM "LUMAP" FOR CONVERSION TO REMOTE 'EXEC' * CALLS. * * * NAME: XDV00 * SOURCE: 91750-18181 * RELOC: 91750-16181 * PGMR: JOHN LAMPING * * WRITTEN BY LYLE WEIMAN [MAY 1979] * MODIFIED BY JOHN LAMPING [OCTOBER 1979] * * *************************************************************** SPC 3 * * DEFINE ENTRY POINTS * ENT IDV00,DDV00 SPC 1 * * DEFINE EXTERNALS * EXT $XQSB,$ATTN,#SPLU,$DVLU,$Q.PV EXT $LUTA,$LUT# EXT $IF5 EXT $DV1,$DV2,$DV3,$DV4,$DV5,$DV6,$DV7,$DV8,$DV9,$DV10 EXT $DV11,$DV12,$DV13,$DV14,$DV15,$DV16,$DV17,$DV18 EXT $DV19,$DV20,$DV21,$DV22 * * IN THIS DRIVER, THE TERM "I/O MAP" IS USED TO REFER TO THE MAPPING * BETWEEN LUS AT THE SOURCE NODE, AND DESTINATION NODE AND LU NUMBERS. * IT HAS NOTHING TO DO WITH "SESSION LU MAPPING", ALTHOUGH IT CAN * OPERATE WITHIN THAT CONTEXT (PROVIDING TWO LEVELS OF I/O MAPPING, * WHICH CAN PERHAPS BE CONFUSING). TO ALLAY THIS CONFUSION, THE * TERM WILL IS ONLY USED HERE WITHIN THE FORMER CONTEXT. * * THE "MAPPING" FROM AN LU IN THE SOURCE SYSTEM TO A DESTINATION NODE * AND LU NUMBER IS PQERFORMED BY THE DRIVER, BUT THE ENTIRE OPERATION * REQUIRES ASSISTANCE FROM PROGRAMS "LUQUE" AND "LUMAP". SPC 5 * CALLING SEQUENCES (ORDINARY I/O): * * (NOTE: PRIOR TO ESTABLISHING A MAP FOR AN LU, XDV00 COMPLETES * ALL I/O REQUESTS TO THAT LU WITHOUT TRANSFERRING ANY DATA, I.E., * IT IGNORES ALL I/O REQUESTS). * SPC 2 * "READ" OR "WRITE" DATA SPC 1 * JSB EXEC * DEF *+5,6 OR 7 * DEF RCODE OCT 1 OR 2 * DEF CONWD LU (ANY LU EXCEPT "RESERVED" LU) * ANY SUBFUNCTION BITS EXCEPT "Z" BIT MAY BE SET * THE "Z" BIT MAY ONLY BE SET ON READ REQUESTS * DEF DBUF DATA BUFFER ADDRESS * DEF DBUFL DATA BUFFER LENGTH (+ WORDS OR - CHARS) * LIMIT: 512 WORDS, THE LENGTH OF THE BUFFER IN 'LUMAP' * [DEF IPRM1] 1ST OPTIONAL PARAMETER * [DEF IPRM2] 2ND OPTIONAL PARAMETER SPC 2 * THE FOLLOWING ERROR CONDITIONS RESULT IN I/O REJECT: * * 1) DOUBLE-BUFFER ("Z") BIT SET EXCEPT ON READ REQUESTS * 2) ORDINARY I/O ISSUED UPON "RESERVED" LU * 3) BUFFER LENGTH >512 WORDS * SPC 2 * CONTROL REQUESTS: * * JSB EXEC * DEF *+3 OR 4 * DEF D3 * DEF CONWD MAY SET ANY SUBFUNCTION BITS * [DEF ] * * I/O REJECT IF: * * 1) "RESERVED" LU IS USED * * UPON RETURN, (A)-REGISTER CONTAINS STATUS INFORMATION AS * RETURNED BY ACTUAL DRIVER AT DESTINATION NODE. * (B)-REGISTER CONTAINS ACTUAL DRIVER-SUPPLIED TRANSMISSION LOG. * SKP * CALLING SEQUENCES ON "RESERVED" LU: * * NOTE: THE "RESERVED LU" IS MEANT TO BE USED ONLY FOR COMMUNICATION * BETWEEN XDV00 AND PROGRAMS 'LUQUE' AND 'LUMAP'. * * THE FIRST TIME THE DRIVER IS ENTERED, IT WILL SET #SPLU TO THE * FIRST LU POINTING TO A DVT WITH A ZERO-LENGTH EXTENSION * THIS LU BECOMES THE RESERVED LU. * * SUB-FUNCTION SUMMARY: * SUB- ACTION * FUNCTION * -------- ----------------------------- * CONTROL CALLS: * * 35 OBTAIN SYSTEM ATTENTION * 36 RE-TRY ORIGINAL REQUEST AFTER 1 SEC * 37 'STOP': ERROR ON ORIGINAL REQUEST. "COMPLETE" ORIGINAL * REQUEST WITH I/O TIME-OUT INDICATION. * * READ & WRITE CALLS: * * 36 (WRITE) SET UP I/O MAP * 36 (READ) RETURN I/O MAP INFORMATION ON SPECIFIED LU * 37 (READ) SEND REQUEST INFO TO 'LUQUE' * 37 (WRITE) SEND REPLY TO ORIGINAL REQUESTOR * * ALL OTHER CODES IGNORED * * * TO SET UP THE I/O-MAPPING FUNCTION: * * JSB EXEC * DEF *+5 * DEF D2 * DEF CONWD "RESERVED" LU + 3600B * DEF BUFFR SET-UP BUFFER (SEE BELOW) * DEF D4 * * SET-UP BUFFER FORMAT: * * 1 SECURITY CODE (25834) * * 2 "SOURCE" LU NUMBER (IF -1 THEN DRIVER WILL FIND AN UNUSED LU * FROM THE SET OF LUS WHICH "POINT" TO THIS DRIVER--I.E., ONE * WHICH DOES NOT ALREADY HAVE AN I/O MAP CURRENTLY SET UP, AND * EXCLUDING THE "RESERVED" LU--AND RETURN THAT LU IN THE B- * REGISTER, AND SET UP THE I/O MAP FOR IT ACCORDING TO THE * SPECIFICATIONS IN THE REMAINDER OF THIS BUFFER. ZERO IS * RETURNED IF NO LU CAN BE FOUND). * * 3 DESTINATION LU NUMBER * SET BIT 15 IF MESSAGE HEADER IS TO BE APPENDED ("WRITES" ONLY) * SET BIT 14 IF "PROMPT" IS TO BE APPENDED ("READS" ONLY) * THE TWO FUNCTIONS MAY BE COMBINED. * * 4 DESTINATION NODE NUMBER * * THE FOLLOWING ERROR CONDITIONS RESULT IN AN I/O REJECT: * * 1) SECURITY CODE SPECIFIED DOES NOT MATCH 25834 * * 2) SOURCE LU INVALID (NOT IN RANGE 1 TO $LUT#) * * 3) SOURCE LU SPECIFIED IS SAME AS "RESERVED" LU, OR POINTS TO * SAME DVT * * 4) SOURCE LU DOES NOT "POINT" TO XDV00 * * 5) DVT EXTENSION NOT EQUAL TO 5 WORDS * SPC 2 * TO RETURN I/O MAP INFORMATION ON A SbqPECIFIED LU: * * JSB EXEC * DEF *+6 * DEF D1 "READ" * DEF CONWD "RESERVED" LU + 3600B * DEF BUFFR RETURN DATA BUFFER * DEF D2 RETURNS TWO DATA WORDS * DEF LU LOGICAL UNIT WHOSE I/O MAP IS TO BE RETURNED. * * UPON RETURN: * BUFFR(1) = DESTINATION NODE NUMBER (-1 IF LU DOES NOT * "POINT" TO THIS DRIVER) * BUFFR(2) = DESTINATION NODE LU NUMBER, OR ZERO IF MAP ENTRY IS EMPTY. * THE LU NUMBER WILL HAVE BITS 15 AND 14 SET AS SPECIFIED * IN THE SETUP CALL SKP * THE NORMAL SEQUENCE OF EVENTS IS SUMMARIZED BELOW: * * 1) ORDINARY PROGRAM (ONE WHICH HAS NOT BEEN SPECIFICALLY MODIFIED * FOR REMOTE-EXEC I/O) CALLS EXEC FOR I/O, SPECIFYING AN LU WHICH * "POINTS" TO THIS DRIVER. THE REAL-TIME I/O CONTROL * MODULE CALLS THIS DRIVER. THE REQUEST IS ASSIGNED A SEQUENCE * NUMBER BY THE DRIVER. * * 2) THE DRIVER SCHEDULES "LUQUE", PASSING IT THE ADDRESS OF THE * ORIGINAL REQUEST'S DVT, LENGTH, DESTINATION NODE NUMBER, AND * AND SEQUENCE NUMBER. * * 3) LUQUE ISSUES A CLASS-I/O "READ" CALL, SPECIFYING A "RESERVED" * LU (THIS ONE IS NOT FOR USE BY "ORDINARY" PROGRAMS, AND THUS * IS NOT NORMALLY "BUSY" AT THIS TIME). THE ADDRESS OF THE * ORIGINAL REQUEST DVT IS PASSED BACK TO THE DRIVER IN ONE * OF THE I/O PARAMETERS. THE CLASS NUMBER USED IS THE ONE * ON WHICH "LUMAP" IS SUSPENDED. * * 4) THE DRIVER LOCATES THE ORIGINAL REQUEST'S DVT VIA THE I/O PARAMETER. * IT COPIES THE ORIGINAL REQUEST I/O PARAMETERS (ACTUAL DEVICE NODE * AND LU NUMBER, SUB-FUNCTION, ETC.), AND DATA IN THE CASE THAT THE * ORIGINAL REQUEST WAS A "WRITE", INTO THE BUFFER IN SYSTEM AVAILABLE * MEMORY PROVIDED BY THE LUQUE'S CLASS-I/O REQUEST. * THE DRIVER RETURNS I/O COMPLETION STATUS ON THIS REQUEST, * CAUSING "LUMAP" TO BE SCHEDULED. AND CHAqNGES THE TIMEOUT * ON THE ORIGINAL REQUEST TO BE SET TO THE MASTER TIMEOUT. * * 5) LUMAP DETERMINES THAT THIS IS A NEW REQUEST, ENTERS INFORMATION * IN A TABLE IT KEEPS, AND BUILDS A REMOTE-EXEC CALL FROM THE * INFORMATION SUPPLIED. RATHER THAN WAIT FOR THE REPLY, AS DO * OTHER REMOTE-EXEC CALLS, IT RETURNS TO ITS "GET" TO AWAIT THE * NEXT NEW REQUEST, OR THE REPLY. THE SAME CLASS NUMBER IS USED * FOR BOTH. * * 6) AT THE DESTINATION NODE, "EXECM" PERFORMS THE REQUESTED I/O * OPERATION AND RETURNS THE REPLY. * * 7) WHEN THE REPLY ARRIVES, GRPM RE-QUEUES IT TO LUMAP'S CLASS, AS IT * RE-QUEUES ALL REPLIES TO THE APPROPRIATE MASTER PROGRAM. * LUMAP DETERMINES THE PROPER ORIGINAL REQUESTOR FROM INFORMATION * IN ITS INTERNAL TABLE, AND MAKES A CLASS-I/O "WRITE" CALL TO THIS * DRIVER, SPECIFYING THE "RESERVED" LU AND THE ORIGINAL REQUEST'S * DVT ADDRESS, AND DATA IN THE CASE WHERE THE ORIGINAL REQUEST * HAD BEEN A "READ". THE SAME CLASS NUMBER IS USED FOR THIS, ALSO. * IT THEN RETURNS TO ITS "GET". * * 8) THE DRIVER LOCATES THE ORIGINAL REQUEST DVT. IF THE ORIGINAL * REQUEST HAD BEEN A "READ", THEN DATA IS TRANSFERRED BACK TO * THE ORIGINAL PROGRAM'S BUFFER. THE ACTUAL DEVICE TYPE AND * STATUS (FROM EQT 5/DVT 6) RETURNED BY THE ACTUAL DRIVER * USED ARE STORED IN THE ORIGINAL REQUEST'S DVT WORD 6. * NOTE THAT THIS FEATURE IS INTENDED TO BE USED SO THAT AN "INNOCUOUS" * I/O REQUEST BE MADE AFTER THE I/O MAP IS SET UP, PRIOR TO SCHEDULING * ANY PROGRAMS WHICH USE THAT LU. THE RETURNED STATUS, POSTED IN * THE DVT, SOLVES THE PROBLEM WHICH WOULD OTHERWISE EXIST BY THE * POSSIBILITY THAT THE PROGRAM MAY ISSUE AN EXEC (13) I/O STATUS * REQUEST TO A MAPPED LU, WHICH IS HANDLED ENTIRELY BY RTIOL, * WITHOUT ANY ASSISTANCE FROM THE DRIVER. THUS, THE CORRECT * DEVICE TYPE ANDA= STATUS WILL BE OBTAINED. * * 9) THE DRIVER DOES A I/O COMPLETION RETURN ON BOTH THE RESERVED DVT * AND THE ORIGINAL REQUEST DVT. * * 10) LUMAP IS RE-SCHEDULED TO PROCESS THE I/O COMPLETION OF ITS "WRITE" * REQUEST. IT SIMPLY GOES BACK TO ITS "GET". * * AT STEPS 4 AND 9 ABOVE, WHERE THE DRIVER NEEDS TO TAKE ACTION ON TWO * DVT'S AT THE SAME TIME, THE MECHANISM IS AS FOLLOWS. IT SETS THE * CONTINUATION CODE IN THE ORIGINAL REQUEST'S DVT TO THE ACTION IT * WANTS TO PERFORM, PLACES THE IFT ON THE PHYSICAL DONE QUEUE, * SETS THE ADDRESS OF THE ORIGINAL DVT IN THE IFT EXTENSION, ALONG WITH * A TIMEOUT, AND TAKES A LOGICAL WAIT EXIT. RTIOL WILL ENTER THE * THE ORIGINAL DVT WITH A LOGICAL CONTINUE WHICH WILL BE PROCESSED * ACCORDING TO THE CONTINUATION CODE. THE DRIVER WILL PLACE THE IFT * BACK ON THE DONE QUEUE POINTING TO THE RESERVED DVT AND WILL * DO A LOGICAL DONE WHEN RE-ENTERED. IT IS NECESSARY TO USE THE * DONE QUEUE TWICE AS DESCRIBED ABOVE TO PREVENT CONTENTION FOR * THE IFT BY TWO MAPPING REQUESTS. SPC 2 * THE SEPARATE CALLS TO THE DRIVER MENTIONED ABOVE ARE DESCRIBED * BELOW IN MORE DETAIL. SPC 2 * A "READ" REQUEST IS ISSUED BY 'LUQUE' (SCHEDULED BY THIS DRIVER * WHENEVER AN I/O REQUEST IS MADE ON ANY LU EXCEPT THE "RESERVED" ONE). * THE REQUEST LENGTH MUST BE AT LEAST 9 WORDS (PLUS USER DATA LENGTH, * IN THE CASE OF A "WRITE" REQUEST). * * JSB EXEC * DEF *+7 * DEF D17 CLASS "READ" * DEF <"RESERVED" LU> SUB-FUNCTION = 37 (8) * DEF * DEF * DEF * DEF * * * * INFORMATION RETURNED BY DRIVER IN : * * WORD CONTENTS * ---- ----------------------------------- * 1 DESTINATION NODE NUMER * 2 DESTINATION NODE LU NUMBER * 3 ORIGINAL REQUEST CONTROL WORD (ALL 16 BITS) * 4 ORIGINAL REQUEST LENGTH (+ WORDS OR - CHARS) * 5 " " " OPTIONAL PARAMETER 1 * 6 " " " OPTIONAL PARAMETER 2 * 7 " " " " " 3 * 8 ID SEGMENT ADDRESS OF CALLER (OR ZERO, IF SYSTEM) * 9 SEQUENCE NUMBER (ASSIGNED BY DRIVER) * 10 & FOLL.: USER-SPECIFIED DATA BUFFER ("WRITE" REQUESTS ONLY) * * NOTE: WORDS 1 THRU 9 ARE CALLED THE "DRIVER REQUEST HEADER AREA" SPC 5 * A "WRITE" REQUEST IS ISSUED BY LUMAP WHEN THE REPLY COMES BACK. * * JSB EXEC * DEF *+7 * DEF D18 CLASS "WRITE" * DEF SUB-FUNCTION = 37(8) * DEF * DEF * DEF * DEF * * PRIOR TO THE CALL, DATA MUST BE SET UP IN THE BUFFER IN THE FOLLOWING * FORMAT: * * 1 (A)-REGISTER STATUS UPON I/O COMPLETION (ACTUAL DEVICE STATUS) * THIS VALUE IS PLACED IN DVT WORD 6 * 2 "ACTUAL" DEVICE TRANSMISSION LOG * 3 EXTENDED STATUS WORD 1 * 4 " " " 2 * * WORDS 5 & FOLLOWING ARE FILLED BY THE DRIVER ("READ" * REQUESTS ONLY) * 5 ORIGINAL \ * 6 DATA, "READ" * 7 AS REQUESTS * ... ONLY * N+4 READ / * * NOTE: WORDS 1 THRU 4 ARE CALLED THE "DRIVER REPLY AREA" * * I/O REJECT IF NOT CLASS-I/O REQUEST SKP * OTHER CAPABILITIES, NOT DESCRIBED ABOVE: SPC 2 * ----TO OBTAIN SYSTEM ATTENTION, AS IN REMOTE USE---------------------- * (SIMULATES OPERATOR STRIKING KEYBOARD ON LU # 1) * * JSB EXEC * DEF *+4 * DEF D3 * DEF LU "RESERVED" LU + 3500 * DEF "ATTENTION" LOGICAL UNIT, I.E., LU SYSTEM SENDS * "PROMPT" & "READ" TO. * THE MUST BE A MAPPABLE LU. * * ----TO CAUSE THE DRIVER TO RETRY THE REQUEST ----------------------- * * JSB EXEC *  DEF *+7 * DEF RCODE OCT 2 * DEF CONWD LU + 3400 * DEF <0> * DEF <0> * DEF * DEF SPC 2 * ----A 'STOP' REQUEST IS SENT TO THE DRIVER, VIA THE "RESERVED" LU,----- * IF THE REQUEST CANNOT BE HONORED, DUE TO AN ERROR -- ANY ERROR). SPC 1 * JSB EXEC * DEF *+7 * DEF RCODE OCT 2 * DEF CONWD LU + 3500 = 'STOP' * DEF <0> * DEF <0> * DEF IDENTIFIES ORIGINAL REQUEST * DEF SKP * * ERROR CODES (IN DVT 5 STATUS) -- SAME AS RETURNED BY ACTUAL * DEVICE DRIVER AT DESTINATION NODE * * * * DVT WORD USAGE BREAKDOWN * * DVT# USE * 6 !AV! EQUIPMENT TYPE! STATUS! * 13 TIME-OUT VALUE * 15 REQUEST CONTROL WORD (CONWD) * 16 ADDRESS OF DATA BUFFER * 17 LENGTH OF DATA BUFFER; ON EXIT, TRANSMISSION LOG * 18 1ST OPTIONAL PARAMETER * 19 2ND OPTIONAL PARAMETER * 22 ADDRESS OF DVT EXTENSION AREA * * STATUS FIELD FILLED IN FROM ACTUAL DEVICE * STATUS AT DESTINATION COMPUTER. FIELD IN "RESERVED" * DVT IS MEANINGLESS. * * DVT EXTENSION AREA * 1 SEQUENCE NUMBER * 2 CONTINUATION CODE * 3 # RETRIES COUNTER, FOR ATTEMPTS TO SCHEDULE LUQUE * 4 DESTINATION NODE # * 5 DESTINATION NODE LU # * * * * THE "CONTINUATION CODE" IS USED TO DIRECT CONTROL TO THE * NEXT STAGE OF PROCESSING AFTER AN I/O TIME-OUT. * THE CODE IS VALIDATED BEFORE BEING ADDED TO THE "CONTINUATION * JUMP TABLE ADDRESS" TO OBTAIN THE ADDRESS OF THE CONTINUATION * PROCESSOR. HED DRIVER INITIALIZATION SECTION DREQL EQU 9 SIZE OF DIRVER "REQUEST" AREA DRPYL EQU 4 SIZE OF DRIVER "REPLY" AREA SPC 2 DDV00 NOP z STA DIREC SAVE DIRECTIVE CODE LDA $DV22,I SET UP DVT JSB SEXT EXTENSION POINTERS LDA DIREC RECOVER DIRECTIVE CODE AND B3 MASK DIRECTIVE CODE CPA B1 INITIATE? JMP INIT YES CPA B2 CONTINUE? JMP CNTNU YES CPA B3 TIME-OUT? JMP TMOUT YES JMP IEXIT IMMEDIATE COMPLETION ON ALL OTHERS * INIT EQU * LDA $DV6,I CLEAR OLD STATUS AND =B177600 STA $DV6,I LDB $DV20,I RBL,CLE,ERB CLEAR "FIRST ENTRY" INDICATOR STB $DV20,I LDB SPDVT SPECIAL DVT SZB FOUND YET? JMP IV1 YES * * THIS IS THE FIRST TIME THIS DRIVER HAS BEEN ENTERED. * WE MUST LOCATE THE RESERVED DVT AND ITS LU NUMBER. * THIS CODE IS ONLY EXECUTED THIS ONCE AND WILL BE * OVERLAYED BY TEMPORARIES LATER. * OVRLY EQU * * LDB $DV5,I GET ADB =D6 IFT LDA B,I EXTENSION AND =B777 LENGTH CPA =D2 BETTER BE 2 RSS OK JMP REJCT NO, NO LU MAPPING FOR THIS DUDE LDB $DV1 GET POINTER TO FIRST DVT SPSR1 LDA B GET ADA =D20 WORD LDA A,I 21 SZA,RSS ANY EXTENSION OR PARAMETERS? JMP SPSR2 NO, THIS IS IT ADB B3 YES, ADVANCE TO NEXT DVT LDB B,I IN CIRCULAR LIST CPB $DV1 IS THIS WHERE WE GOT ON? JMP REJCT YES, NO RESERVED DVT, BAD GEN JMP SPSR1 NO, TRY NEXT ONE SPSR2 STB SPDVT SAVE RESERVED DVT POINTER JSB $DVLU SET ITS LU STA #SPLU FOR OTHER FOLKS TO SEE LDB SPDVT * * OVREN EQU * END OF OVERLAY AREA * IV1 CPB $DV1 IS THIS THE "RESERVED" DVT? JMP SPECL YES SPC 2 * HERE FOR ALL I/O ON NON-"RESERVED" LU * * THE 'LUQUE' PROGRAM IS SCHEDULED TO PERFORM THE CLASS-I/O "READ"). * # DRIVER EXITS, AND PROCESSING RESUMES WHEN THE CLASS "READ" REQUEST * IS MADE ON THE DRIVER, BEGINNING AT LABEL "MVRED" (ASSUMING THAT * 'LUQUE' IS SCHEDULABLE, AND NO OTHER ERRORS ARE DETECTED). * * THE CLASS-I/O REQUEST GOES TO XDV00 ON ITS "RESERVED" * LU. SINCE NO OTHER I/O REQUESTS ARE ALLOWED ON THIS LU AND * IT ALWAYS COMPLETES THESE REQUESTS IMMEDIATELY, THIS DVT * IS NEVER BUSY. SPC 2 LDA $DV21,I DOES THIS DVT ADA MEXTZ HAVE THE CORRECT SZA LENGTH EXTENSION? JMP REJCT NO LDA $DV15,I GET THE REQUEST CODE RAR,SLA,RAL IS THIS A READ? RSS JMP ORDA YES, Z BIT IS OK IOR ZBIT IS THE CPA $DV15,I Z BIT SET? JMP REJCT YES--ERROR! ORDA AND B3 CONTROL CPA B3 REQUEST? JMP ORDI YES LDA $DV17,I JSB CHTW CONVERT WORD COUNT TO CHARACTER COUNT ADA MAXBF BUFFER LENGTH SSA,RSS GREATER THAN MAX. ALLOWED? JMP REJCT YES, REJECT IT. LDA $DV15,I IS THIS A AND ZBIT DOUBLE BUFFERED SZA,RSS WRITE/READ? JMP ORDC NO LDA $DV19,I YES, CHECK LENGTH JSB CHTW OF SECOND BUFFER ADA MAXBF SSA,RSS JMP REJCT TOO LONG JMP ORDC * ORDI LDA $DV16,I MOVE PARAMETER STA $DV18,I TO A BETTER SPOT * ORDC EQU * LDB EXTLU,I PICK UP DESTINATION LU FROM I-O MAP SZB,RSS DOES THIS ENTRY HAVE AN ACTIVE MAP IN IT? JMP LOG0 NO, IGNORE THIS REQUEST SPC 2 LDA SEQN# ASSIGN A INA SEQUENCE STA SEQN# NUMBER STA SEQN,I LDA NSCDL SET UP # RETRIES COUNTER STA NTRY,I JMP LIST CALL $LIST TO SCHEDULE LUQUE * DIREC NOP DIRECTIVE CODE SPC 2 * HERE TO REJECT REQUEST REJCT EQU * LDA =B140001 "DON'T DOWN & DO FINOISH" THIS REQUEST STA $DV16,I CLA CLEAR STA $DV17,I TRANSMISSION LOG JMP LDEX COMPLETION STATUS TO RTIOL SPC 2 * HERE FOR READ & WRITE REQUESTS ON "RESERVED" DVT * SPECL EQU * LDA $DV15,I REQUEST CONTROL WORD AND =B3703 IS THIS REQUEST TO CPA =B3602 SET UP I/O MAP? JMP MAPEQ YES CPA =B3601 IS THIS A REQUEST TO RETURN I/O MAP INFORMATION? JMP RTMAP YES CPA =B3503 OBTAIN SYSTEM ATTENTION? JMP SYSAT YES JSB SXDVT SET UP POINTERS TO OTHER DVT LDB $DV19,I GET SEQUENCE NUMBER LDA $DV15,I GET BACK AND =B3703 REQUEST CODE CPA =B3701 IS THIS AN ORIGINAL RSS REQUEST FROM LUQUE? CPB SEQN,I NO, SEQUENCE NUMBER MUST MATCH RSS JMP LOG0 NO GOOD, NO MATCH CPA =B3402 RETRY LATER? JMP RETRY YES CPA =B3502 "STOP" REQUEST? JMP SSTOP YES AND =B3700 MASK SUB-FUNCTION CPA =B3700 CORRECT FOR "SPECIAL" LU? RSS YES, CONTINUE JMP REJCT NO, REJECT REQUEST LDA $DV15,I LOAD REQUEST CONTROL WORD AND =B140000 MASK CLASS-I/O REQUEST BITS CPA =B140000 IS THIS A CLASS-I/O REQUEST? RSS YES, CONTINUE JMP REJCT NO, REJECT LDA $DV15,I OBTAIN REQUEST CODE AGAIN SLA,RSS WAS THIS REQUEST A "READ"? JMP MVRPL NO, MOVE REPLY BACK TO ORIGINAL REQUESTOR. SKP * HERE TO PASS ORIGINAL REQUEST TO LUMAP. * * SPC 1 * * DETERMINE ID SEGMENT ADDRESS OF CALLER * LDA XDT6,I IS REQUEST STILL PENDING? SSA,RSS JMP LOG0 NO LDB XDT2,I YES, GET I/O LINK WORD LDA XDT15,I GET REQUEST SSA "SYSTEM" I/O? CLB YES, CAN'T GET ID SEGMENT ADDRESS RAL ROTATE THE 'BUFFERED RQST' BIT _SSA BUFFERED? CLB YES, CAN'T GET ID SEGMENT ADDRESS STB IDADR & SAVE LOCALLY FOR USE LATER * LDB $DV16,I LOAD CLASS I/O BUFFER ADDRESS LDA EXTNO,I STORE DESTINATION NODE NUMBER STA B,I IN BUFFER(1) INB LDA EXTLU,I STORE DESTINATION NODE LU NUMBER STA B,I IN BUFFER(2) INB LDA XDT15,I STORE ORIGINAL CONTROL WORD STA B,I IN BUFFER (3) INB LDA XDT17,I STORE ORIGINAL REQUEST LENGTH STA B,I IN BUFFER(4) INB LDA XDT18,I STORE ORIGINAL 1ST OPTIONAL PARAMETER STA B,I IN BUFFER(5) INB LDA XDT19,I STORE ORIGINAL 2ND OPTIONAL PARAMETER STA B,I IN BUFFER(6) INB CLA 3RD OPTIONAL PARAMETER ALWAYS ZERO FOR THIS RTE STA B,I IN BUFFER(7) INB LDA IDADR STORE CALLING PROGRAM'S ID SEGMENT STA B,I ADDRESS IN BUFFER(8) INB LDA SEQN,I GET SEQUENCE NUMBER STA B,I STORE IN BUFFER(9) LDA XDT15,I LOAD ORIGINAL CONTROL WORD AGAIN IOR ZBIT IS THE Z BIT CPA XDT15,I SET? JMP MVXI YES, MUST SEND SECOND BUFFER AND B3 MASK CPA B2 "WRITE" REQUEST? MVXI INB,RSS YES, (B) POINTS TO BUFFER ADDRESS JMP MVX3 NO, SKIP DATA TRANSFER * * SET UP DATA TRANSFER * STB SEXT SAVE DESTINATION BUFFER ADDRESS LDA XDT17,I LOAD ORIGINAL REQUEST LENGTH LDB XDT15,I IF DOUBLE BUFFERED BLF,SLB MUST USE LDA XDT19,I SECOND BUFFER JSB CHTW CONVERT CHAR COUNT TO WORDS CMA,INA CONVERT COUNT TO NEGATIVE SSA,RSS IS IT REALLY NEGATIVE? JMP MVX3 NO, SKIP THE TRANSFER STA SXDVT SAVE ADA $DV17,I MAKE SURE THE LENGTH CPA .REQL WE GOT FROM LUQUE IS RIGHT RSS JMP LOG0  NO WAY! LDA XDT16,I LOAD "SOURCE" ADDRESS LDB XDT15,I IF DOUBLE BUFFERED BLF,SLB MUST USE LDA XDT18,I SECOND BUFFER * MXVL EQU * MOVE-WORDS LOOP LDB A,I MOVE DATA FROM HERE STB SEXT,I TO HERE INA INCREMENT ADDRESSES ISZ SEXT ISZ SXDVT END OF LOOP? JMP MXVL NO, CONTINUE * * MVX3 EQU * LDB B4 "SET MASTER TIME-OUT" CONTINUATION CODE STB CCODE,I STORE CONTINUATION CODE LDB $DV19,I LOAD DS TIMEOUT LDA XDT15,I GET THE OR RAL,RAL OF THE PROMPT FLAG IOR EXTLU,I AND THE Z-BIT CMA (COMPLEMENTED) ALF,RAR IN BIT 1 IOR XDT15,I IF THIS IS A READ AND RAR,SLA PROMPT OR Z-BIT IS SET RSS LDB BIT15 THEN USE MAXIMUM TIMEOUT LDA $DV5,I SET IN IFT ADA =D8 WHERE IT CAN BE FOUND STB A,I ON NEXT ENTRY JMP SEXIT DO SPECIAL EXIT SKP * HERE TO SEND THE REPLY BACK TO THE CALLING PROGRAM. SPC 2 * BUFFER CONTAINS THE REPLY TO THE ORIGINAL REQUEST, * PLUS DATA (AS READ) IN THE CASE WHERE THE * ORIGINAL REQUEST WAS A "READ". INCLUDED IN THE DATA ARE: * * WORD 1 SEQUENCE NUMBER--ASSIGNED BY DRIVER. MUST BE PROVIDED WITH * REPLY, IN ORDER TO BE SURE OF MATCHING ORIGINAL REQUEST. * 2 (A)-REGISTER AT COMPLETION (DEVICE TYPE & STATUS) * 3 TRANSMISSION LOG * 4 EXTENDED STATUS WORD 1 * 5 EXTENDED STATUS WORD 2 * 6 & FOL. : ORIGINAL DATA ("READ" REQUEST ONLY) * * ORIGINAL REQUEST IS SPECIFIED VIA THE DVT ADDRESS * (CONTAINED IN 1ST OPTIONAL PARAMETER). MVRPL EQU * LDA XDT6,I IS A REQUEST STILL WAITING? SSA,RSS JMP LOG0 NO LDA CCODE,I YES, IS IT WAITING CPA B3 FOR A RESPONSE? RSS JMP LOG0 NO LDA $DV16,I LOAD BUFFER ADDRESS STA TEMP SAVE IT LDA TEMP,I GET ACTUAL DEVICE STATUS XOR XDT6,I AND =B37777 MASK OFF "AV" FIELD FROM DESTINATION XOR XDT6,I INCLUDE "AV" FIELD FROM ORIGINAL REQUEST'S DVT STA XDT6,I STORE NEW I/O STATUS & EQUIPMENT TYPE ISZ TEMP POINT TO TRANSMISSION LOG LDB XDT17,I SAVE ORIGINAL REQUEST LENGTH LDA TEMP,I STORE ACTUAL TRANSMISSION LOG IN DVT-- STA XDT17,I WE'LL PICK IT UP ON I/O COMPLETION. ISZ TEMP BUMP TO EXTENDED STATUS LDA TEMP,I LOAD EXTENDED STATUS WORD # 1 STA XDT18,I AND SAVE IN DVT WORD 18 ISZ TEMP BUMP POINTER TO 2ND EXTENDED-STATUS WORD LDA TEMP,I LOAD 2ND STATUS WORD STA XDT19,I AND SAVE LDA XDT15,I WAS ORIGINAL AND B3 REQUEST CPA B1 A "READ"? RSS YES JMP RPXIT NO, RETURN I/O COMPLETION TO IOC * ISZ TEMP BUMP POINTER TO DATA AREA * * ORIGINAL REQUEST WAS A "READ". * DATA IS TO BE PASSED TO ORIGINAL CALLING PROGRAM'S BUFFER, AS READ * LDA XDT17,I BUFFER LENGTH SSB IF ORIGINAL REQUEST WAS CHARACTERS CMA,INA BUFFER LENGTH IS CHARACTERS JSB CHTW CONVERT WORDS TO CHARACTERS CMA,INA CONVERT WORD COUNT TO NEGATIVE SSA,RSS IS IT REALLY NEGATIVE? JMP RPXIT NO, SKIP TRANSFER STA SXDVT SAVE WORD COUNT LDB XDT16,I LOAD DESTINATION ADDRESS XL EQU * WORD-MOVE LOOP LDA TEMP,I GET DATA STA B,I STORE DATA ISZ TEMP INCREMENT INB ADDRESSES ISZ SXDVT END OF LOOP? JMP XL NO, CONTINUE * RPXIT EQU * LDA B2 SET "IMMEDIATE COMPLETION" STA CCODE,I COMPLETION CODE * * SPECIAL EXIT: EXIT WITH THE IFT ON THE PRIVILEDGED DONE QUEUE * POINTING TO THE z%OTHER DVT. THE OTHER DVT WILL BE HANDLED AS ITS * CONTINUATION CODE INDICATES WHEN IT GETS A PHYSICAL COMPLETE * ENTRY FROM THE PHYSICAL LEVEL, AND WILL PUT THE IFT BACK ON THE * DONE QUEUE TO RE-ENTER THE RESERVED DVT, WHICH WILL THEN DO A * COMPLETION. SEXIT LDA XDT1 GET ADDRESS OF OTHER DVT JSB IFDQ SET UP IFT DONE QUEUE JMP LWEX DO LOGICAL WAIT EXIT SPC 2 * * THIS EXIT IS TAKEN TO LEAVE TRANSMISSION LOG ZERO * LOG0 EQU * CLA STA $DV17,I JMP IEXIT RETURN SKP * HERE TO SET UP THE I/O MAPPING FUNCTION * MAPEQ EQU * LDA $DV16,I GET BUFFER ADDRESS LDB A,I GET SECURITY CODE CPB FNMBR CORRECT? INA,RSS JMP LOG0 NO, REJECT * MOVE I/O MAP SET-UP INFO TO LOCAL STORAGE STA SXDVT SAVE ADDRESS DLD SXDVT,I GET 1ST TWO WORDS DST VLU SAVE ISZ SXDVT BUMP POINTER ISZ SXDVT LDA SXDVT,I LOAD DESTINATION NODE # STA RNODE SAVE * LDA VLU CPA M1 ARE WE TO FIND AN LU? JMP FMPEQ YES. * LDB VLU CHECK THE SPECIFIED LU FOR "MAPPABILITY" JSB CKMLU JMP NOMAP ERROR--CRITERIA NOT MET JMP SETMP CRITERIA MET: SET UP I/O MAP SPC 2 * HERE TO ALLOCATE AN UNUSED "MAP LU" FROM THE POOL. * THAT IS, FIND AN LU WHICH "POINTS" TO THIS DRIVER, AND * WHICH DOES NOT HAVE AN ACTIVE MAP ENTRY: LU WORD IS 0 * * FMPEQ EQU * LDA $LUT# SET LOOP CMA,INA COUNTER FOR MAX. # LUS STA CNTR CLB,INB INITIALIZE LU NUMBER STB VLU FMLUP EQU * LDB VLU LOAD LU TO BE CHECKED JSB CKMLU CHECK THE LU FOR "MAPPABILITY". JMP FMNXT NO, TRY NEXT LU SPC 2 LDA B INA LDA A,I LOAD ENTRY SZA EMPTY? JMP FMNXT NO--ENTRY IN USE * * FOUND AN ENTRY THAT'S AVAILABLE. SETMP EQU * POINTS TO ADDRESS OF "NODE #" WORD IN I/O MAP LDA RNODE STORE DESTINATION NODE # STA B,I IN THE TABLE INB ADVANCE PNTR TO "LU" WORD LDA RLU STORE THE LU NUMBER STA B,I IN THE TABLE LDB VLU RETURN LU # TO USE FMXIT STB $DV17,I IN TRANSMISSION LOG JMP IEXIT SPC 2 FMNXT EQU * HERE TO ADVANCE TO NEXT LU ISZ VLU BUMP LU # ISZ CNTR END OF LOOP? JMP FMLUP NO, CONTINUE TRYING LUS NOMAP EQU * HERE TO RETURN "NO GOOD" STATUS TO CALLER CLB JMP FMXIT SKP * SUBROUTINE TO CHECK THE DVT ASSOCIATED WITH AN LU * TO VERIFY THAT IT IS "MAPPABLE". BY THIS WE MEAN: * 1) THE LU POINTS TO AN DVT WHICH "POINTS" TO THIS DRIVER. * 2) THE LU IS NOT THE "RESERVED" LU, AND DOES NOT POINT TO * THE "RESERVED" DVT. * 3) THE DVT ASSOCIATED WITH IT HAS AN EXTENSION SIZE * OF 6 * * CALLING SEQUENCE: * LDB * JSB CKMLU * CONTAINS ADDRESS * OF "DESTINATION NODE #" WORD IN I/O MAP> * SPC 2 * TEMPORARY STORAGE AREA CKTMP NOP TEMPORARY STORAGE FOR THIS ROUTINE SPC 2 CKMLU NOP ENTRY/EXIT LDA B CHECK THAT LU # IS A VALID ONE CMA,INA ADA $LUT# SSA JMP CKMLU,I LU > MAX # LUS IN SYSTEM ADB M1 COMPUTE DVT ADDRESS SSB SPECIFIED LU < 1? JMP CKMLU,I YES, TAKE "NO" EXIT ADB $LUTA ADD ADDRESS OF LU TABLE LDB B,I GET THE DVT ADDRESS SZB,RSS BIT BUCKET? JMP CKMLU,I IF YES, TAKE "NO" EXIT ADB B4 ADVANCE TO @ ASSOCIATED IFT ADDRESS LDA B,I GET IFT ENTRY ADDRESS XOR $DV5,I SAME AS THIS DRIVER? CLE,ELA t SZA JMP CKMLU,I NO, TAKE "NO GOOD" EXIT * * WE'VE FOUND A DVT WHICH "BELONGS" TO THIS DRIVER. * IF IT HAS AN UNUSED "I/O MAP" ENTRY, THEN WE CAN SET IT UP * WITH ONE. ADB =D16 ADVANCE POINTER TO EXTENSION SIZE LDA B,I GET SIZE ADA MEXTZ IS EXTENSION SZA EXACTLY THE RIGHT SIZE? JMP CKMLU,I NO, TAKE "NO GOOD" ENTRY INB GOOD! ADVANCE TO ADDRESS OF EXT. AREA LDB B,I LOAD EXTENSION ADDRESS ADB B3 ADVANCE TO I/O MAP ISZ CKMLU -TAKE "GOOD" EXIT JMP CKMLU,I NOW RETURN: = I/O MAP ADDRESS SPC 2 * HERE TO RETURN I/O MAP INFORMATION FOR A SPECIFIED LU SPC 1 RTMAP EQU * LDA $DV17,I GET BUFFER LENGTH CPA B2 TWO WORDS? RSS JMP REJCT NO! REJECT LDB $DV18,I GET THE LU JSB CKMLU CHECK IT FOR MAPPABILITY CCA,RSS NOT MAPABLE JMP RTGUD ***GOOD LU *** LDB $DV16,I GET DATA BUFFER ADDRESS STA B,I RETURN -1 JMP IEXIT SPC 2 RTGUD EQU * HERE WHEN LU RETURNED IS A GOOD ONE STB CHTW SAVE I/O MAP ADDRESS FOR JUST A FEW LINES.... LDA $DV16,I GET USER BUFFER ADDRESS STA CKTMP SAVE ADDRESS DLD CHTW,I GET THE MAP ENTRY WORDS DST CKTMP,I RETURN THEM TO USER * JMP IEXIT IMMEDIATE COMPLETION SKP * HERE ON REQUESTS TO SEND A 'STOP' TO ORIGINATING USER PROGRAM * SSTOP EQU * LDA XDT6,I SET "I/O TIMEOUT" STATUS BIT IOR =B40 STA XDT6,I CLA SET ZERO STA XDT17,I TRANSMISSION LOG LDA B6 SET CONTINUATION CODE STA CCODE,I FOR DELAYED COMPLETION JMP SEXIT DO SPECIAL EXIT SPC 2 RETRY EQU * HERE TO SET UP ORIGINAL REQUEST RE-TRY LDA B5 WE WILL RE-ATTEMPT TO EXECUTE THE ENTIRE STA CCODE,I REQUEST ON RE-ENTRY AFTER 1w SECOND JMP SEXIT DO SPECIAL EXIT SPC 2 * HERE TO SIMULATE A REQUEST FOR SYSTEM ATTENTION SYSAT EQU * LDA $DV16,I PICK UP LU TO USE SZA,RSS DEFAULTED? CLA,INA YES, USE LU = 1 STA TEMP LDB A MAKE SURE THIS LU JSB CKMLU IS MAPPABLE JMP IEXIT NO, NO ATTENTION LDA TEMP YES, GET BACK LU STA $ATTN SET "OPERATOR ATTENTION" FLAG JMP IEXIT HED CONTINUATION INTERRUPT PROCESSING SECTION SKP CNTNU EQU * CONTINUATOR ENTRY POINT LDA SPDVT IS THIS THE CPA $DV1 SPECIAL DVT? RSS JSB IFDQ NO, SET UP RE-ENTRY ON SPECIAL DVT TMOUT EQU * LDA $DV6,I IS THIS A SSA,RSS SPURIOUS INTERRUPT? JMP LWEX YES LDA $DV1 SPECIAL DVT? CPA SPDVT JMP IEXIT YES, ALWAYS DO COMPLETION LDA CCODE,I LOAD CONTINUATION CODE SSA,RSS VERIFY IT SZA,RSS JMP LWEX NOT VALID, CONTINUATION RETURN TO $CIC ADA CTABL TOO SSA,RSS BIG? JMP LWEX YES, INVALID LDA CCODE,I LOAD CODE AGAIN ADA CTBLE CONVERT TO JUMP ADDRESS JMP A,I AND GO THERE. SPC 2 * * WARNING: DO NOT DISTURB THE ORDER OF ENTRIES IN * THE "CONTINUATION JUMP" AND "ORIGINAL REQUESTOR'S * DVT POINTERS" TABLES. * * "CONTINUATION JUMP TABLE" * CTBLE DEF *,I DEF LISTX 1: RE-TRY LUQUE SCHEDULE DEF IEXIT 2: I/O COMPLETION DEF MTMOT 3: MASTER TIME-OUT DEF SMSTM 4: SET MASTER TIME OUT DEF W1SEC 5: WAIT 1 SECOND AND RETRY DEF DCOMP 6: DELAYED COMPLETION CTABL ABS CTBLE-* NEG. LENGTH OF CONTINUATION TABLE * * END OF "CONTINUATION JUMP" TABLE SPC 2 * ROUTINE TO RE-ATTEMPT TO SCHEDULE LUQUE * SPC 2 LISTX EQU * HERE ON CONTINUATION CODE = 1 ISZ NTRY,I YBUMP RE-TRY COUNTER. EXHAUSTED? RSS NO, CONTINUE JMP MTMOT YES--MASTER TIMEOUT JMP LIST ATTEMPT TO SCHEDULE IT SPC 2 MTMOT EQU * HERE ON MASTER TIME-OUT(CC=3) LDA $DV6,I IOR =B40 SET I/O TIME-OUT BIT STA $DV6,I JMP LOG0 SPC 2 SMSTM EQU * LDB $DV5,I GET ADB =D8 TIMEOUT LDA B,I FROM IFT EXTENSION STA $DV12,I SET TIMEOUT LDA B3 SET COMPLETION CODE STA CCODE,I TO "MASTER TIMEOUT" JMP LWEX SPC 2 W1SEC LDA =D-100 GET 1 SECOND TIMEOUT JMP DELAY SET UP FOR RETRY IN 1 SECOND SPC 2 DCOMP LDB $DV15,I IF REQUEST IS WRITE RBR,SLB OR CONTROL JMP IEXIT COMPLETE IMMEDIATELY LDA B2 OTHERWISE, WAIT STA CCODE,I 2.5 SECONDS AND THEN LDA MB400 COMPLETE STA $DV12,I (THIS PREVENTS READ LOOPS JMP LWEX FROM HOGGING THE MACHINE) SPC 2 IEXIT EQU * CLA SAY NO ERROR STA $DV16,I JMP LDEX SPC 2 * * EXITS FROM LOGICAL LEVEL * LWEX ISZ DDV00 LOGICAL WAIT ISZ DDV00 PHYSICAL INITIATE LDEX CLA,INA LOGICAL DONE (ALWAYS ENABLE TIMEOUT) JMP DDV00,I RETURN SPC 5 * * PLACE IFT ON PRIVILEDGED DONE QUEUE POINTING TO DVT POINTED TO * BY A * IFDQ NOP LDB $DV5,I POINT TO IFT'S ADB =D4 DVT REFERENCE WORD STA B,I PLACE THE DVT'S ADDRESS THERE ADB =D3 POINT TO THE PRIVILEDGED DONE QUEUE LINK CLC 4 LDA $Q.PV PLACE IFT STB $Q.PV ON PRIVILEDGED STA B,I DONE QUEUE STC 4 JMP IFDQ,I SPC 5 * * INTERFACE DRIVER: ANY ENTRY HERE IS AN ERROR * IDV00 NOP CLE,ERA INITIALIZE OR SZA ABORT REQUEST? ISZ IDV00 NO, DO WAIT EXIT CLA NOx OPTIONS WANTED JMP IDV00,I GET OUT OF HERE HED SUBROUTINES SPC 2 * * CODE TO SCHEDULE LUQUE * * CALLING SEQUENCE: * * P JMP LIST * * LIST WILL EXIT THE DRIVER THROUGH LWEX AFTER SETTING * A CONTINUATION CODE OF 1 * LIST EQU * LDA $DV1 STA PRAM5 PARAMETER 1: DVT ADDRESS LDA EXTNO,I PARAMETER 2: DESTINATION NODE # STA PRAM5+1 LDA $DV17,I PARAMETER 3: BUFFER LENGTH LDB $DV15,I UNLESS WRITE SLB DON'T SEND CLA DATA BLF,SLB BUT IF WRITE/READ LDA $DV19,I SEND SECOND BUFFER LENGTH STA PRAM5+2 LDA SEQN,I PARAMETER 4: SEQUENCE NUMBER STA PRAM5+3 STORE IN BUFFER * JSB $XQSB SCHEDULE 'LUQUE' DEF LUQUE NAME DEF PRAM5 5-PARAMETER AREA DEC 0 DON'T CHANGE TTY LDB LUPTO SET ONE-SECOND TIME-OUT SZA,RSS UNLESS LUQUE WASN'T SCHEDULED, DELAY LDB =D-100 IN WHICH CASE IT IS SHORTER STB $DV12,I CLA,INA SET CONTINUATION CODE FOR RETRY STA CCODE,I STORE CONTINUATION CODE JMP LWEX WAIT FOR LUQUE TO CALL US SPC 2 * * SUBROUTINE TO CONVERT CHARACTER COUNT TO WORDS * CALLING SEQUENCE: * LDA + = WORDS, - = CHARS * JSB CHTW * (A) = + WORD COUNT, (B) = SAME AS AT CALL * CHTW NOP SSA,RSS ALREADY HAVE COUNT IN WORDS? JMP CHTW,I YES, RETURN CMA,INA CONVERT INA ROUNDED ARS WORDS JMP CHTW,I RETURN TO CALLER SPC 2 * SUBROUTINE TO SET UP THE "XDT" TABLE POINTERS. * THIS TABLE CONTAINS POINTERS TO THE ORIGINAL REQUEST'S * DVT. IT IS USED WHEN THE DRIVER IS ENTERED VIA THE * "RESERVED" LU, AND PROVIDES CONVENIENT ACCESS TO THE * ORIGINAL REQUEST'S DVT. * SXDVT NOP ENTRY/EXIT LDA SZXDT SET UP LOOP COUNTER  STA CNTR LDA $DV18,I GET ORIGINAL REQUEST'S DVT ADDRESS LDB @XDT LOAD ADDRESS OF XDT TABLE JSB SETP SET PARAMETER POINTERS LDA XDT22,I LOAD DVT EXTENSION ADDRESS JSB SEXT SET ADDRESSES OF EXTENSION AREA JMP SXDVT,I RETURN TO CALLER SPC 2 * SUBROUTINE TO SET UP THE "EXT" TABLE POINTERS * ON ENTRY, (A) = ADDRESS OF EXTENSION WORD 1 * ON RETURN, SEQN = ADDRESS OF 1ST EXTENSION WORD * CCODE 2ND * ETC. SEXT NOP LDB MEXTZ SET UP LOOP STB CNTR LDB @SEQN JSB SETP JMP SEXT,I SPC 2 * SUBROUTINE TO SET UP POINTERS SETP NOP STA B,I SET ADDRESS INA INB ISZ CNTR DONE WITH LOOP? JMP SETP+1 NO, CONTINUE JMP SETP,I YES, EXIT A EQU 0 B EQU 1 * SPC 2 PRAM5 BSS 5 B1 OCT 1 B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B6 OCT 6 BIT15 OCT 100000 MB400 OCT 177400 M1 DEC -1 NSCDL DEC -20 LIMIT OF ATTEMPTS TO SCHEDULE LUQUE LUPTO DEC -5 RE-TRY DELAY FOR ATTEMPT TO SCHEDULE LUQUE * * NOTE: LEAVE "LUQUE" AND "MAXBF" CONTIGUOUS, SO USERS MAY * FIND & MODIFY MAXBF, IF DESIRED. LUQUE ASC 3,LUQUE NAME OF 'LUQUE' MAXBF DEC -513 NEG. OF MAX. ALLOWABLE BUFFER SIZE -1 * * * "ORIGINAL REQUESTOR'S DVT POINTERS" TABLE * * WARNING: DO NOT DISTURB ORDER OF ENTRIES IN THIS TABLE. * * THIS TABLE OVERLAYS THE CODE THAT FINDS THE RESERVED DVT * @XDT DEF XDT1 ADDRESS OF INTERNAL TABLE XDT1 EQU OVRLY POINTER TO ORIGINAL REQUEST'S DVT WRD 1 XDT2 EQU XDT1+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 2 XDT3 EQU XDT2+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 3 XDT4 EQU XDT3+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 4 XDT5 EQU XDT4+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 5 XDT6 EQU XDT5+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 6 XDT7O EQU XDT6+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 7 XDT8 EQU XDT7+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 8 XDT9 EQU XDT8+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 9 XDT10 EQU XDT9+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 10 XDT11 EQU XDT10+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 11 XDT12 EQU XDT11+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 12 XDT13 EQU XDT12+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 13 XDT14 EQU XDT13+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 14 XDT15 EQU XDT14+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 15 XDT16 EQU XDT15+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 16 XDT17 EQU XDT16+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 17 XDT18 EQU XDT17+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 18 XDT19 EQU XDT18+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 19 XDT20 EQU XDT19+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 20 XDT21 EQU XDT20+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 21 XDT22 EQU XDT21+1 POINTER TO ORIGINAL REQUEST'S DVT WRD 22 SZXDT ABS XDT1-XDT22-1 NEGATIVE OF SIZE OF XDT TABLE * CHECK EQU OVREN-1-XDT22 WILL GENERATE AN ERROR IF OVERLAY * AREA EXCEEDED * * * STORAGE BELOW FOR DVT EXTENSION AREA * ( MUST BE CONTIGUOUS ) * SEQN NOP ADDRESS OF SEQUENCE NUMBER CCODE NOP ADDRESS OF CONTINUATION CODE NTRY NOP ADDRESS OF # RETRIES COUNTER EXTNO NOP ADDRESS OF I-O MAP: DESTINATION NODE NUMBER EXTLU NOP " " " " " " LU # * MEXTZ ABS SEQN-EXTLU-1 NEGATIVE SIZE OF DVT EXTENSION * * END OF "ORIGINAL REQUESTOR'S DVT POINTERS" TABLE * @SEQN DEF SEQN .REQL ABS DREQL LENGTH OF DRIVER REQUEST AREA IDADR NOP ZBIT OCT 10000 "Z" BIT FNMBR DEC 25834 MAP SET UP SECURITY CODE SEQN# OCT 0 SEQUENCE NUMBER SPDVT NOP HOLDS ADDRESS OF "RESERVED" DVT TEMP NOP * * WARNING: DO NOT DISTURB ORDER OF "VLU", "RLU" AND "RNODE" * VLU NOP RLU NOP RNODE NOP * CNTR NOP END ֢  t 91750-18182 2013 S C0122 &RDBAP &RDBAP             H0101 ASMB HED RDBAP - REMOTE DATA BASE ACCESS PROGRAM MAIN NAM RDBAP,20,40 91750-16182 REV.2013 800125 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18182 * RELOC: 91750-16182 * * * ******************************************************************* * * * * COM DABUF(2174),RQBUF(30) COM RECRQ,RECDA,SEGNM,DBCNT,CLASS(5) * * This is the main of the Remote Data Base Access Program for Remote * IMAGE/1000. It performs the following sequence of operations. * * 1) Retrieve scheduling parameters. These are our class number, our * index in the RDBAP copy scheduling table, and RDBAM's class number, * in that order. * * 2) Ask #GET to get the request and data off of our class. If there * is any error: * * A) Send a reply with proper DS error code. * * B) If we do not have a data base open (DBCNT is zero) then send * RDBAM a request to remove us from the system (RDBA Index is -2 * and Mode is our index in RDBAP copy scheduling table) and termi- * nate normally. * * C) Return to class GET. * * 3) Get RDBA Index from the request buffer. If it is a negative * one (-1), this is a clean-up request. Schedule the 4th segment of * this program. If any error, set DBCNT to zero and go to 2-B. * * 4) Get RDBA Index from the request buffer and bound check for * validity. Index must be within [36,45]. If bound check fails, go * to 2-A. * * 5) Determine the segment of our program which is to service this re- * quest as follows: * DBOPN, DBINF, DBLCK, DB ]UNL, DBCLS serviced by segment 1 * DBFND, DBGET, DBUPD serviced by segment 2 * DBPUT, DBDEL serviced by segment 3 * * 6) Load and execute the appropriate segment. If any error go to 2-A. * ENT RDBAP,BP.GT EXT BAPS1,BAPS2,BAPS3 EXT #GET,DBBUF,EXEC,RDEXT,RMPAR,SEGLD,#ATCH SKP ********************************************************************** *** *** * Standard DS/1000 equates * *** *** *$ * ****************************************************************** * * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * *$ *** *** ********************************************************************** ********************************************************************** * * * DS/1000 RDBA Communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * These two static buffers are as described below. * * * ********************************************************************** *** *** * * * Request buffer - one buffer of from 12 to 21 words per RDBA call * * * *** *** RBSTR EQU #STR DS/1000 stream word RBSEQ EQU #SEQ DS/1000 sequence number RBSRC EQU #SRC DS/1000 source node number RBDST EQU #DST DS/1000 destination node number RBIDX EQU #REQ RDBA call Index RBMOD EQU #REQ+1 RDBA call mode RBID EQU #REQ+2 RDBA call item or set number * or for a DBOPN, the level code word RBITM EQU #REQ+3 Search item number for DBFND RBMRT EQU #REQ+5 For DBOPN, max. returned RT size RBLEN EQU #REQ+6 Word size of ibase parameter RBBAS EQU #REQ+7 Ibase parameter *** *** ***  *** * * * Reply buffer - one buffer of either 17 or 18 words per RDBA call * * * *** * * RBSTR EQU #STR DS 1000 stream word * RBSEQ EQU #SEQ DS/1000 sequence number * RBSRC EQU #SRC DS/1000 source node number * RBDST EQU #DST DS/1000 destination node number RBEC1 EQU #EC1 DS/1000 1st error code word RBEC2 EQU #EC2 DS/1000 2nd error code word RBEC3 EQU #ENO DS/1000 error node number upon an error RBSTA EQU #REP RDBA call status array RBNUM EQU #REP+10 RDBA data base number for DBOPN * RPLEN DEC 23 Standard reply buffer length * one more for DBOPN *** *** ********************************************************************** * * Maximum request and data buffers. * MAXRQ DEC 30 MAXDA DEC 2174 * A EQU 0 B EQU 1 SKP * * Retrieve scheduling parameters * RDBAP JSB RMPAR DEF *+2 DEF CLASS * * Ask #GET to get the data and request off of our class number for us. * BP.GT JSB #GET DEF *+6 DEF CLASS #GET needs: class number DEF RQBUF request buffer DEF MAXRQ max. request length DEF DABUF data buffer DEF MAXDA max. data length JMP E153 error return point * STA RECRQ returns: request length in STB RECDA A reg., data length in B. * * Attach this RDBAP to a session * LDA RQBUF+#SID AND LOBYT STA TEMP JSB #ATCH DEF *+2 DEF TEMP * * Get the RDBA Index from the request buffer and check if this * is a special clean-up request from the DS software. If so, the Index * will be -1, bring up the 4th segment to perform the clean-up. * BP.G1 LDA RQBUF+RBIDX INA,SZA JMP BAP No - a normal request. * JSB SEGLD DEF *+3 DEF SEG4,I DEF IERR * * If we returned from the SEGLD call, we got an error. One of our seg- * ments is missing. Set data base count (DBCNT) to zero, and terminate * permanently. * CLB STB DBCNT JMP EREXT SKP * * Get the RDBA index from the request buffer (5th word) and make sure it * falls within the bounds of an IMAGE/1000 call, i.e. Index within [36..45]. * The bound check effectively maps [36..45] onto [0..9] in a one-to-one * fashion. * BAP LDB RQBUF+RBIDX CMB,INB ADB D35 Is index > 35? SSB,RSS JMP E159 No - error ADB D10 Yes - is index < 46? SSB JMP E159 No - error STB RQBUF+RBIDX Yes - save this result * * The base parameter for the IMAGE call starts in the 12th word of the * request buffer. Its first word contains the index for our program in the * high byte and the data base number in the low byte. Remove our index * from this word (unless this happens to be a DBOPN call in which case it * is two blanks and is left the same). * CPB D9 B = 9 if a DBOPN request. JMP BAP0 LDA RQBUF+RBBAS AND LOBYT STA RQBUF+RBBAS * * We will allow each segment to do its own parse of the request (and data) * buffer(s) because it varies from call to call. Now, all we need to do * is determine which segment to load (based on the index we resulted in * from our subtractions and additions above and jumping into the table * below), then we load it. * BAP0 BLS Multiply index by two ADB TABAD (2 words/entry in table) JMP B,I then index into the table. * TABAD DEF *+1 LDA SEG1 Index = 45, DBUNL QQJMP BAP1 LDA SEG1 Index = 44, DBLCK JMP BAP1 LDA SEG3 Index = 43, DBDEL JMP BAP1 LDA SEG3 Index = 42, DBPUT JMP BAP1 LDA SEG2 Index = 41, DBUPD JMP BAP1 LDA SEG2 Index = 40, DBGET JMP BAP1 LDA SEG2 Index = 39, DBFND JMP BAP1 LDA SEG1 Index = 38, DBCLS JMP BAP1 LDA SEG1 Index = 37, DBINF JMP BAP1 LDA SEG1 Index = 36, DBOPN * BAP1 STA SEGAD * * Check to see if this segment is already in memory. If so, no need to * call SEGLD to bring it in again. The current segment's name suffix * is in SEGNM in common. * ADA D2 LDA A,I CPA SEGNM RSS JMP BAP2 Not there, load it. * * Segment is already in memory. Determine which entry point to take by * putting the number suffix in the low order byte of the A register and * subtracting 61B to get a number within [0..2]. Then use this number * as an index into the following JMP table. * ALF,ALF AND LOBYT ADA M61B ADA JMPTB JMP A,I * JMPTB DEF *+1 JMP BAPS1 Segment one. JMP BAPS2 Segment two. JMP BAPS3 Segment three. * * Segment not already in memory. Load it and give it control. * BAP2 JSB SEGLD DEF *+3 SEGAD ABS *-* DEF IERR * * If we returned from the SEGLD call, we got an error. One of our seg- * ments is missing. * LDB M156 Segment error RSS E159 LDB M159 Illegal index RSS E153 LDB M153 Illegal request or data size EREXT CLA DST ERROR * CLB STB RECDA Set returned data length to zero. JSB RDEXT Send DS reply. DEF *+6 DEF RQBUF RDEXT needs: reply buffer DEF RPLEN reply length DEF DABUF data buffer DEF RECDA data length DEF ERROR *($ error code. NOP * LDA DBCNT If we have no open data base, SZA JMP BP.GT * LDA M2 Send RDBAM a "remove me" request. STA RQBUF+RBIDX RDBA Index is -2 for this request LDA CLASS+1 and the mode is our index STA RQBUF+RBMOD into the RDBAP copy scheduling table. * JSB EXEC DEF *+8 DEF WT/RD write/read w/no abort DEF CONTR double buffer, lu zero DEF DABUF DEF D0 no data DEF RQBUF OFf request buffer DEF RPLEN request length DEF CLASS+2 RDBAM's class number NOP ignore errors * JSB EXEC End of run. DEF *+4 DEF D6 DEF D0 DEF D0 Normal completion. * * Constants and variables. * M159 DEC -159 M156 DEC -156 M153 DEC -153 M61B OCT -61 M2 DEC -2 D0 DEC 0 D2 DEC 2 D6 DEC 6 D9 DEC 9 D10 DEC 10 D35 DEC 35 B1 OCT 1 * WT/RD OCT 100024 CONTR OCT 010000 LOBYT OCT 377 * ERROR BSS 2 TEMP EQU ERROR IERR EQU ERROR * SEG1 DEF *+1 ASC 3,BAPS1 SEG2 DEF *+1 ASC 3,BAPS2 SEG3 DEF *+1 ASC 3,BAPS3 SEG4 DEF *+1 ASC 3,BAPS4 END RDBAP sR* u 91750-18183 2013 S C0122 &BAPS1 &BAPS1             H0101 ASMB HED BAPS1 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 1 NAM BAPS1,5 91750-1X183 REV.2013 800523 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18183 * RELOC: 91750-1X183 * * * ******************************************************************* * * * COM DABUF(2174),RQBUF(30) COM RECRQ,RECDA,SEGNM,DBCNT,CLASS(5) * * Segment 1 of the Remote Data Base Access Program. This segment has the * following sequence of operations. * * 1) Determine the type of IMAGE call and branch to the appropriate * call handler. * * A) DBOPN * * I ) Perform the DBOPN call. If any error, go to 2. * * II ) Increment data base count. * * III) Build compacted Run Table for the source node in the data * buffer. * * IV ) Go to 2. * * B) DBINF * * I ) Perform DBINF call. * * II) Go to 2. * * C) DBCLS * * I ) Perform DBCLS call. If DBCLS successful and this was a * mode 1 DBCLS, then decrement the data base count (DBCNT). * * II) Go to 2. * * D) DBLCK * * I ) Perform DBLCK call. * * II) Go to 2. * * E) DBUNL * * I ) Perform DBUNL call. * * II) Go to 2. * * 2) Send the RDBA reply and any data associated with it. * * 3) If data base count (DBCNT) is zero, then send a request to RDBAM to * remove us from the system and terminate normally. * * 4) Return to class get in main. SKP ********************************************************************** uE*** *** * Standard DS/1000 equates * *** *** *$ * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * *$ ****************************************************************** * *** e *** ********************************************************************** ********************************************************************** * * * DS/1000 RDBA Communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * These two static buffers are as described below. * * * ********************************************************************** *** *** * * * Request buffer - one buffer of from 12 to 21 words per RDBA call * * * *** *** RBSTR EQU #STR DS/1000 stream word RBSEQ EQU #SEQ DS/1000 sequence number RBSRC EQU #SRC DS/1000 source node number RBDST EQU #DST DS/1000 destination node number RBIDX EQU #REQ RDBA call Index RBMOD EQU #REQ+1 RDBA call mode RBID EQU #REQ+2 RDBA call item or set number * or for a DBOPN, the level code word RBITM EQU #REQ+3 Search item number for DBFND RBMRT EQU #REQ+5 For DBOPN, max. returned RT size RBLEN EQU #REQ+6 Word size of ibase parameter RBBAS EQU #REQ+7 Ibase parameter * MAXRQ DEC 30 Maximum request buffer length *** *** *** *** * * * Reply buffer - one buffer of either 23 or 24 words per RDBA call * * * ***  * * RBSTR EQU #STR DS 1000 stream word * RBSEQ EQU #SEQ DS/1000 sequence number * RBSRC EQU #SRC DS/1000 source node number * RBDST EQU #DST DS/1000 destination node number RBEC1 EQU #EC1 DS/1000 1st error code word RBEC2 EQU #EC2 DS/1000 2nd error code word RBEC3 EQU #ENO DS/1000 error node number upon an error RBSTA EQU #REP RDBA call status array RBNUM EQU #REP+10 RDBA data base number for DBOPN * RPLEN DEC 23 Standard reply buffer length OLEN DEC 24 DBOPN is 1 more * 24 for DBOPN *** *** ********************************************************************** * ENT BAPS1 EXT BP.GT,DBCLS,DBINF,DBLCK,DBOPN,DBUNL EXT EXEC,GETKY,RDEXT * A EQU 0 B EQU 1 DAADR DEF DABUF BFLEN DEC 2174 * * Set the reply length to the standard reply length. * BAPS1 LDA RPLEN STA LENTH * * Put our name suffix into SEGNM in common. That way, RDBAP (the main) * will not reload us if another request comes through for us to handle. * LDA SUFIX STA SEGNM * * Determine the type of IMAGE call being made by the index calculated in * the main and jump to the proper handling routine. Remember that this * index is: 45 - (RDBA Index). * LDA RQBUF+RBIDX ADA JMPTB JMP A,I * JMPTB DEF *+1 JMP UNL RDBA Index = 45, DBUNL JMP LCK RDBA Index = 44, DBLCK JMP E159 JMP E159 RDBA Index within [43,39] JMP E159 should not happen. JMP E159 JMP E159 JMP CLS RDBA Index = 38, DBCLS JMP INF RDBA Index = 37, DBINF JMP OPN RDBA Index = 36, DBOPN SKP * * A remote DBOPN. * The RDBA request buffer contains the following information. * OPMOD EQU RQBUF+RBMOD open mode LEVEL EQqU RQBUF+RBID level code word (3 words) OPBAS EQU RQBUF+RBBAS data base namr * * The status array is directly following the DS reply buffer heading. * In the 24th word of the reply buffer, we return our suffix. * OPSTA EQU RQBUF+RBSTA status array OPSUF EQU RQBUF+RBNUM remote data base number. * * Save off maximum acceptable Run Table size for later. * OPN LDA RQBUF+RBMRT STA MAXRT * * Perform the DBOPN call. * JSB DBOPN DEF *+5 DEF OPBAS DEF LEVEL DEF OPMOD DEF OPSTA * * If DBOPN succeeded, we need to build the source node's compacted Run * Table and increment the data base count. Else, we can just return the * error to the source node. * CLB Set length of reply data to zero. LDA OPSTA SZA JMP EXIT * * Since DBOPN succeeded, put our index into first byte of OPSUF, then * set the reply length to one more than the standard reply length. * ISZ DBCNT Increment data base count. LDA CLASS+1 ALF,ALF IOR OPBAS STA OPSUF ISZ LENTH * * Initialize the parameters for the Run Table build. * * * Get the address of the data buffer from common. * LDA DAADR STA ADDRS * * Determine the address for the item number buffer. We will use this for * a call to DBINF in mode 103. This returns the number of accesible items * in the data base and their respective item numbers (negative if write- * able). * ADA BFLEN Use the last 256 words of the ADA M256 data buffer. Maximum of STA ITADR 255 items. * * Call DBINF to return us the item count and numbers. * JSB DBINF DEF *+6 DEF OPBAS DEF DUMMY This param ignored. DEF D103 DEF DUMMY We need only 2 words for status. DEF ITADR,I * * Now, our data buffer looks like this: * * word +------------------------------+ * DABUF -> 1 | | * | unused | * | as | * | of | * | yet | * | | * -------------------------------- * DABUF + BFLEN - 256 | item count | * | followed by count | * | number of item numbers | * DABUF + BFLEN +------------------------------+ * * We want to build the item table for the remote machine at the begin- * ning + 1 word of the data buffer as follows: * For each item number returned to us through the DBINF 103 call, call * DBINF in mode 102 to get the item's name, element count and element * length. (DBINF actually returns us 13 words of info but only these * 9 words are of interest to us.) These 13 words of info are put into * the first 13 words of the data buffer which, as of yet, have not been * used. To get an idea of what this does, the data buffer with look * like this after the first mode 102 call: * * word +------------------------------+ * DABUF + 2 | 16 character | * | data item name | * | (8 words) | * -------------------------------- * DABUF + 10 | item type | blank | * -------------------------------- * DABUF + 11 | element length | * -------------------------------- * DABUF + 12 | element count | * -------------------------------- * DABUF + 13 | doubleword | * | zero | * -------------------------------- * DABUF + 15 | | * | unused | * | as | * | of | * | yet | * | | * -------------------------------- * DABUF + BFLEN - 256 | item count | * | followed by count num- | * | ber of item numbers | * DABUF + BFLEN +------------------------------+ * * We then condense these 13 words into the 5 words needed by a remote * 1000 node. The result takes the form: * * word +------------------------------+ * DABUF + 2 | item name | * | (3 words) | * | | * -------------------------------- * DABUF + 5 | item number | * -------------------------------- * DABUF + 6 | item length = element count *| element length * -------------------------------- * DABUF + 7 | | * | unused | * | as | * | of | * | yet | * | | * -------------------------------- * DABUF + BFLEN - 256 | item count | *  | followed by count num- | * | ber of item numbers | * DABUF + BFLEN +------------------------------+ * * The first word of the data buffer contains the item count which is taken * from the first word of the item number buffer at the end. The buffer * for the next DBINF call then starts at the first word following the 5 * words of information for the first item. This process is repeated for * each item in the item number list. * LDA ITADR,I Use negative number of items STA ADDRS,I as a loop counter. ISZ ADDRS SZA,RSS JMP OPN2 No items accessible. CMA,INA STA CNTR * OPN1 ISZ ITADR If item number is negative, LDA ITADR,I make it positive. SSA CMA,INA STA ITADR,I * JSB DBINF Get the item's info. DEF *+6 DEF OPBAS DEF ITADR,I DEF D102 DEF DUMMY DEF ADDRS,I * LDB ADDRS Get item type from ADB D8 returned info STB TEMP and save. INB Get element length LDA B,I INB and element count STB DUMMY CLB and multiply to get item MPY DUMMY,I length in a register. LDB TEMP,I If item type is X CPB /X this length is now in bytes. ARS get it in words. * LDB ADDRS Compact the info. ADB D3 STB ADDRS LDB ITADR,I STB ADDRS,I ISZ ADDRS STA ADDRS,I ISZ ADDRS * ISZ CNTR JMP OPN1 * * Now that we've built the item table for the remote machine, we need to * build its set table. The set table is built basically the same as the * item table. First we do a mode 203 DBINF call to get the count and * numbers of all available sets. Then, for each set we do a mode 202 call * to get the set name, entry length and set type. Although DBINF returns * 17 words of information only these five words are of interest. We then * compact the 17 words into 5 words for the remote 1000. After this com- * paction, we check the type of the data set. If it is a master, we need * to determine the length of its key item. GETKY performs this service * for us. Then, the key item length is appended to the compacted informa- * tion. If the set is a detail, a zero is appended. Each entry, then, * appears as: * * +------------------------------+ * | set name | * | (3 words) | * | | * -------------------------------- * | set number | * -------------------------------- * | length of entry | * -------------------------------- * | key item length, or zero | * +------------------------------+ * * Preceding the set table, and in the first word after the item table, is * stored the set count. The final remote Run Table then looks like: * * +------------------------------+ * | item count | * -------------------------------- * | item table | } 5 * | entry # 1 | } words * -------------------------------- * . . * . . * . . * -------------------------------- * | item table | *  | entry # count | * -------------------------------- * | set count | * -------------------------------- * | set table | } 6 * | entry # 1 | } words * -------------------------------- * . . * . . * . . * -------------------------------- * | set table | * | entry # count | * +------------------------------+ * * * First, determine the address for the set number buffer. We will use the * last 51 words of the data buffer for this purpose. * OPN2 LDA DAADR ADA BFLEN ADA M51 STA STADR * * Call DBINF to return us the set count and numbers. * JSB DBINF DEF *+6 DEF OPBAS DEF DUMMY This param. ignored DEF D203 DEF DUMMY Two words of status only DEF STADR,I * * Put the set count in the data buffer, and negate it for a loop counter. * LDA STADR,I STA ADDRS,I ISZ ADDRS SZA,RSS JMP OPN5 No sets accessible CMA,INA STA CNTR * * For each set number in the buffer get the necessary information. * OPN3 ISZ STADR LDA STADR,I If the set number is negative, SSA CMA,INA make it positive. STA STADR,I * JSB DBINF DEF *+6 DEF OPBAS DEF STADR,I DEF D202 DEF DUMMY DEF ADDRS,I * * Compact the information we already have. * LDB ADDRS ADB D8 But first get and save the k LDA B,I set type in word 8 STA TEMP INB and the entry length LDA B,I in word 9. STA DUMMY * LDB ADDRS ADB D3 LDA STADR,I Set number STA B,I INB LDA DUMMY Entry length STA B,I INB STB ADDRS Save place in entry. * * If set a master, get its key item length through GETKY. * LDA TEMP CPA /D JMP OPN4 * JSB GETKY Returns length DEF *+2 in A register. DEF STADR,I RSS * OPN4 CLA Length = 0 for a detail STA ADDRS,I ISZ ADDRS ISZ CNTR JMP OPN3 * * Run Table complete. Calculate the length of the returned data as fol- * lows: * length = (# of items) * 5 * + (# of sets) * 6 * + 2 <>. * Make sure that the Run Table built is no longer than the maximum allow- * able, then jump with the data length in the B register to the exit * routine. If the resulting Run Table is longer than maximum, then clean- * up open and return an IMAGE size error. * OPN5 LDA DABUF CLB MPY D5 STA TEMP ADA DAADR INA LDA A,I CLB MPY D6 LDB D2 ADB A ADB TEMP * STB A A = B = length of built Run Table. CMA,INA ADA MAXRT SSA,RSS A > max. allowed? JMP EXIT No * LDA OPSUF Yes - get data base number AND LOBYT from reply buffer. STA TEMP * JSB DBCLS Close newly opened data base. DEF *+5 DEF TEMP DEF D0 DEF D1 DEF DUMMY * CCA Decrement data base count. ADA DBCNT STA DBCNT * LDA D128 Set error code to 128 STA OPSTA LDA RPLEN reply length to 23 STA LENTH CLB and data length to zero. JMP EXIT Then return. * * Constants and variables. * M256 DEC -256 M51 DEC -51 D3 DEC 3 D5 DEC 5 D8 DEC 8 D102 DEC 102 D103 DEC 103 D128 DEC 128 D202 DEC 202 D203 DEC 203 * /D ASC 1,D /X ASC 1,X * CNTR NOP ADDRS NOP ITADR NOP STADR EQU ITADR DUMMY BSS 2 TEMP NOP MAXRT NOP SKP * * A remote DBINF. * The RDBA request buffer contains the following information: * IFMOD EQU RQBUF+RBMOD Info mode IFID EQU RQBUF+RBID Data set or item number IFBAS EQU RQBUF+RBBAS Data base parameter * * The status array is directly following the DS reply header. * IFSTA EQU RQBUF+RBSTA * * The ibuf parameter is the data buffer. * IFBUF EQU DABUF * * Perform the DBINF call. * INF LDA IFMOD Save the MODE for later. STA TEMP2 * JSB DBINF DEF *+6 DEF IFBAS DEF IFID DEF IFMOD DEF IFSTA DEF IFBUF * * If DBINF returned an error code or this was a mode 402 request, there * is no data to return. Else, get the length of the data to return from * the second word of istat and jump to the EXIT routine. * CLB LDA TEMP2 CPA D402 RSS LDA IFSTA SZA,RSS LDB IFSTA+1 JMP EXIT TEMP2 NOP SKP * * A remote DBCLS. * The RDBA request buffer contains the following information: * CLMOD EQU RQBUF+RBMOD Close mode CLID EQU RQBUF+RBID Data set number CLBAS EQU RQBUF+RBBAS Data base parameter * * The status array is directly following the DS reply header. * CLSTA EQU RQBUF+RBSTA * * There is no data associated with the request or reply. * * Perform the DBCLS call. * CLS LDA CLMOD Save the close mode. STA TEMP2 * JSB DBCLS DEF *+5 DEF CLBAS DEF CLID DEF CLMOD DEF CLSTA * * Set the returned data langth to zero. Then, if the close mode was 1 * and the DBCLS call succee@ded, decrement the data base count. * CLB LDA TEMP2 CPA D1 RSS JMP EXIT * CCB ADB DBCNT LDA CLSTA 1st word of CLSTA is zero SZA,RSS if DBCLS succeeded. STB DBCNT CLB JMP EXIT SKP * * A remote DBLCK. * The RDBA buffer contains the following information: * LKMOD EQU RQBUF+RBMOD Lock mode LKID EQU RQBUF+RBID Unused data set number LKBAS EQU RQBUF+RBBAS Data base parameter * * The status array is the directly following the DS reply buffer. * LKSTA EQU RQBUF+RBSTA * * There is no data associated with the request or reply. * * Perform the DBLCK call. * LCK JSB DBLCK DEF *+5 DEF LKBAS DEF LKID DEF LKMOD DEF LKSTA * * Set the returned data length to zero and jump to the exit routine. * CLB JMP EXIT SKP * * A remote DBUNL. * The RDBA request buffer contains the following information: * ULMOD EQU RQBUF+RBMOD Unlock mode ULID EQU RQBUF+RBID Unused data set number ULBAS EQU RQBUF+RBBAS Data base parameter * * The status array is the directly following the DS reply buffer. * ULSTA EQU RQBUF+RBSTA * * There is no data associated with the request or reply. * * Perform the DBUNL call. * UNL JSB DBUNL DEF *+5 DEF ULBAS DEF ULID DEF ULMOD DEF ULSTA * * Set the returned data length to zero and continue into the exit routine. * CLB JMP EXIT SKP * * This is the only DS error return point. A bad RDBA index found. * E159 LDB M159 Get error code and set CLA returned data length to zero. STA RECDA JMP EXIT2 * * This is the exit routine for segment 1 of RDBAP. Its purpose is to * call the necessary subroutines in order to send the RDBA reply to the * orginating node and to terminate this operation. All replies are sent * through4K RDEXT. * EXIT STB RECDA Set returned data length in common. CLA Set error code to zero CLB i.e. no error. EXIT2 DST ERROR * JSB RDEXT RDEXT builds the reply buffer DEF *+6 and then sends it to the DEF RQBUF originator through #SLAV. DEF LENTH DEF DABUF DEF RECDA DEF ERROR RSS Error on sending reply. JMP EXIT3 Normal return. * * On error from RDEXT, check to see if this was a successful DBOPN re- * quest. (The reply length will be 24 in this case.) If so, close the * newly opened data base and decrement the data base count. * LDA LENTH CPA OLEN RSS JMP EXIT3 Not a DBOPN. * LDA OPSUF Get data base number AND LOBYT from reply buffer. STA TEMP This is all we need for DBCLS. * JSB DBCLS DEF *+5 DEF TEMP DEF D0 DEF D1 Close mode 1. DEF DUMMY Dummy status array. * CCA Decrement data base count. ADA DBCNT STA DBCNT * * If the data base count is now zero, we want to terminate ourselves. * EXIT3 LDA DBCNT If data base count is not zero, SZA JMP BP.GT return to class get in main. * LDA M2 Else, tell RDBAM to OFf us. STA RQBUF+RBIDX RDBA Index = -2 for such a request. LDA CLASS+1 Mode is our index into STA RQBUF+RBMOD the RDBAP copy scheduling table. JSB EXEC DEF *+8 DEF WT/RD write/read w/no abort DEF CONTR double buffer, lu 0 DEF DABUF DEF D0 no data DEF RQBUF OFf request buffer DEF RPLEN and length DEF CLASS+2 RDBAM's class number NOP ignore abortion return * JSB EXEC Then terminate. DEF *+4 DEF D6 DEF D0 DEF D0 Normal completion. * * ConstantsZXT and variables. * M159 DEC -159 M2 DEC -2 D0 DEC 0 D1 DEC 1 D2 DEC 2 D6 DEC 6 D402 DEC 402 * WT/RD OCT 100024 CONTR OCT 010000 LOBYT OCT 377 SUFIX ASC 1,1 * ERROR BSS 2 LENTH NOP END BAPS1 `Z v 91750-18184 2013 S C0122 &BAPS2 &BAPS2             H0101 ASMB HED BAPS2 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 2 NAM BAPS2,5 91750-1X184 REV.2013 800523 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18184 * RELOC: 91750-1X184 * * * ******************************************************************* * * * COM DABUF(2174),RQBUF(30) COM RECRQ,RECDA,SEGNM * * Segment two of the Remote Data Base Access Program. This segment has * the following sequence of operations. * * 1) Determine the type of IMAGE call and branch to the appropriate call * handler. * * A) DBFND * * I ) Perform the DBFND call. * * II) Go to 2. * * B) DBGET * * I ) Perform the DBGET call. * * II) Go to 2. * * C) DBUPD * * I ) Perform the DBUPD call. * * II) Go to 2. * * 2) Send the RDBA reply and any associated data. Ignore any errors. * * 3) Return to class get in main. * SKP ********************************************************************** *** *** * Standard DS/1000 equates * *** *** *$ *$ * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * ^ * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * *** *** ********************************************************************** ********************************************************************** * * * DS/1000 RDBA Communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * These two static buffers are as described below. * * x * ********************************************************************** *** *** * * * Request buffer - one buffer of from 12 to 21 words per RDBA call * * * *** *** RBSTR EQU #STR DS/1000 stream word RBSEQ EQU #SEQ DS/1000 sequence number RBSRC EQU #SRC DS/1000 source node number RBDST EQU #DST DS/1000 destination node number RBIDX EQU #REQ RDBA call Index RBMOD EQU #REQ+1 RDBA call mode RBID EQU #REQ+2 RDBA call item or set number * or for a DBOPN, the level code word RBITM EQU #REQ+3 Search item number for DBFND RBMRT EQU #REQ+5 For DBOPN, the max. returned RT size RBLEN EQU #REQ+6 Word size of ibase parameter RBBAS EQU #REQ+7 Ibase parameter * MAXRQ DEC 30 Maximum request buffer length *** *** *** *** * * * Reply buffer - one buffer of either 17 or 18 words per RDBA call * * * *** * * RBSTR EQU #STR DS 1000 stream word * RBSEQ EQU #SEQ DS/1000 sequence number * RBSRC EQU #SRC DS/1000 source node number * RBDST EQU #DST DS/1000 destination node number RBEC1 EQU #EC1 DS/1000 1st error code word RBEC2 EQU #EC2 DS/1000 2nd error code word RBEC3 EQU #ENO DS/1000 error node number upon an error RBSTA EQU #REP RDBA call status array RBNUM EQU #REP+10 RDBA data base number for DBOPN * RPLEN DEC 23 Standard reply buffer length * WG 24 for DBOPN *** *** ********************************************************************** ENT BAPS2 EXT BP.GT,DBFND,DBGET,DBUPD EXT RDEXT * DAADR DEF DABUF A EQU 0 B EQU 1 * * Put our name suffix into SEGNM in common. That way, if another request * comes through for this segment, RDBAP (the main) will not reload us. * BAPS2 LDA SUFIX STA SEGNM * * Determine the type of IMAGE call being made by the index calculated * in the main and jump to the proper handling routine. Remember that * this index is: 45 - (RDBA Index). * LDB RQBUF+RBIDX ADB JMPTB JMP B,I * JMPTB DEF *+1 JMP E159 JMP E159 RDBA Index within [45,42] JMP E159 should not happen. JMP E159 JMP UPD RDBA Index = 41, DBUPD JMP GET RDBA Index = 42, DBGET JMP FND RDBA Index = 40, DBFND JMP E159 JMP E159 RDBA Index within [39,36] JMP E159 should not happen. SKP * * A remote DBFND. * The request buffer contains the following information: * FNMOD EQU RQBUF+RBMOD Find mode FNSET EQU RQBUF+RBID Data set number FNITM EQU RQBUF+RBITM Data item number FNBAS EQU RQBUF+RBBAS Data base parameter * * The status array is directly following the DS reply buffer. * FNSTA EQU RQBUF+RBSTA * * The key item value is in the data buffer. * FNARG EQU DABUF * * Perform the DBFND call. * FND JSB DBFND DEF *+7 DEF FNBAS DEF FNSET DEF FNMOD DEF FNSTA DEF FNITM DEF FNARG * * There is no data to return, so set reply data length to zero (in B * register) and jump to the exit routine. * CLB JMP EXIT SKP * * A remote DBGET. * The request buffer contains the following information: * GTMOD EQU RQBUF+RBMOD Get mode GTSET EQU RQBUF+sTRBID Data set number GTBAS EQU RQBUF+RBBAS Data base parameter * * The status array is directly following the DS reply buffer. * GTSTA EQU RQBUF+RBSTA * * The item list is the 2nd through ?th words of the data buffer. * GTLST EQU DABUF+1 * * The key item value for a mode 7 get or the record number for a mode * 4 get is in the necessary number of words immediately following the * item list in the data buffer. The first word of the data buffer con- * tains the length of the item list. Therefore, the address of the IARG * parameter is the address of the data buffer plus the length of the list * plus one. * GET LDA DAADR ADA DABUF INA STA GTARG * * Perform the DBGET call, the data read is returned in the data buffer. * JSB DBGET DEF *+8 DEF GTBAS DEF GTSET DEF GTMOD DEF GTSTA DEF GTLST DEF DABUF DEF GTARG,I * * If DBGET did not succeed (i.e. first word of GTSTA NE 0) then the re- * turned data length is zero. Else, the returned data length is in the * 2nd word of the status array. Get this length in the B register and * jump to the exit routine. * CLB LDA GTSTA SZA,RSS LDB GTSTA+1 JMP EXIT * * Constants and variables. * GTARG NOP SKP * * A remote DBUPD. * The request buffer contains the following information: * UPMOD EQU RQBUF+RBMOD Update mode UPSET EQU RQBUF+RBID Data set number UPBAS EQU RQBUF+RBBAS Data base parameter * * The status array is directly following the DS reply buffer. * UPSTA EQU RQBUF+RBSTA * * The item list starts in the 2nd word of the data buffer. * UPLST EQU DABUF+1 * * The values for the items in the item list immediately follow the item * list in the data buffer. The first word of the data buffer contains * the length of the item list. Therefore, the address of the value buf- * fer is the address of the data buffer plu]$"s the length of the item list * plus one. * UPD LDA DAADR ADA DABUF INA STA UPBUF * * Perform the DBUPD call. * JSB DBUPD DEF *+7 DEF UPBAS DEF UPSET DEF UPMOD DEF UPSTA DEF UPLST DEF UPBUF,I * * There is no return data, so set the length of returned data to zero, * and jump to the exit routine. * CLB JMP EXIT * * Constants and variables. * UPBUF NOP SKP * * The only DS error routine is when the RDBA Index for this segment is * in error. * E159 LDB M159 CLA STA RECDA Set data length to zero. JMP EXIT2 * * This is the exit routine for segment 2 of RDBAP. Its purpose is to * call the necessary subroutines in order to send the RDBA reply to the * originating node and to terminate the program, saving resources. All * DS replies are sent through RDEXT. * EXIT STB RECDA Set returning data length CLA CLB and zero the error code. EXIT2 DST ERROR * JSB RDEXT Then let RDEXT send the reply. DEF *+6 DEF RQBUF It needs: reply buffer DEF RPLEN reply length DEF DABUF data buffer DEF RECDA data length DEF ERROR error code NOP * JMP BP.GT Return to class get in main. * * Constants and variables. * M159 DEC -159 * SUFIX ASC 1,2 * ERROR BSS 2 END BAPS2 _$ w 91750-18185 2013 S C0122 &BAPS3 &BAPS3             H0101 ASMB HED BAPS3 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 3 NAM BAPS3,5 91750-1X185 REV.2013 800523 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18185 * RELOC: 91750-1X185 * * * ******************************************************************* * * * COM DABUF(2174),RQBUF(30) COM RECRQ,RECDA,SEGNM * * Segment three of the Remote Data Base Access Program. This segment * has the following sequence of operations. * * 1) Determine the tyep of IMAGE call and branch to the appropriate call * handler. * * A) DBPUT * * I ) Perform the DBPUT call. * * II) Go to 2. * * B) DBDEL * * I ) Perform the DBDEL call. * * II) Go to 2. * * 2) Send the RDBA reply (no data). * * 3) Return to class get in main. * SKP ********************************************************************** *** *** * Standard DS/1000 equates * *** *** *** *** *$ * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFM}PST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * *$ ********************************************************************** ********************************************************************** * * * DS/1000 RDBA Communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * These two static buffers are as described below. * * * ********************************************************************** ***  *** * * * Request buffer - one buffer of from 12 to 21 words per RDBA call * * * *** *** RBSTR EQU #STR DS/1000 stream word RBSEQ EQU #SEQ DS/1000 sequence number RBSRC EQU #SRC DS/1000 source node number RBDST EQU #DST DS/1000 destination node number RBIDX EQU #REQ RDBA call Index RBMOD EQU #REQ+1 RDBA call mode RBID EQU #REQ+2 RDBA call item or set number * or for a DBOPN, the level code word RBITM EQU #REQ+3 Search item number for DBFND RBMRT EQU #REQ+5 For DBOPN, the max. returned RT size RBLEN EQU #REQ+6 Word size of ibase parameter RBBAS EQU #REQ+7 Ibase parameter * MAXRQ DEC 30 Maximum request buffer length *** *** *** *** * * * Reply buffer - one buffer of either #MHD+17 or 18 words/RDBA call * * * *** * * RBSTR EQU #STR DS 1000 stream word * RBSEQ EQU #SEQ DS/1000 sequence number * RBSRC EQU #SRC DS/1000 source node number * RBDST EQU #DST DS/1000 destination node number RBEC1 EQU #EC1 DS/1000 1st error code word RBEC2 EQU #EC2 DS/1000 2nd error code word RBEC3 EQU #ENO DS/1000 error node number upon an error RBSTA EQU #REP RDBA call status array RBNUM EQU #REP+10 RDBA data base number for DBOPN * RPLEN DEC 23 Standard reply buffer length * one more for DBOPN *** *** ********************************************************************** ENT BAPS3 EXT BP.GT,DBDEL,DBPUT EXT RDEXT * A EQU 0 B EQU 1 DAADR DEF DABUF * * Put our name suffix into SEGNM in common. That way, if another request * comes though for this segment, RDBAP (the main) will not reload us. * BAPS3 LDA SUFIX STA SEGNM * * Determine the type of IMAGE call being made by the index calculated * in the main and jump to the proper handling routine. Remember that * this index is: 45 - (RDBA Index). * LDB RQBUF+RBIDX ADB JMPTB JMP B,I * JMPTB DEF *+1 JMP E159 RDBA Index within [45,44] JMP E159 should not happen JMP DEL RDBA Index = 43, DBDEL JMP PUT RDBA Index = 42, DBPUT JMP E159 JMP E159 JMP E159 RDBA Index within [41,36] JMP E159 should not happen. JMP E159 JMP E159 SKP * * A remote DBPUT. * The request buffer contains the following information: * PTMOD EQU RQBUF+RBMOD Put mode PTSET EQU RQBUF+RBID Data set number PTBAS EQU RQBUF+RBBAS Data base parameter * * The status array directly following the DS reply buffer. * PTSTA EQU RQBUF+RBSTA * * The item list starts in the 2nd word of the data buffer. * PTLST EQU DABUF+1 * * The values for the items in the item list immediately follow the item * list in the data buffer. The first word of the data buffer contains * the length of the item list. Therefore, the address of the value buf- * fer is the address of the data buffer plus the length of the item list * plus one. * PUT LDA DAADR ADA DABUF INA STA PTBUF * * Perform the DBPUT call. * JSB DBPUT DEF *+7 DEF PTBAS DEF PTSET DEF PTMOD DEF PTSTA DEF PTLST DEF PTBUF,I * * There is no return data, so set the length of returned data to zero, * and jump to the exit ro (utine. * CLB JMP EXIT * * Constants and variables * PTBUF NOP SKP * * A remote DBDEL. * The information in the request buffer is as follows: * DEMOD EQU RQBUF+RBMOD Delete mode DESET EQU RQBUF+RBID Data set number DEBAS EQU RQBUF+RBBAS Data base parameter * * The status array directly following the DS reply buffer. * DESTA EQU RQBUF+RBSTA * * There is no data associated with either the request or reply. * * Perform the DBDEL call. * DEL JSB DBDEL DEF *+5 DEF DEBAS DEF DESET DEF DEMOD DEF DESTA * * Set the returned data length to zero and jump to the exit routine. * CLB JMP EXIT SKP * * The only DS error is when the RDBA index for this segment is in error. * E159 LDB M159 CLA STA RECDA Set the data length to zero. JMP EXIT2 * * This is the exit routine for segment 3 of RDBAP. Its purpose is to * call the necessary subroutines in order to send the RDBA reply to the * orginiating node and to terminate the program, saving resources. All * DS replies are sent through RDEXT. * EXIT STB RECDA Set returned data length. CLA CLB Set the error code to zero. EXIT2 DST ERROR * JSB RDEXT Then, let RDEXT send the reply. DEF *+6 DEF RQBUF It needs: reply buffer DEF RPLEN reply length DEF DABUF data buffer DEF RECDA data length DEF ERROR error code NOP * JMP BP.GT Return to class get in main. * * Constants and variables. * M159 DEC -159 * SUFIX ASC 1,3 * ERROR BSS 2 END BAPS3  x 91750-18186 2013 S C0122 &BAPS4 &BAPS4             H0101 ASMB HED BAPS4 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 4 NAM BAPS4,5 91750-1X186 REV.2013 790812 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18186 * RELOC: 91750-1X186 * * * ******************************************************************* * * * * COM DABUF(2174),RQBUF(30) COM RECRQ,RECDA,SEGNM,DBCNT,CLASS(5) * * Segment 4 of the Remote Data Base Access Program. This segment is the * special clean-up segment and has the following sequence of operations: * * 1) For each entry in data base pointer table: * * A) If entry not empty, call DBCLS to release the data base to * whose Run Table it points. * * 2) Send a request to RDBAM to remove us from the system and terminate * normally. SKP ********************************************************************** *** *** * Standard DS/1000 equates * *** *** *$ * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, E}XECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * *$ *** *** ********************************************************************** ********************************************************************** * * * DS/1000 RDBA communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * These two static buffers are as described below. * * * ********************************************************************** *** *** * g * * Request buffer - one buffer of from 12 to 21 words per RDBA call * * * *** *** RBSTR EQU #STR DS/1000 stream word RBSEQ EQU #SEQ DS/1000 sequence number RBSRC EQU #SRC DS/1000 source node number RBDST EQU #DST DS/1000 destination node number RBIDX EQU #REQ RDBA call Index RBMOD EQU #REQ+1 RDBA call mode RBID EQU #REQ+2 RDBA call item or set number * or for a DBOPN, the level code word RBITM EQU #REQ+3 search item number for DBFND RBMRT EQU #REQ+5 For DBOPN, the max. returned RT size RBLEN EQU #REQ+6 word size of ibase parameter RBBAS EQU #REQ+7 ibase parameter * MAXRQ DEC 30 maximum request buffer length *** *** *** *** * * * Reply buffer - one buffer of either 17 or 18 words per RDBA call * * * *** *** * RBSTR EQU #STR DS/1000 stream word * RBSEQ EQU #SEQ DS/1000 sequence number * RBSRC EQU #SRC DS/1000 source node number * RBDST EQU #DST DS/1000 destination node number RBEC1 EQU #EC1 DS/1000 1st error code word RBEC2 EQU #EC2 DS/1000 2nd error code word RBEC3 EQU #ENO DS/1000 3rd error code word RBSTA EQU #REP RDBA call status array RBNUM EQU #REP+10 RDBA data base number for DBOPN * RPLEN DEC 23 standard reply buffer length * one more for DBOPN *** *** ********************************************************************** EXT DBCLS,DBRTP,DBRTM,EXDEC,RDEXT * A EQU 0 B EQU 1 * * Get the -(maximum number of entries in data base pointer table) as a * loop counter, get a copy of the address of this table, and set the data * base index to 1. * BAPS4 LDA DBRTM CMA,INA STA CNTR * LDA DBRTP STA ADDRS CLB,INB STB INDEX * * For each entry in the table: * 1) If entry not empty, call DBCLS to release data base. * LOOP LDB ADDRS,I SZB,RSS JMP EMPTY Entry is empty. * JSB DBCLS DEF *+5 DEF INDEX Only the d.b. index is needed by DBCLS. DEF D0 DEF D1 Close mode 1. DEF STAT * EMPTY ISZ INDEX Bump d.b. index, ISZ ADDRS and R.T. pointer table address. ISZ CNTR Done with all entries? JMP LOOP No - continue. * * When done, send the requestor a successful reply. * CLA CLB DST ERROR * JSB RDEXT DEF *+6 DEF RQBUF reply buffer DEF RPLEN reply length DEF DABUF DEF D0 no data DEF ERROR NOP ignore errors. * * Send RDBAM a special "remove me" request to purge this copy from the * system. * LDA M2 RDBA Index for such a STA RQBUF+RBIDX request is -2. LDA CLASS+1 Mode for the request is STA RQBUF+RBMOD our index into scheduling table. * JSB EXEC DEF *+8 DEF WT/RD Class write/read w/no abort DEF CONTR double buffer, lu 0 DEF DABUF DEF D0 no data DEF RQBUF request buffer DEF RPLEN and its length DEF CLASS+2 RDBAM's class number NOP Ignore any errors. * * Terminate, normal completion. * JSB EXEC DEF *+4 DEF D6 DEF D0 DEF D0 * * Constants and variables. * M2 DEC -2 D0 DEC 0 D1 DEC 1 D6 DEC 6 * WT/RD OCT 100024 COkNTR OCT 010000 * CNTR NOP ADDRS NOP INDEX NOP ERROR BSS 2 STAT EQU ERROR END BAPS4 END$ K y 91750-18187 2013 S C0122 &RBMST &RBMST             H0101 .ASMB HED RBMST UTILITY SUBROUTINE OF RDBA-IMAGE/1000 NAM RBMST,7 91750-1X187 REV.2013 791029 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18187 * RELOC: 91750-1X187 * * * ******************************************************************* * * * * Remote data Base MaSTer is a utility subroutine for the RDBA subrou- * tines whose function it is to take the RDBA parameters and build the * DS/1000 or request buffer, send the request to the remote node and * await the reply. When the reply is received, RBMST breaks the reply * buffer into the RDBA reply parameters. If a DS error occurs, it puts the * error code in the status array and takes the error exit, else it takes * the normal return. * * The calling sequence for RBMST is: * * JSB RBMST * DEF *+11 return address * DEF INDEX RDBA index * DEF MODE IMAGE call mode * DEF INFO1 - for DBOPN this is a 3 word level code word * - for all other calls, this is a data set or * data item number. * DEF INFO2 - for a DBFND this is a data item number * - for a DBGET this is the word length of the * data expected * - for a DBOPN the remote data base number * - for all other calls this parameter is a dummy * DEF BASE IMAGE call base parameter * DEF STAT IMAGE call status array. * DEF OUTDA outgoing data buffer * DEF OUTLN outgoing data le(ngth * DEF INDA incoming data buffer * DEF INLN incoming data length * < error return > * < normal return > * SKP ********************************************************************** * * * Run Table for local machine in Remote Data Base Access * * * * The local copy of the Run Table used by the RDBA master subrou- * * tines consists of the following sections: * * * * 1) Data Base Control Block * * 2) Data Item Table * * 3) Data Set Table * * 4) Sort Table * * * * These sections are in the order stated. Details of each section * * follow. * * * ********************************************************************** *** *** * * * Data Base Control Block - one 17 word entry per data base * * * *** *** * * * RDCBS DEC 17 DCB size * * RDNAM DEC 0 data base name - three words RDRBN DEC 3 remote data base number RDDSN DEC 5 DS node number * RDITC DEC 7 data item count * RDITP DEC 8 data item table pointer * RDDSC DEC 9 l data set count * RDDSP DEC 10 data set table pointer * RDSOP DEC 11 sort table pointer * RDLMD DEC 13 lock flag/open mode * RDLFG DEC RDLMD 1st byte: lock flag * RDMOD DEC RDLMD 2nd byte: open mode * RDCBC DEC 15 # of DCBs desired = 0 * RDMDL DEC 16 maximum data length * *** * * Standard DS/1000 equates. * *$ * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * * ********************************************************************** * * * DS request buffer for RDBA. * * * * The request buffer is comprised of the following sections: * * * * 1) standard DS/1000 header * * 2) apppendage * * * * These section appear in the order stated. Details of each * * section follow. * * * ********************************************************************** *** *** * * * DS/1000 header - one 13 word entry per request * * * *** *** DS1HL EQU #MHD header length * DS1ST EQU #STR stream word, stream # = 10 DS1SQ EQU #SEQ RTE sequence number DS1DN EQU #DST destination node number DS1RQ EQU #REQ start of request specific buffer * *** *** * * * Appendage - from 9 to 27 words per request * * * *** *** RBIDX EQU #REQ RDBA index RBMOD EQU RBIDX+1 IMAGE call mode RBIN1 EQU RBMOD+1 IMAGE call info RBLEV EQU RBIN1 - for DBOPN level code word RBID EQU RBIN1 - for other calls, set or item # RBIN2 EQU RBIN1+1 IMAGE call info RBITM EQU RBIN2 - for DBFND item number RBDLN EQU RBIN2 - for DBGET expected data length RBMRT EQU RBIN2+2 for DBOPN, the max. returned RT size RBBLN EQU RBMRT+1 word size of base parameter RBBAS EQU RBBLN+1 base parameter RBRBN EQU RBBAS 1st word: remote base number RBBNR EQU RBBAS+1 remainder of base parameter * RBLVL DEF #RQB+RBLEV RBNAM DEF #RQB+RBBNR RBASE DEF RBBAS SKP ********************************************************************** * * * DS reply buffer for RDBA. * * * * The reply buffer is comprised of the following sections: * * * * 1) standard DS/1000 header * * 2) appendage * * * * These section appear in the order stated. Details of each * * section follow. * * * ********************************************************************** *** *** * * * DS/13000 header - one 13 word entry per reply * * ! * * * *** *** DS1RL EQU #MHD header length * DS1E1 EQU #EC1 DS error code word 1 DS1E2 EQU #EC2 DS error code word 2 DS1EN EQU #ENO node # at which error occurred * DSRL DEF DS1RL length of header DSTAT DEF #RQB+#REP address of returned 10 word status *** *** * * * Maximum reply length is 24 words. * * * *** *** RPMAX DEC 24 SKP A EQU 0 B EQU 1 * ENT RBMST EXT .ENTR,.MVW,AIRUN,#MAST,#RQB * INDEX NOP MODE NOP INFO1 NOP INFO2 NOP BASE NOP STAT NOP OUTDA NOP OUTLN NOP INDA NOP INLN NOP * * Get true parameter and return point addresses. * RBMST NOP JSB .ENTR DEF INDEX * * Build the appendage: * * 1) RDBA index * LDA INDEX,I STA #RQB+RBIDX * * 2) IMAGE call mode * LDA MODE,I STA #RQB+RBMOD * * 3) INFO1 and INFO2 * A) If INDEX NE 36 (i.e. request not a DBOPN) INFO1 and INFO2 are * both only 1 word long. Move them into the appendage and update * the appendage address to the word to contain the base parameter * size. * LDA INDEX,I CPA D36 JMP MST1 * LDA INFO1,I STA #RQB+RBIN1 LDA INFO2,I STA #RQB+RBIN2 JMP MST2 * * B) If INDEX = 36, INFO1 is a level code word (3 words long) * and INFO2 is ignored. Immediately following the level code * word in the appendage is the maximum Run Table size expected. * This is found in INLN. * MST1 LDLA INFO1 Move level code word LDB RBLVL to the appendage. JSB .MVW into appendage. DEF D3 DEC 0 * LDA INLN,I Move max. RT length STA #RQB+RBMRT into appendage. * * * 4) Word size of base parameter. We don't know this yet. * * * 5) Base parameter * A) Get remote data base number from the DBCB (4th word). This * is the first word of the parameter, for DBOPN this has been * set to two blanks. * MST2 LDA AIRUN ADA RDRBN LDA A,I STA #RQB+RBBAS * * B) Move the 2nd through ?th words of the base parameter into the * appendage word by word. We do this to keep a count of each * word we move and terminate the process with the first blank * or semi-colon encountered. However, in case the parameter is * incorrect, we allow no more than 10 words. * LDA M10 Set up maximum count. STA CNTR * CLA,INA A one to word count STA #RQB+RBBLN (for RDB number). LDB RBNAM * MST3 ISZ BASE Get next word in param. LDA BASE,I STA B,I and put it into appendage. INB * ISZ #RQB+RBBLN Bump word count CCA Set processing 1st byte flag. STA FIRST * LDA BASE,I Get first byte. ALF,ALF MST4 AND LOBYT * CPA BLANK Is it a blank? JMP MST6 Yes - end of base param. CPA SEMI No - is it a semi-colon? JMP MST6 Yes - end of base param. * ISZ FIRST Neither - was this the 1st byte? JMP MST5 No LDA BASE,I Yes - get 2nd JMP MST4 and check it. * MST5 ISZ CNTR Done with word, JMP MST3 is param too long? JMP E103 Yes - error * * Note that the length of the base parameter was set in the appendage * by the above loop, so it is complete. Set up the control word 02for the * DS master subroutine. This includes the no abort bit (bit 15) and * for DBOPN the long timeout bit (bit 14). * MST6 CLA,CCE,INA ERA LDB INDEX,I CPB D36 Index for DBOPN = 36. ERA STA CONWD SKP * * Build the standard four word header on the request. * * 1) stream word = 10 * LDA D10 STA #RQB * * 2) Destination node number = data base's node number which is found * in 6th word of DBCB. * LDA AIRUN ADA RDDSN LDA A,I STA #RQB+DS1DN * * Determine the length of the request = length of DS/1000 request header * + length of fixed part of appendage, (for index through * base length words) + length of base. * LDA RBASE ADA #RQB+RBBLN STA RQLEN * * Send request through #MAST, it also waits for the reply for us and re- * turns it in the request buffer and any associated data is returned in the * INDA buffer. * JSB #MAST DEF *+8 DEF CONWD D65MS needs: control word DEF RQLEN request length DEF OUTDA,I outgoing data buffer DEF OUTLN,I outgoing data length DEF INLN,I incoming data length DEF RPMAX maximum reply length DEF INDA,I incoming data buffer JMP DSERR error return point * STA RQLEN normal return, save reply length STB INLN and data returned length SKP * * Unbuffer the reply parameters. First we need to determine the length * and address of the appendage in the reply buffer. Length of appendage = * length of reply - length of DS standard reply header. Address of ap- * pendage = address of request reply buffer + length of DS standard reply * header. * LDB DSRL CMB,INB B = -(header length) ADB RQLEN B = length of appendage, STB APPLN save it. * * Move status array from reply into user's status array. Status in first * 10 words of appendage. * LDA DSTAT LDB STAT JSB .MVW DEF D10 DEC 0 * * If appendage length > 10, this was a successful DBOPN. Put Remote * Data base number from 11th word of appendage into INFO2 parameter. * LDB APPLN CMB,INB ADB D10 SSB,RSS JMP MST8 * LDA A,I A -> RDB # thanks to MVW, STA INFO2,I LDA RQLEN Get reply and data lengths again. LDB INLN * * Return to user. * MST8 ISZ RBMST Normal return point MST9 JMP RBMST,I * * Error return points. * * DS error. Set up status array as follows: * word +------------------------------------+ * 1 | -1 | * +------------------------------------+ * 2 | two word error | * -- -- * 3 | code from A & B regs. | * +------------------------------------+ * DSERR STA SAVE Save 1st word of error code. CCA STA STAT,I ISZ STAT * LDA SAVE Pick up entire error code again DST STAT,I and put it in status array. JMP MST9 Take error return point. * * Illegal base parameter error. * E103 LDA D103 Error code = 103. STA STAT,I JMP MST8 Take normal return point. * * Constants and variables. * M10 DEC -10 D3 DEC 3 D10 DEC 10 D36 DEC 36 D44 DEC 44 D103 DEC 103 * LOBYT OCT 377 BLANK OCT 040 SEMI OCT 073 * SAVE NOP MVLEN NOP FIRST NOP CNTR EQU MVLEN APPLN EQU FIRST CONWD NOP * RQLEN NOP END $END %<:66< z 91750-18188 2013 S C0122 &RDEXT &RDEXT             H0101 ASMB HED RDEXT UTILITY SUBROUTINE FOR RDBAM & RDBAP NAM RDEXT,7 91750-1X188 REV.2013 791029 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18188 * RELOC: 91750-1X188 * * * ******************************************************************* * * * * RD EXiT is a utility subroutine for the Remote Data Base Access Program * and Monitor. Its function is to build the DS/1000 header for the reply * buffer then call #SLAV to send the reply. * * The calling sequence for RDEXT is: * * JSB RDEXT * DEF *+6 return point * DEF RPBUF reply buffer * DEF RPLEN reply length * DEF DABUF data buffer * DEF DALEN data length * DEF ERROR DS error code (2 words) to put in reply * * * SKP ********************************************************************** *** *** * Standard DS/1000 equates * *** *** *$ * ****************************************************************** * * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * *$ *** *** ********************************************************************** ********************************************************************** * * * DS/1000 RDBA Communications consist of two descriptive buffers: * * 1) Request buffer * * 2) Reply buffer * * The reply buffer we are concerned with is as described below. * * * ********************************************************************** *** *** *  * * Reply buffer - one buffer of either 23 or 24 words per RDBA call * * * *** * RBSTR EQU #STR DS 1000 stream word RBSEQ EQU #SEQ DS/1000 sequence number RBSRC EQU #SRC DS/1000 source node number RBDST EQU #DST DS/1000 destination node number RBEC1 DEF #EC1 DS/1000 1st error code word RBEC2 EQU #EC2 DS/1000 2nd error code word RBEC3 EQU #ENO DS/1000 error node number upon an error RBSTA EQU #REQ RDBA call status array RBNUM EQU #REQ+10 RDBA data base number for DBOPN *** *** ********************************************************************** * * DS reply buffer which is in #SLAV * *********************************************************************** REBUF DEF #RPB+0 ENT RDEXT EXT #NODE,.ENTR,#SLAV,.MVW,#RPB * A EQU 0 B EQU 1 * RPBUF NOP RPLEN NOP DABUF NOP DALEN NOP ERROR NOP * * Get true parameter and return point addresses. * RDEXT NOP JSB .ENTR DEF RPBUF * * Bump B register to the error code words of the reply and * put the 2 words passed to us in ERROR into the first two words of the * ECOD space in the reply buffer. * LDB RPBUF ADB RBEC1 LDA ERROR,I STA B,I INB LDA ERROR INA LDA A,I STA B,I * * If there was an error, the A register is now non-zero. Set the node * number in the 3rd error code word * and if the error code is ASCII, i.e. first word of ERROR is non-zero, * we need to set bit 15 of the 3rd error word also. * INB SZA,RSS JMP EXT1 No error - set ECOD3 to zero. * LDA ERROR SZA LDA BIT15 IOR #NODE EXT1 STA B,I * * Call #SLAV to send the reply. * * [* Move the request buffer into #SLAV's request buffer * LDA RPBUF LDB REBUF JSB .MVW DEF RPLEN,I NOP * * JSB #SLAV DEF *+4 DEF RPLEN,I DEF DABUF,I DEF DALEN,I RSS Error return, skip bump of return point. * ISZ RDEXT JMP RDEXT,I * * Constants and variables. * BIT15 OCT 100000 END RDEXT #E { 91750-18189 2013 S C0122 &RMCLN &RMCLN             H0101 ASMB HED RMCLN SUBROUTINE FOR RECOV NAM RMCLN,7 91750-1X189 REV.2013 791029 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18189 * RELOC: 91750-1X189 * * * ******************************************************************* * * * * DS/1000 AND RDBA STANDARD EQUATES FOR REQUEST BUFFER. * * ****************************************************************** * * * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * RBIDX EQU #REQ RDBA INDEX RBMOD DEF RBIDX+1+#RQB RDBA MODE RBNOD EQU RBIDX+4 RDBA NODE NUMBER FOR CLEAN UP * * * RQLEN DEF 23 REQUEST LENGTH BUFFER SIZE * * *** * A EQU 0 B EQU 1 * h  ENT RMCLN EXT #NODE,.ENTR,.MVW,#MAST,#RQB * PNAME NOP PNODE NOP ERROR NOP * RMCLN NOP JSB .ENTR DEF PNAME * LDA D10 SET UP REQUEST BUFFER: STA #RQB+#STR STREAM = 10 LDA #NODE STA #RQB+#DST DESTINATION NODE = LOCAL NODE * CCA STA #RQB+RBIDX RDBA INDEX = -1 LDB RBMOD MODE AND INFO WORDS = THE NAME LDA PNAME OF THE MASTER PROGRAM TO JSB .MVW CLEAN-UP AFTER AND ITS NODE DEF D3 NUMBER DEC 0 LDA PNODE,I STA #RQB+RBNOD * JSB #MAST ASK #MAST TO ROUTE THE REQUEST DEF *+8 TO RDBAM FOR US. DEF CONWD DEF RQLEN DEF D0 THERE IS NO DATA WITH EITHER DEF D0 THE REQUEST OR REPLY. DEF D0 DEF RQLEN DEF D0 * CCA,RSS ERROR RETURN LDA #RQB+#EC2 NORMAL RETURN STA ERROR,I JMP RMCLN,I * D0 DEC 0 D3 DEC 3 D10 DEC 10 * CONWD OCT 140000 * END 7x  | 91750-18190 2013 S C0122 &D3KMB              H0101 czASMB,L NAM D3KMB,0 91750-1X190 REV.2013 791129 MEF: 3K LINK, 4096 BFRS * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * END ӎ } 91750-18191 2013 S C0122 &D$3B2              H0101 JRASMB,Q NAM D$3BF,7 91750-1X191 REV.2013 800201 MEF: 4096 3K BUF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$3BF,D$RQB SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$3BF *SOURCE: 91750-18191 * RELOC: 91750-1X191 * PGMR: DMT LST ************************** D$3BF ************************* * * * SOURCE: 91750-18191 * * * * BINARY: 91750-1X191 (PART OF $D3KMB) * * * * PROGRAMMER: DAVE TRIBBY * * * * NOVEMBER 29, 1979 * * * ***************************************************************** SPC 2 * BUFFER FOR DS/1000-DS/3000 MASTER REQUEST SUBROUTINE D3KMS. * * DIFFERENT SIZE DATA BUFFERS MAY BE CREATED BY CHANGING "L" AND * RE-ASSEMBLING. SPC 1 L EQU 4096 MAXIMUM LINE BUFFER SIZE SPC 1 D$RQB DEF D$3BF D$3BF BSS L D3KMS BUFFER END O ~ 91750-18192 2013 S C0122 &D$CO2              H0101 XbASMB,Q NAM D$CON,7 91750-1X192 REV.2013 800201 MEF: 4096 3K BUF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$MAX,D$MXR SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$CON *SOURCE: 91750-18192 * RELOC: 91750-1X192 * PGMR: DMT LST ************************** D$CON ************************* * * * SOURCE: 91750-18192 * * * * BINARY: 91750-1X192 (PART OF $D3KMB) * * * * PROGRAMMER: DAVE TRIBBY * * * * NOVEMBER 29, 1979 * * * ***************************************************************** SPC 2 * CONSTANTS FOR DS/1000-DS/3000 COMMUNICATION. * * THESE CONSTANTS CHANGE FOR DIFFERENT BUFFER SIZES. NEW SIZES * CAN BE CREATED BY CHANGING "L" AND "DBL", THEN RE-ASSEMBLING. SPC 1 DBL EQU 4096 MAXIMUM TOTAL DATA SIZE L EQU 4096 MAX WORDS/BLOCK (DATA+HEADER) * D$MAX ABS DBL D$MXR ABS L END *    91750-18193 2013 S C0122 &D$QB2              H0101 LpASMB,Q NAM D$QBF,7 91750-1X193 REV.2013 800201 MEF: 4096 3K BUF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$WAD,D$RAD,D$WLN SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$QBF *SOURCE: 91750-18193 * RELOC: 91750-1X193 * PGMR: DMT LST ************************** D$QBF ************************* * * * SOURCE: 91750-18193 * * * * BINARY: 91750-1X193 (PART OF $D3KMB) * * * * PROGRAMMER: DAVE TRIBBY * * * * NOVEMBER 19, 1979 * * * ***************************************************************** SPC 2 * BUFFER FOR DS/1000-DS/3000 COMMUNICATIONS PROGRAM QUEX. * * DIFFERENT SIZE DATA BUFFERS MAY BE CREATED BY CHANGING "L" AND * RE-ASSEMBLING. SPC 1 L EQU 4096 MAXIMUM LINE BUFFER SIZE * * D$WAD DEF D$WBF ADDRESS OF WRITE BUFFER D$RAD DEF D$RBF ADDRESS OF READ BUFFER * *** DO NOT CHANGE ORDER OF NEXT THREE LINES ****** D$WLN NOP LENGTH OF WRITE BUFR (-BYTES). D$WBF BSS L WRITE BUFFER. D$RBF BSS L READ BUFFER. * END .    91750-18194 2013 S C0122 &D$TS2              H0101 ^sASMB,Q NAM D$TST,7 91750-1X194 REV.2013 800201 MEF: 4096 3K BUF SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT D$TST SPC 2 UNL NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING * NAME: D$TST *SOURCE: 91750-18194 * RELOC: 91750-1X194 * PGMR: DMT LST ************************** D$TST ************************* * * * SOURCE: 91750-18194 * * * * BINARY: 91750-1X194 (PART OF $D3KMB) * * * * PROGRAMMER: DAVE TRIBBY * * * * NOVEMBER 29, 1979 * * * ***************************************************************** SPC 2 * BUFFER FOR DS/1000-DS/3000 SLAVE REQUEST AND REPLY CONVERTERS. * * DIFFERENT SIZE DATA BUFFERS MAY BE CREATED BY CHANGING "DBL" AND * RE-ASSEMBLING. SPC 1 DBL EQU 4096 TOTAL DATA SIZE SPC 1 D$TST BSS 14+DBL+25 RQCNV/RPCNV LOCAL TST + ROOM FOR DATA END   91750-18199 2013 S C0122 &#RR7 +              H0101 uIASMB,R,Q,C HED <#RR7> REROUTING INIT. ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #RR7,30 91750-1X199 REV 2013 800207 ALL W/ RR SPC 1 EXT $OPSY,#LVSC,#LCNT ENT #RR7 * * NAME: #RR7 * SOURCE: 91750-18199 * RELOC: 91750-1X199 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * * * #RR7 CALLING SEQUENCE: * * * < A REG. = LU > * JSB #RR7 FIND NEIGHBOR NODE FOR THIS LINK * < RETURN 1, NOT FOUND, A REG. = LU > * < RETURN 2, FOUND, A REG. = NEIGHBOR NODE # > * #RR7 NOP STA LU SET UP LU WORDS NOP JSB CONFG LDA #LCNT RR ENABLE? SZA,RSS JMP NOTFD .NO LDA LU JSB #LVSC FIND SAM ADDR OF LU JMP NOTFD NOT IN LV ADB =D5 ADD OFFSET TO GET NEIGHBROR # JSB LDWD LOAD IT SSA JMP NOTFD ISZ #RR7 ADJUST RETURN ADDR JMP #RR7,I RETURN NOTFD EQU * LDA LU NOT FOUND, LOAD LU JMP #RR7,I SKP * * CONFIGURE THE SYSTEM ENVIRONMENMT * CONFG NOP CLB STB NOP LDA $OPSY RAR,SLA STB LDMOD JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** SKP * * DATA AREA * LU NOP END     91750-18200 2013 S C0122 &#ICV0              H0101 6ASMB,R,Q,C HED #ICV0 91750-1X200 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #ICV0,7 91750-1X200 REV.2013 800326 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT #ICV0 * ************************ * NAME: #ICV0 * * * SOURCE: 91750-18200 * THIS MODULE KNOWS * * RELOC: PART OF 91750-12002 * ONLY ABOUT LEVEL 0 * * PGMR: JIM HARTSELL * MESSAGE FORMATS * * * * * ************************ * * * SUBROUTINE TO PERFORM REQUEST-SPECIFIC CONVERSION FOR "INCNV". * * <<<<< CALLED BEFORE CONVERSION FROM LEVEL 0 TO LEVEL 1 >>>>> * * <<<<< A-REGISTER = ADDRESS OF LEVEL 0 REQUEST >>>>> * <<<<< B-REGISTER = LENGTH OF LEVEL 0 REQUEST >>>>> * SPC 5 SUP B EQU 1 * #ICV0 NOP ENTRY. STA RQADR SAVE ADDRESS OF REQUEST. STB RQLEN SAVE LENGTH OF REQUEST. * LDA RQADR,I GET STREAM WORD. AND B77 CPA B3 CHECK STREAM TYPE. RSS CPA B5 RSS JMP EXIT NOT DEXEC: NO CONVERSION. * LDA RQADR,I DEXEC: RAL IF THIS IS A SSA,RSS REQUEST, GO DO JMP REQ CONVERSION. * CLA REPLY FROM LEVEL 0 NODE: LDB RQADR ADD A ZERO WORD ADB RQLEN ("$OPSY") TO THE STA B,I END OF THE BUFFER. JMP BUMP GO BUMP THE LENGTH. * REQ LDB RQADR GET ICODE PARAM (LEVEL 0). ADB B4 LDA B,I AND B377 CPA D13 IF ICODE IS NOT JMP ADJ0 ADA N4 1,2,3, OR 13, SSA,RSS JMP EXIT NO CONVERSION REQUIRED. * * REFORMAT ICODE 1,2,3,13 REQUESTS TO INCLUDE LEVEL 1 #CWX = 0. * ADJ0 ADB B3 POINT TO WORD 7 (OLD #PM1, NEW #BFL). STB TEMP INB POINT TO WORD 8 (OLD #PM2, NEW #PM1). STB TEMP1 * DLD TEMP,I MOVE THE OPTIONAL PARAMS TO DST TEMP1,I THEIR PROPER LOCATIONS (+1). LDB TEMP ADB N1 STB TEMP LDB TEMP,I GET LENGTH OR CONTROL PARAM, CLA CLEAR LU EXTENSION FOR NOW, DST TEMP,I AND SET INTO PROPER PLACE. * LDB TEMP POINT TO ICODE PARAM. ADB N2 LDA B,I SET "DLUEX" BIT IN ICODE (BIT 12). IOR DLUFL STA B,I INB POINT TO LU WORD. LDA B,I STA TEMP1 SAVE FOR FCN PART. AND B77 KEEP LU PORTION, IOR BIT15 AND SET "NO SST MAPPING" BIT. STA B,I STORE AS 1ST WORD. LDA TEMP1 SET UP FUNCTION CODE WORD AND FCMSK (LU EXTENSION). STA TEMP,I STORE AS 2ND WORD. * BUMP ISZ RQLEN BUMP REQUEST BUFFER LENGTH BY 1. * EXIT ISZ #ICV0 SET FOR NORMAL RETURN. LDB RQLEN RETURN WITH LENGTH OF REQUEST. JMP #ICV0,I * * B3 OCT 3 B4 OCT 4 B5 OCT 5 B77 OCT 77 B377 OCT 377 BIT15 OCT 100000 D13 DEC 13 N1 DEC -1 N2 DEC -2 N4 DEC -4 FCMSK OCT 3700 DLUFL OCT 10000 TEMP NOP TEMP1 NOP RQLEN NOP RQADR NOP * BSS 0 SIZE OF MODULE. * END w   91750-18201 2013 S C0122 &#OCV0              H0101 6ASMB,R,Q,C HED #OCV0 91750-1X201 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #OCV0,7 91750-1X201 REV.2013 800207 ALL SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 ENT #OCV0 * EXT #NODE,.MVW * ************************ * NAME: #OCV0 * * * SOURCE: 91750-18201 * THIS MODULE KNOWS * * RELOC: PART OF 91750-12002 * ONLY ABOUT LEVEL 0 * * PGMR: JIM HARTSELL * MESSAGE FORMATS * * * * * ************************ * * * SUBROUTINE TO PERFORM REQUEST-SPECIFIC CONVERSION FOR "OTCNV". * * <<<<< CALLED AFTER CONVERSION FROM LEVEL 1 TO LEVEL 0 >>>>> * * <<<<< A-REGISTER = ADDRESS OF LEVEL 0 REQUEST >>>>> * <<<<< B-REGISTER = LENGTH OF LEVEL 0 REQUEST >>>>> * SPC 5 SUP B EQU 1 * #OCV0 NOP ENTRY. STA RQADR SAVE ADDRESS OF REQUEST. STB RQLEN SAVE LENGTH OF REQUEST. * LDA RQADR,I GET STREAM WORD. RAL IF THIS IS SSA A REPLY, NO JMP EXIT CONVERSION IS REQUIRED. * RAR AND B77 CPA B3 CHECK STREAM TYPE. RSS CPA B5 RSS JMP EXIT NOT DEXEC: NO CONVERSION. * LDB RQADR DEXEC: GET REQUEST CODE. ADB B4 STB TEMP MAINTAIN POINTER TO REAL ONE. LDA B,I AND B377 STA ICODE SAVE MASKEgD ONE FOR COMPARE. * LDA TEMP,I IF REQUEST CODE AND NOT11 LDB ICODE IS 9 OR 23, CPB D9 RSS REMOVE "CLONE OK" BIT (11) CPB D23 STA TEMP,I FOR LEVEL 0 NODE. * CPB D11 CHECK IF REQ CODE = 1,2,3,11,13. JMP ADJ0 CPB D13 JMP ADJ0 ADB N4 SSB,RSS JMP EXIT NONE OF THE ABOVE. EXIT NOW. * ADJ0 LDA TEMP,I GET REAL REQUEST CODE. ALF DLUEX CALL TO LEVEL 0 NODE? SLA,RSS (BIT 12 SET?) JMP ADJ1 NO. * LDA RQADR,I YES. ERROR. IOR BIT14 SET REPLY BIT. STA RQADR,I DLD "IO01 SET ERROR TO "IO01". DST TEMP,I (TEMP POINTS TO REPLY ERROR WORDS.) LDA #NODE SET ERROR NODE NUMBER IOR BIT15 AND "ASCII ERROR" BIT. LDB TEMP ADB B2 STA B,I JMP ERTN TAKE ERROR EXIT. * ADJ1 CCA PRIME FOR ICODE 1,2,3. LDB ICODE IF ICODE IS 11 OR 13, CPB D11 ADD 3 TO LENGTH JMP *+2 FOR PLACEHOLDERS. CPB D13 IF ICODE IS 1,2, OR 3, LDA B3 DECREMENT LENGTH BY 1 TO ADA RQLEN COMPENSATE FOR 1-WORD CONWD. STA RQLEN CPB D11 IF TIME REQ, WE'RE DONE. JMP EXIT * LDB TEMP FOR ICODE 1,2,3,13 MOVE ADB B2 EVERYTHING BELOW #CNW LDA B UP 1 WORD. INA JSB .MVW DEF B3 NOP * EXIT ISZ #OCV0 SET FOR NORMAL RETURN. ERTN LDB RQLEN RETURN WITH LENGTH OF REQUEST. JMP #OCV0,I * * B2 OCT 2 B3 OCT 3 B4 OCT 4 B5 OCT 5 B77 OCT 77 B377 OCT 377 BIT14 OCT 040000 BIT15 OCT 100000 NOT11 OCT 173777 D9 DEC 9 D11 DEC 11 D13 DEC 13 D23 DEC 23 N4 DEC -4 "IO01 ASC 2,IO01 TEMP NOP ICODE NOP RQLEN NOP RQADR NOP * BSS 0 SIZE OF MODULE. * END    91750-18202 2013 S C0122 &SYSAT +              H0101 ASMB,Q,C NAM SYSAT,19,45 91750-16202 REV.2013 800814 ALL SUP * * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: SYSAT * SOURCE: 91750-18202 * RELOC: 91750-16202 * PGMR: JOHN LAMPING * * * WRITTEN BY LYLE WEIMAN [OCTOBER 1979] * MODIFIED BY JOHN LAMPING [NOVEMBER 1979] * " " LYLE WEIMAN [JULY 1980] * * THIS PROGRAM MAY BE USED TO SEND A "BREAK" TO A REMOTE PROGRAM, * E.G., ONE WHICH IS PRINTING VIA LU MAPPING, AND YOU NEED TO * TERMINATE THE PRINTOUT PREMATURELY WITHOUT ABORTING IT, * OR TO OBTAIN THE REMOTE SYSTEM'S ATTENTION. * * USE (RTE-4B, RTE-L) : * - - - - * / \ * / \ * / \ * *RU,SYSAT, , * \ / * \ / * \ / * * * USE (RTE-M3) : * - - - - * / \ * / \ * / \ * *RU,SYSAT, , * \ / * \ / * \ / * PR,GN,AM * * NOTE THAT, IN RTE-M3, THE PROGRAM NAME MUST BE DIVIDED INTO * THREE GROUPS OF TWO CHARACTERS, SEPARATED BY COMMAS. * * * IF PROGRAM NAME SUPPLIED, A "BR," COMMAND IS * SENT TO THE REMOTE NODE SPECIFIED, VIA A CALL TO DMESS (THIS * REQUIRES THAT THE REMOPTE OPERATOR COMMAND MODULE--OPERM--EXIST AND IS * ENABLED AT THE REMOTE). * * IF NO PROGRAM IS NAMED, SYSTEM ATTENTION IS REQUESTED VIA * A CALL TO DMESS TO "RU,IOMAP". AGAIN, THIS IMPLIES THAT THE * REMOTE COMMAND PROCESSOR--OPERM--EXIST, AND ALSO THAT IOMAP * EXISTS AT THE REMOTE. * * SEQUENCE OF OPERATIONS: * * 1. #PKUP IS CALLED TO RETRIEVE PARAMETERS. IN RTE-M, PROGRAM * NAME IS BROKEN UP INTO 3 GROUPS OF TWO CHARACTERS, SEPARATED * BY COMMAS. * 2. LOGLU IS CALLED TO RETURN THE OPERATOR'S TERMINAL LU # * (NOT SAME AS 1ST PARAM, SO DON'T TRUST #PKUP'S RETURN). * 3. CHECK INPUT. IF NO NODE # SPECIFIED, GOTO "EXIT". * 4. CHECK 1ST PARAMETER: IF ASCII, GOTO STEP 9 * 5. CONVERT VALUE OF 2ND PARAMETER TO ASCII, STORED IN XXXXXX FIELD * OF MESSAGE: * RU,IOMAP, XXXXXX,-32768,25834 * 6. SEND MESSAGE TO REMOTE NODE #. * 7. CHECK FOR ERROR: IF SO, CALL DSERR & PRINT DETAILS OF ERROR. * IF NO DS ERROR REPORTED, PRINT "MESSAGE DELIVERED". * CHECK FOR RETURNED MESSAGE: IF SO, PRINT THAT. * GO TO "EXIT". * 8. (EXIT): TERMINATE PROGRAM * 9. MOVE NAMED PROGRAM INTO XXXXXX FIELD OF MESSAGE: * BR,XXXXXX * AND SEND MESSAGE TO REMOTE NODE. * GO TO STEP 7 SPC 2 EXT LOGLU,#PKUP,DMESS,EXEC,DSERR EXT CNUMD,.MVW,.OPSY SPC 2 SYSAT EQU * JSB #PKUP RECOVER PARAMETERS DEF *+4 DEF MASK DEF PBUFR RETURNED INFO ARRAY DEF LUTTY * * NOTE! #PKUP MAY HAVE RETURNED THE WRONG LU, SINCE IT * EXPECTS THE FIRST PARAMETER TO BE THE LU #. SO WE'LL CALL * 'LOGLU' OURSELVES, TO BE CERTAIN. * * JSB LOGLU DETERMINE WHAT LU TO USE FOR PRINTOUT DEF *+2 DEF LUTTY DUMMY STORAGE STA LUTTY SAVE LU # * * IF THIS IS RTE-M3, AND THE USER HAS SELECTED THE * "BR, PROGR" FORMAT, WE'LL HAVE TO MOVE THE PAR AMETERS * AROUND A LITTLE BIT. * JSB .OPSY CHECK OPERATING SYSTEM TYPE CPA RTEM3 RTE-M3? RSS YES, WE HAVE MORE THINGS TO CHECK.... JMP S1 NO, #PKUP HAS GIVEN US THE RIGHT DATA FORMAT LDA PBUFR+3 IS #PKUP BEING TOO CPA B27 NICE TO US? RSS YES,.... JMP S1 NO, CONTINUE LDA PBUFR+4 #PKUP HAS PUT THE NODE NUMBER IN THE SECURITY STA RNODE CODE PART OF THE CLA,INA AND PRETEND WE REALLY DID GET STA RNODE+3 A NODE NUMBER * S1 EQU * LDA PBUFR+3 WAS A PROGRAM AND D3 CHECK ONLY 1ST PARAMETER TYPE FIELD CPA D3 NAME GIVEN? JMP BRPRG YES, ISSUE "BR,PROGRAM NAME" * * GET SYSTEM ATTENTION * LDA @SYMS LDB @BUFR MOVE MESSAGE TO BUFFER JSB .MVW DEF D15 NOP JSB CNUMD CONVERT LU # (IF ANY) DEF *+3 DEF PBUFR DEF BUFFR+5 * LDA SYML LOAD MESSAGE SIZE, IN BYTES * DMES. EQU * HERE TO ISSUE DMESS CALL STA MSLEN SAVE MESSAGE SIZE, IN BYTES LDA RNODE+3 CHECK RETURN: CPA D1 WAS AN NODE # RETURNED? RSS YES, CONTINUE JMP EXIT NO NODE # PASSED * JSB DMESS NOW SEND MESSAGE TO REMOTE DEF *+4 DEF RNODE DESTINATION NODE # @BUFR DEF BUFFR MESSAGE BUFFER DEF MSLEN MESSAGE LENGTH, IN BYTES * STA PBUFR SAVE REPLY LENGTH SSB ERROR? JMP ERPRT YES, GET DETAILS * JSB PRNT DEF SUCMG "MESSAGE DELIVERED" DEF SUCML * LDA PBUFR GET REPLY LENGTH SZA,RSS ANY RETURN MESSAGE? JMP EXIT NO, SIMPLY EXIT * * A MESSAGE HAS BEEN RETURNED. PRINT IT FOR USER. * JSB PRNT DEF BUFFR DEF PBUFR * * HERE TO TERMINATE * EXIT EQU * JSB EXEC X4 DEF *+2 DEF D6 SPC 2 * HERE TO GET DETAILS ABOUT AN ERROR * ERPRT EQU * JSB DSERR DEF *+2 DEF BUFFR * JSB PRNT PRINT THE ERROR DEF BUFFR DEF D24 BUFFER LENGTH JMP EXIT SPC 2 * HERE TO ISSUE "BR,PROGRAM NAME" * BRPRG EQU * LDA @BR LDB @BUFR JSB .MVW MOVE MESSAGE DEF D5 NOP * LDA D10 LOAD SIZE OF MESSAGE JMP DMES. AND CALL DMESS SPC 1 * SUBROUTINE TO PRINT MESSAGES * * CALLING SEQUENCE: * JSB PRNT * DEF * DEF * PRNT NOP DLD PRNT,I DST PRN1 ISZ PRNT BUMP RETURN ISZ PRNT ADDRESS JSB EXEC AND PRINT MESSAGE DEF *+5 DEF D2 DEF LUTTY PRN1 NOP MESSAGE ADDRESS NOP ADDRESS OF LENGTH JMP PRNT,I RETURN TO CALLER SPC 2 * DATA AREA * M5 DEC -5 RTEM3 EQU M5 $OPSY CODE FOR RTE-M3 D1 DEC 1 D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D15 DEC 15 D10 DEC 10 B27 OCT 27 D24 DEC 24 * * DEFINE #PKUP MASK MASK BYT 2,3 2 PARAMS: BOTH RET'D IN FORMAT * LUTTY NOP STORAGE FOR TERMINAL LU MSLEN NOP @SYMS DEF SYMS SYMS ASC 15,RU,IOMAP, XXXXXX,-32768,25834 SY.. EQU *-SYMS SYML ABS SY..+SY.. SYZE OF MESSAGE, IN BYTES * SUCMG ASC 9,MESSAGE DELIVERED SUCML ABS *-SUCMG * * NOTE: DO NOT DISTURB ORDER OF THE FOLLOWING: @BR DEF BRMS BRMS ASC 2,BR, * PBUFR BSS 10 PARSE BUFFER RNODE BSS 10 REMOTE NODE NUMBER * * * END OF FIXED-ORDERING * BUFFR BSS 24 MESSAGE BUFFER END SYSAT   91750-18203 2013 S C0122 &#DISM              H0101 ~YASMB,R,Q,C,Z IFZ HED #DISM 91750-1X203 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #DISM,7 91750-1X203 REV.2013 800702 RTE-IVB W/S.M. XIF IFN HED #DISM 91750-1X204 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #DISM,7 91750-1X204 REV.2013 800702 ALL, W/O S.M. XIF * * "Z" OPTION FOR SESSION MONITOR NODE, "N" OPTION FOR NON-SESSION NODE. SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 ENT #DISM EXT EXEC,#PRNT,#INBF,REIO,$DSCS,#POOL EXT #DFUN,#PASS,$OPSY,$LIBR,$LIBX,.DRCT IFZ EXT .UACT,.MVW,XLUEX,CNUMD,#READ,#PRNL,#EXFR,#CLSB EXT #RSM.,#RSM,#MSKD,#ABRT,LUSES,#BREJ,#NODE,#MHCT EXT PGMAD,SESSN,ISMVE,DTACH,ATACH,$SMII XIF * * NAME: #DISM * SOURCE: 91750-18203 * RELOC: PART OF 91750-12014 ("Z"), -12015 ("N") * PGMR: JIM HARTSELL * * SUBROUTINES TO PERFORM OPTIONAL REMOTE SESSION INITIALIZATION FOR * THE DS/1000 DINIT PROGRAM. CALLING SEQUENCES: * * FOR SHUTDOWN, LOG OFF ALL REMOTELY OWNED SESSIONS: * * CCA * JSB #DISM * * FIND AMOUNT OF SAM REQUIRED FOR REMOTE SESSION: * * CLA * JSB #DISM * (A) = # SAM WORDS NEEDED. * * BUILD SESSION ID POOL, GET DEFAULT ACCOUNT NAME & NON-SESSION PASSWORD: * * CLA,INA * JSB #DISM * * PERFORM ABORT FUNCTIONS FOR REMOTE SESSION: * * LDA B2 * JSB #DISM SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O fC K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SKP * OPBLK-START * ****************************************************************** * * * O P R E Q B L O C K REV 2013 791119 * * * * OFFSETS INTO DS/1000 OPREQ MESSAGE BUFFERS, USED BY: * * * * DMESS, OPERM, RQCNV, RPCNV * * RSM, DLGON, #MSSM, #UPSM * ****************************************************************** * * OFFSETS INTO OPREQ REQUEST AND REPLY BUFFERS. * #CML EQU #REQ COMMAND LENGTH. #CMS EQU #CML+1 COMMAND STRING. #LGC EQU #CMS+1 LOGON REQUEST CODE #LNL EQU #LGC+1 LENGTH OF USER NAME #LUN EQU #LNL+1 LOGON USER NAME * #RLN EQU #REP REPLY LENGTH. #MSG EQU #RLN+1 REPLY MESSAGE. * * MAXIMUM SIZE OF OPREQ REQUEST/REPLY BUFFER. * #OLW EQU #CMS+23 M A X I M U M S I Z E ! ! ! * * OPBLK-END SKP SUP PRINT EQU #PRNT INBUF EQU #INBF IFZ READ EQU #READ PRNTL EQU #PRNL ERXFR EQU #EXFR CLSUB EQU #CLSB MSKED EQU #MSKD ABORT EQU #ABRT XIF A EQU 0 B EQU 1 * * INITIALIZE. * #DISM NOP ENTRY. STA FCODE SAVE FUNCTION CODE. * JSB .DRCT RESOLVE INDIRECT EXTERNAL REFS. DEF INBUF STA DINBF JSB .DRCT DEF #DFUN STA DFUN JSB .DRCT DEF #PASS STA PASS * * CHECK #DISM FUNCTION REQUESTED. * LDA FCODE IFZ CPA N1 JMP SHUTD XIF SZA,RSS JMP AMNT CPA B1 JMP FILL CPA B2 JMP KILL CLA JMP #DISM,I SKP IFZ * * LOG OFF ALL SESSIONS CREATED FROM REMOTE NODES. USE THE SPECIAL * NO-REPLY LOG-OFF REQUEST (SIMILAR ROUTINE IN #MSSM & #UPSM, BUT * #DISM'S VERSION IS BUILT FROM #POOL ENTRY INFO). RSM IS HIGHER * PRIORITY THAN DINIT, TWHUS SESSIONS WILL GET RELEASED BEFORE DINIT * ABORTS RSM. THERE IS NO NEED TO CLEAR #POOL ENTRIES SINCE DINIT * WILL BE RELEASING THE S.A.M. AREA. * SHUTD LDA #RSM IS RSM STILL AROUND? SZA,RSS JMP #DISM,I NO. DON'T EVEN BOTHER. * LDB #POOL GET ADDRESS OF SID POOL. SZB,RSS DO WE HAVE ONE? JMP #DISM,I NO. DON'T BOTHER. JSB LODWD GET # POOL ENTRIES (NEGATIVE). STA CNTR INB POINT TO FIRST #POOL ENTRY. LOOP1 JSB LODWD (CROSS) LOAD WORD 1 OF POOL ENTRY. SSA,RSS IS ENTRY ACTIVE (CHECK BIT 15)? JMP NEXT1 NO. GO TO NEXT ENTRY. * STB POOLA YES. SAVE ADDRESS OF POOL ENTRY. AND B377 ISOLATE "IN-USE" SESSION ID. STA TEMP * JSB LUSES IS THE SESSION FOR THIS DEF *+2 #POOL ENTRY STILL AROUND? DEF TEMP * SZA,RSS JMP RSTOR NO. GO TO NEXT ENTRY. * LDB POOLA CLA RESET CERTAIN SLOTS. STA LGF+#SEQ STA LGF+#MAR STA LGF+#MAC LDA B7 BUILD STREAM WORD. IOR #BREJ IOR BIT12 SET "LEVEL 1 & ABOVE" BIT. STA LGF+#STR INB POINT TO 2ND WORD OF #POOL ENTRY. JSB LODWD (CROSS) LOAD SOURCE NODE NUMBER. SZA,RSS JMP RSTOR IF NONE, SKIP IT. STA LGF+#SRC STORE IN LOG-OFF REQUEST. LDA #NODE STA LGF+#DST STORE DEST NODE # IN REQUEST. CLA,INA STA LGF+#LVL STORE UPGRADE LEVEL # IN REQUEST. LDA N2 STA LGF+#MAS SET TO BYPASS MESSAGE ACCOUNTING. LDA #MHCT STA LGF+#HCT SET HOP COUNT. INB POINT TO 3RD WORD OF #POOL ENTRY. JSB LODWD (CROSS) LOAD SOURCE SESSION ID. AND B377 ALF,ALF STA LGF+#SID (DEST SID ZERO.) LDA TEMP STA LGF+#LNL STORE SESSION ID TO BE LOGGED OFF. * LDA B2 STORE COMMAND LENGTH. STA LGF+#CML LDA "XX" STORE "XX"O COMMAND. STA LGF+#CMS CCA STORE "NO-REPLY" REQ CODE. STA LGF+#LGC * JSB EXEC DO CLASS WRITE/READ TO RSM. DEF *+8 DEF CLS20 NO ABORT. DEF CONWX DEF TEMP NO DATA. DEF B0 DEF LGF REQUEST BUFFER. DEF L#LNL REQUEST LENGTH. DEF #RSM I/O CLASS. NOP IGNORE ERROR. * RSTOR LDB POOLA RESTORE B-REGISTER. NEXT1 ADB POOSZ ADVANCE TO NEXT #POOL ENTRY. ISZ CNTR LOOP TILL DONE. JMP LOOP1 * JMP #DISM,I RETURN TO CALLER (DSMOD). SPC 5 * * SUBROUTINE TO LOAD A WORD FROM S.A.M., CROSS LOAD IF DMS SYSTEM. * LODWD NOP LDA $OPSY OP SYSTEM TYPE. RAR,SLA JMP *+3 LDA B,I NON-DMS. JMP LODWD,I XLA B,I DMS. JMP LODWD,I XIF SKP * * FIND AMOUNT OF S.A.M. NEEDED FOR REMOTE SESSION. * AMNT LDA B7 INITIALIZE DEFAULT NUMBER OF STA NPOOL CONCURRENT SESSIONS = 7. * LDA $DSCS IF NO SESSION MONITOR, OR S.M. NOT SSA INITIALIZED AT THIS NODE, JMP DSMD1 USE DEFAULT. IFN JSB PRNTW ISSUE WARNING IF NON-SESSION DEF WARN1 MODULE WAS LOADED IN JSB PRNTW A SESSION MONITOR NODE! DEF WARN2 JMP DSMD1 CONTINUE AS IF NON-SESSION NODE. XIF * IFZ JSB PRINT ASK USER TO SPECIFY DEF SMSG1 "MAX # LOCAL SESSIONS FOR REMOTE..." DSMR1 LDA B7 SET DEFAULT VALUE. STA NPOOL JSB READ READ RESPONSE. CPA B1 RESULT NUMERIC? JMP DSMV1 YES--PROCESS IT. CPB /D DEFAULT WANTED? JMP DSMD1 YES--USE DEFAULT. DSME1 JSB ERXFR IMPROPER REPLY: DEF IVRES INFORM USER OF ERROR JMP DSMR1 AND TRY AGAIN. DSMV1 STB NPOOL SAVE # POOL ENTRIES. SSB,RSS IF NEGATIVE - ERROR. CMB,ZINB,SZB,RSS NEGATE NUMBER & CHECK FOR ZERO. JMP DSME1 REPORT ERROR. ADB D253 ADD MAXIMUM NUMBER ALLOWED (253). SSB BEYOND RANGE? JMP DSME1 YES--REPORT ERROR. XIF DSMD1 LDA NPOOL GET # POOL ENTRIES. MPY POOSZ MULTIPLY BY SIZE OF POOL ENTRY. INA ADD COUNT WORD. STA BLKSZ SAVE SAM SIZE NEEDED. JMP #DISM,I RETURN AMOUNT OF SAM REQUIRED. SKP * * BUILD SESSION ID POOL: FIND AS MANY UNDEFINED LOGICAL UNIT NUMBERS * AS "MAX # CONCURRENT SESSIONS" ENTERED PREVIOUSLY. * FILL LDB $OPSY RBR,SLB SKIP IF NON-DMS. CLA,RSS JMP FILL1 STA MOD1 MODIFY FOR DMS. STA CLR1 * FILL1 LDA #POOL CLEAR POOL AREA IN S.A.M. INA STA ADDR START OF POOL AREA PAST COUNT WORD. LDB BLKSZ ADB N1 CMB,INB NEG. # WORDS (LESS COUNT WORD). JSB $LIBR GO PRIVILEGED. NOP CLA CLR1 JMP CLR2 NOP IF DMS. XSA ADDR,I STORE IN ALTERNATE MAP. RSS CLR2 STA ADDR,I ISZ ADDR INB,SZB JMP CLR1 JSB $LIBX GO UN-PRIVILEGED. DEF *+1 DEF *+1 * LDA $DSCS IF NO SESSION MONITOR, OR NOT SSA,RSS INITIALIZED AT THIS NODE, JMP SETAD XLIBX LDA NPOOL JUST SET CMA,INA COUNT WORD LDB #POOL FOR S.I.D. JSB STUFF POOL JMP #DISM,I AND RETURN. * SETAD EQU * IFN JMP XLIBX NON-SM LIBR IN SESSION NODE! XIF * IFZ CLA STA SID STA BUFR * JSB PGMAD GET DINIT'S ID SEGMENT ADDRESS. DEF *+3 DEF BUFR DEF TEMP * JSB SESSN IS DINIT RUNNING UNDER A SESSION? DEF *+2 DEF TEMP (ID SEG ADDR) * SEZ JMP POOL1 NO. * STB TEMP YES. SAVE POINTER TO SCB. * JSB ISMVE GET LOCAL SESSION ID FROM SCB. DEF *+5 DEF TEMP SESSION WORD FROM ID SEG. DEF $SMII POINT TO SESSION IDENTIFIER. DEF SID (RETURNED) SESSION ID. DEF B1 GET 1 WORD. * JSB DTACH DETACH TEMPORARILY FROM THE SESSION DEF *+1 SO THAT WE CAN LOOK AT ALL LUS. * POOL1 LDA #POOL SET ADDR OF 1ST POOL ENTRY. INA STA ADDR LDA NPOOL SET COUNTER FOR MAX # CMA,INA SESSION ID POOL ENTRIES. STA CNTR CLA INITIALIZE ACTUAL COUNT STA POOL# OF # POOL ENTRIES. LDA D253 SET 1ST SESSION ID CANDIDATE STA SLU AT HIGH END OF LOGICAL UNITS. * LOOP JSB XLUEX GET STATUS OF NEXT LU. DEF *+4 DEF ICD13 DEF SLU DEF TEMP JMP AVAIL ERR RTN: UNDEFINED LU NUMBER? * NEXT LDA SLU IN USE: DECR TO NEXT LOWER LU. ADA N1 STA SLU ISZ CNTR BUMP LOOP COUNTER, JMP LOOP AND LOOP TILL DONE. JMP CHECK DONE: GO SEE IF WE GOT ENOUGH. * AVAIL CPA "IO" MAKE SURE IT IS AN UNDEFINED LU. RSS JMP NEXT NO. GO TRY NEXT LU. CPB "02" RSS CPB "26" RSS JMP NEXT NO. GO TRY NEXT LU. * LDA SLU HAVE UNDEFINED LU NUMBER: LDB ADDR STORE IN 1ST WORD JSB STUFF OF POOL ENTRY. ADB POOSZ STB ADDR ADDR OF NEXT POOL ENTRY. ISZ POOL# INCREMENT # POOL ENTRIES. JMP NEXT GO LOOK FOR ANOTHER LU. * CHECK LDA POOL# GET # POOL ENTRIES ACQUIRED. CPA NPOOL YES. SAME AS # REQUESTED? JMP SPCNT YES. * JSB CNUMD NO. ISSUE WARNING MESSAGE. DEF *+3 DEF POOL# DEF SWARN+19 * JSB PRNTW DEF SWARN * LDA POOL# SZA,RSS GET ANY AT ALL? JMP ABORT NO. ** ABORT DINIT ** * SPCNT CMA,INA NEGATE # POOL ENTRIES AND LDB )#POOL STORE IN POOL COUNT WORD. JSB STUFF * LDA SID WAS DINIT UNDER A SESSION? SZA,RSS JMP ASIGN NO. * JSB ATACH YES. RE-ATTACH TO THE SESSION. DEF *+2 (WE MIGHT BE A CLONE) DEF SID * * ALLOCATE CLASS NUMBER AND SCHEDULE RSM. * ASIGN CCA ASSIGN A JSB CLSUB CLASS NUMBER FOR DEF #RSM. "RSM". * JSB MSKED SCHEDULE RSM. DEF #RSM. SZA CATASTROPHIC ERROR? JMP ABORT YES. ** ABORT DINIT ** SKP * * GET DEFAULT ACCOUNT NAME. * LDB BLANK BLANK OUT #DFUN IN RES. LDA DFUN STB A,I LDB A INB JSB .MVW DEF D10 NOP * LDA B6 SET "USER.GENERAL" LENGTH. STA TEMP ALS STA LEN * JSB PRINT ASK THE USER TO DEF SMSG2 "ENTER DEFAULT SESSION USER-NAME:" DSMR2 JSB READ GET THE RESPONSE. CPA B2 RESULT ASCII? JMP DSMV2 YES--PROCESS IT. DSME2 JSB ERXFR IMPROPER REPLY: DEF IVRES INFORM USER OF ERROR JMP DSMR2 AND TRY AGAIN. DSMV2 LDA US.GN CPB /D IF "/D" WAS INPUT, JMP DSMD2 USE "USER.GENERAL". * LDA PRNTL COMPUTE # WORDS INPUT. STA LEN INA ARS STA TEMP SAVE FOR MOVE. ADA N12 IF GREATER THAN 11, SSA,RSS INFORM USER OF ERROR JMP DSME2 AND TRY AGAIN. * LDA DINBF MOVE USER-NAME TO #DFUN (IN RES). DSMD2 LDB DFUN JSB .MVW DEF TEMP NOP * LDA LEN VERIFY WHETHER VALID NAME. CMA,INA LDB DFUN * JSB .UACT DEF BUFR * SSA JMP DSME2 INVALID USER NAME. SKP * * GET PASSWORD FOR NON-SESSION ACCESS. * LDB BLANK BLANK OUT #PASS IN RES. LDA PASS STB A,I LDB A INB JSB .MVW DEF B4 NOP * JSB PRINT ASK THE USER TO DEF SMSG3 "ENTER PASSWORD FOR NON-SESSION ACCESS:" DSMR3 JSB READ GET THE RESPONSE. CPA B2 ASCII? JMP DSMV3 YES--PROCESS IT. DSME3 JSB ERXFR IMPROPER REPLY: DEF IVRES INFORM USER OF ERROR JMP DSMR3 AND TRY AGAIN. DSMV3 CPB /D IF "/D" WAS INPUT, JMP #DISM,I LEAVE PASSWORD = BLANKS. * LDA PRNTL GET # WORDS INPUT. INA ARS STA TEMP ADA N6 IF GREATER THAN 5, SSA,RSS INFORM USER OF ERROR JMP DSME3 AND TRY AGAIN. * LDA DINBF MOVE PASSWORD TO #PASS (IN RES). LDB PASS JSB .MVW DEF TEMP NOP * JMP #DISM,I RETURN TO DINIT. XIF SPC 3 * * SUBROUTINE TO STORE A WORD IN S.A.M. * STUFF NOP JSB $LIBR GO PRIVILEDGED. NOP MOD1 JMP STUF2 NOP HERE IF DMS. XSA B,I STORE IN ALTERNATE MAP. RSS STUF2 STA B,I JSB $LIBX DEF STUFF SKP * * PERFORM ABORT FUNCTIONS FOR REMOTE SESSION. * KILL CLA CLEAR POINTER TO S.I.D. POOL. STA #POOL * JMP #DISM,I RETURN TO DINIT. SPC 3 * * DISPLAY WARNING MESSAGE ON INTERACTIVE DEVICE AND SYSTEM CONSOLE. * PRNTW NOP LDA PRNTW,I GET ADDRESS OF MSG BUFFER. STA MSLOC * JSB PRINT DISPLAY ON INTERACTIVE DEVICE. MSLOC NOP * DLD MSLOC,I DISPLAY ON SYSTEM CONSOLE. STA ADDR LDB B,I STB CNTR * JSB REIO DEF *+5 DEF B2 DEF B1 DEF ADDR,I DEF CNTR * ISZ PRNTW JMP PRNTW,I RETURN. SKP * * CONSTANTS AND STORAGE. * B1 OCT 1 B2 OCT 2 B6 OCT 6 B7 OCT 7 D18 DEC 18 D20 DEC 20 N1 DEC -1 POOSZ DEC 7 SIZE OF #POOL ENTRY. FCODE NOP BLKSZ NOP NPOOL NOP ADDR NOP LEN NOP CNTR NOP DFUN NOP RESO<:6LVED "DEF INBUF". PASS NOP RESOLVED "DEF #PASS". DINBF NOP RESOLVED "DEF INBUF". * IFZ B0 OCT 0 B4 OCT 4 B377 OCT 377 BIT12 OCT 10000 CLS20 OCT 100024 CONWX OCT 10100 D9 DEC 9 D10 DEC 10 D253 DEC 253 N2 DEC -2 N6 DEC -6 N12 DEC -12 ICD13 OCT 100015 "XX" ASC 1,XX "IO" ASC 1,IO "02" ASC 1,02 "26" ASC 1,26 BLANK ASC 1, /D ASC 1,/D TEMP NOP POOL# NOP SLU OCT 0,0 SID NOP POOLA NOP L#LNL ABS #LNL+1 * US.GN DEF *+1 ASC 6,USER.GENERAL * IVRES DEF *+2 DEF D9 ASC 9, INVALID RESPONSE! * SMSG1 DEF *+2 DEF D20 ASC 20, MAX # LOCAL SESSIONS FOR REMOTE NODES?_ * * SMSG2 DEF *+2 DEF D18 ASC 18, ENTER DEFAULT SESSION USER-NAME: _ * * SMSG3 DEF *+2 DEF D20 ASC 20, ENTER PASSWORD FOR NON-SESSION ACCESS:_ * * SWARN DEF *+2 DEF D20 ASC 20, WARNING - # SESSIONS FOR REMOTE = XXXXX * BUFR BSS 128 LGF EQU BUFR "NO-REPLY" LOGOFF REQ BUFFER. XIF * IFN WARN1 DEF *+2 DEF D18 ASC 18, WARNING - SESSION MONITOR NODE HAS WARN2 DEF *+2 DEF D20 ASC 20, WRONG REMOTE-SESSION LIBRARY! XIF * BSS 0 SIZE OF #DISM. * END r<  91750-18205 2013 S C0122 &RD.TB              H0101 bASMB HED RDBAP COPY SCHEDULING TABLE NAM RD.TB,30 91750-16205 REV.2013 800523 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18205 * RELOC: 91750-16205 * * PRGMR: CEJ * * ******************************************************************* * * * * This subroutine contains the RDBAP copy scheduling table. This table * must reside in SSGA to quarantee the information it contains is correct. * * The table contains enough room for 20 entries where each entry is as- * signed to a specific copy of RDBAP. Each entry is eight words long * and is of the following format: * * word contents * +-----------------------------------------+ * 1-3 | master |-> zero if * | program's | entry is * | name | empty * ------------------------------------------- entry is * 4 | node number of master | empty * ------------------------------------------- * 5-7 | name of | * | RDBAP copy | * | (3 words) | * ------------------------------------------- * 8 | class number for RDBAP copy | * +-----------------------------------------+ * * This table can be expanded by adding 1 to #ENTR for each extra RDBAP * cl  opy desired and adding eight to the REP statement immediately following. * ENT RD.TB * RD.TB DEF *+1 #COPY DEC 0 Number of copies scheduled. #ENTR DEC 20 Number of entries in table. UNL REP 160 RDBAP copy scheduling table. NOP LST BSS 0 END END$ >O   91750-18206 2013 S C0122 &DBHD5 &DBHD5             H0101 ASMB HED HEADER FOR $DSDB NAM $DSDB,7 91750-12020 REV.2013 791203 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18206 * RELOC: 91750-1X206 * * * ******************************************************************* * * END   91750-18207 2013 S C0122 &#MAQS +              H0101 bASMB,R,L,C HED <#MAQS> MA QUIESCENCE * (C) HEWLETT-PACKARD CO. 1980 NAM #MAQS,7 91750-1X207 REV 2013 800304 ALL (MA) EXT EXEC,#MCTR,#MTBL,$OPSY ENT #MAQS SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ****************************************************************** SPC 1 * #MAQS * --------------- * SOURCE PART # 91750-18207 * REL PART # 91750-1X207 * WRITTEN BY: TOM MILNER * DATE WRITTEN DEC 1979 * SPC 2 * #MAQS IS USED DURING QUIESCENCE TO DETERMINE IF THERE ARE * ANY MESSAGES THAT HAVE NOT BEEN ACKNOWLEDGED BY MESSAGE * ACCOUNTING. IF THERE ARE NO OUTSTANDING MESSAGES THIS * ROUTINE WILL RETURN TO THE CALLER. * * IF THERE ARE ANY OUTSTANDING MESSAGES (ON ANY CHANNEL), #MAQS * WILL SLEEP FOR 1 SECOND, THEN REPEAT THE SEARCH OF THE MA * TABLE. SKP #MAQS NOP * TOP DLD #MCTR GET # OF ENTRIES AND PTR ADA N1 CTR:=CTR-1; ADB N9 --> MA TABLE-9 DST CTR * * TERMINATE WHEN ENTIRE LIST HAS NO UNACK'ED MSGS * NEXT ISZ CTR ALL DONE? RSS . NO LOOK AT NEXT TABLE ENTRY JMP #MAQS,I . YES RETURN * LDB PTR ADB D10 --> CURRENT STATE WORD STB PTR JSB LODWD CLA LSR 12 ISOLATE VSO SZA,RSS ANY UNACK'ED? JMP NEXT . NO! LOOK @ NEXT ENTRY * JSB EXEC SLEEP FOR 1 SECOND DEF *+6 DEF D12 DEF D0 DEF D2 DEF D0 DEF N1 JMP TOP START AT TOP OF LIST SPC 1 * LODWD- GETS WORD FROM SAM LODWD NOP LDA $OPSY CHECK IF MEMOR   Y MAPPED RAR,SLA MAPPED? JMP *+3 . YES LDA 1,I . NO JUST GET INDIRECT JMP LODWD,I XLA 1,I JMP LODWD,I SPC 2 N1 DEC -1 N9 DEC -9 D0 DEC 0 D2 DEC 2 D10 DEC 10 D12 DEC 12 CTR BSS 1 PTR BSS 1 END    91750-18208 2013 S C0122 &#SEND +              H0101 WASMB,R,Q,C HED <#SEND> REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM #SEND,17,3 91750-16208 REV 2013 800107 ALL W/ RR SPC 1 EXT #NCNT,#NRV,#GRPM,#NODE EXT #LCNT,#CM,#QCLM,#CMCT,#LV EXT #LVSC EXT $OPSY,$LIBR,$LIBX,$TIME EXT XLUEX,EXEC,.ENTR,.LDX,.MVW,DTACH * * NAME: #SEND * SOURCE: 91750-18208 * RELOC: 91750-16208 * PGMR: DOUG W. TSUI JULY 1979 ** * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ****************************************************************** * * * #SEND SENDS UPDATE MESSAGES TO ALL NEIGHBORS. * IT SCANS THE NRV FOR THE ENTRY WITH THE CHANGE BIT SET. * SKP * ****************************************************************** * * * G L O B A L B L O C K REV 2001 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! AND ERROR CODES ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS MAKES STORE-AND-* ***!!!!! FORWARDt CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * SKP #SEND EQU * LDA 1,I GET PASSED SEQ # STA SEQ# JSB DTACH DETACH FROM ANY SESSION DEF *+1 IF NECESSARY NOP JSB CONFG TEST EQU * LDA #CMCT GET SEND SIGNAL SZA,RSS NEED TO SEND? JMP DONE .NO CLA .YES, CLEAR SEND SIGNAL FIRST STA #CMCT STA I SET UP LOOP INDEX LDB #NRV STB @NRV SET UP NRV ADDRESS * LOOP EQU * LDA @DABF STA @DA SET UP DATA BUFFER ADDR CLA STA DALEN SET UP DATA LEN * LOOP1 EQU * ISZ I UP LOOP INDEX ADB N.LU ==> NRV.LU JSB LDWD WILL RETURN NRV.LU WORD SSA,RSS CHANGE BIT SET? JMP CK1 .NO, NO ACTION STA LU SAVE IT AS LU JSB CLBIT JMP TO CLEAR CHANGE BIT LDA LU GET LU BACK AND =B377 MASK OFF ALL EXCEPT LU SZA NRV.LU = 0? JSB #LVSC .NO, FIND INDEX >hOF LU CLA,INA CANNOT FIND LU, USE 1ST LINK STA MNLIX STORE IT AS MIN LINK INDEX LDB @NRV ==> NRV.NODE JSB LDWD WILL RETURN NRV.NODE WORD STA @DA,I STORE IT IN DATA BUFFER ISZ @DA UP @DA TO POINT TO COST AND HOP COUNT JSB LDCM CALL TO LOAD COST AND H.C. FROM CM DEF *+4 DEF I DEF MNLIX @DA NOP JSB ERROR ISZ @DA UP DATA ISZ @DA BUFFER ADDRESS LDA DALEN ADA =D3 STA DALEN UP DATA LEN CPA MXLEN = MAX BUF LEN? JMP SEND .YES, SEND IT CK1 EQU * LDA N CPA I ALL NODES? JMP SEND .YES, SEND IT LDB @NRV UP ADB NRVSZ NRV STB @NRV JMP LOOP1 * * SEND NEWS TO ALL NEIGHBORS * SEND EQU * LDA DALEN SZA,RSS ANYTHING TO SEND? JMP TEST .NO CLA,INA STA J SET UP LOOP INDEX LDB #LV STB @LV SET UP LV ADDRESS * LOOP2 EQU * JSB LDWD WILL RETURN LU WORD SSA,RSS LINK DOWN? JMP CK2 .YES, CHECK END LOOP AND =B377 .NO, MASK OFF FLAGS LDB 0 SAVE IT IN B REG. IOR =B100000 STA CONWD STORE IT AS CONTROL WORD CMB,INB STB DESTN SET NEGATIVE LU AS DESTINATION NODE ISZ SEQ# UP SEQUENCE NUMBER FOR RR MSG NOP IN CASE SEQ# OVERFLOW JSB XLUEX DEF *+8 DEF NA20 DEF CONWD DEF DABUF DEF DALEN DEF RQBUF DEF RQLEN DEF #GRPM JSB ERROR * CK2 EQU * LDA J CPA #LCNT END OF LV TABLE? JMP CK ISZ J .NO, UP J LDB @LV ADB LVSZ UP LV ADDRESS STB @LV JMP LOOP2 * CK EQU * LDA N CPA I END LOOP? JMP TEST LDB @NRV ADB NRVSZ STB @NRV j JMP LOOP BACK TO LOOP * * EXIT FROM PROGRAM * DONE EQU * JSB EXEC DEF *+2 DEF K6 SKP * * ERROR HANDLING * ERROR NOP DST AREG CLA STA #LCNT DISABLE RR LDA #QCLM SZA,RSS JMP DONE LDA @SEND CMA,INA ADA ERROR ADA =D-1 STA PREG LDA PNAME STA PGM DLD PNAME+1 DST PGM+1 DLD $TIME DST TOD JSB EXEC DEF *+8 DEF NA20 DEF K0 DEF MSGBF DEF MSGLN DEF K8 DEF K0 DEF #QCLM NOP JMP DONE * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP CLEAR CALL TO THIS ROUTINE LDA $OPSY GET O/S TYPE RAR SLA,RSS DMS? JMP INIT .NO STB LDMOD .YES, MOD INSTS STB CLMOD STB LSMOD * INIT EQU * LDA #NCNT CMA,INA STA N * LDA #NODE STA SRC# LDA =B10000 SET LEVEL BIT STA STREM CLA STA RQBUF+#REQ JMP CONFG,I *** * * LDWD LOADS ONE WORD FROM SAME TO LOCAL * * CALLING SEQUENCE: * * = RETURN WORD * ==> SAM BUFFER * LDWD NOP LDMOD JMP LDLDA XLA 1,I JMP LDWD,I LDLDA LDA 1,I JMP LDWD,I * *** *** * * CLBIT CLEARS BIT 15 IN SAM * * CALLING SEQUENCE: * * ==> SAM WORD * CLBIT NOP JSB $LIBR NOP CLMOD JMP CLLDA XLA 1,I AND =B77777 XSA 1,I JMP CLRTN CLLDA LDA 1,I AND =B77777 STA 1,I CLRTN JSB $LIBX DEF CLBIT * *** *** * * LDCM MOVES WORDS FROM COST MATRIX TO LOCAL BUFFER * * CALLING SEQUENCE: * * JSB LDCM * DEF *+4 * DEF NIX NODE INDEX * DEF LIX LINK INDEX * DEF BUF RETURN BUFFER AREA * * * @NIX NOP @LIX NOP @BUF hNOP * LDCM NOP JSB .ENTR GET PARAMETER ADDRESS DEF @NIX * * CM ADDR CALCULATION = (#LCNT(NIX-1)+LIX-1)2+#CM * LDA @NIX,I ADA =D-1 MPY #LCNT SZB JMP LDCM,I ERROR RETURN ADA @LIX,I ADA =D-1 ALS LEFT SHIFT(X2) FOR 2 WORD CM ELEMENTS ADA #CM * LDB @BUF ==> SAM BUFFER JSB LDWS LOAD 2 WORDS FROM SAM * ISZ LDCM ADJUST RETURN ADDR JMP LDCM,I * *** *** * * LDWS MOVES WORDS FROM SAM TO LOCAL * * CALLING SEQUENCE: * * ==> SAM WORDS * ==> LOCAL BUFFER * LDWS NOP LSMOD JMP LSMVW JSB .LDX DEF LSLEN MWF JMP LDWS,I LSMVW JSB .MVW DEF LSLEN NOP JMP LDWS,I LSLEN DEC 2 TWO WORD MOVE * *** SKP * * DATA AREA * CONWD NOP WRITE CONTROL WORD OCT 10100 NA20 OCT 100024 K0 DEC 0 K6 DEC 6 K8 DEC 8 I NOP NRV LOOP INDEX J NOP LV LOOP INDEX N NOP # OF NODES IN THE NET MNLIX NOP MIN LINK INDEX @SEND DEF #SEND PNAME ASC 3,#SEND * @LV NOP LV POINTER LVSZ DEC 6 LV SIZE * @NRV NOP NRV POINTER NRVSZ DEC 3 SIZE OF NRV ENTRIES N.LU DEC 2 LU OFFSET * RQBUF BSS #MHD+#LSZ+1 STREM EQU RQBUF SEQ# EQU RQBUF+1 SRC# EQU RQBUF+2 DESTN EQU RQBUF+3 RQLEN ABS *-RQBUF * DABUF BSS 384 MAX BUFFER SIZE = 128*3 MXLEN ABS *-DABUF DALEN NOP @DABF DEF DABUF ADDRESS OF DATA BUFFER * MSGBF BSS 12 LU EQU MSGBF UP LU PREG EQU MSGBF+4 AREG EQU MSGBF+5 TOD EQU MSGBF+7 PGM EQU MSGBF+9 MSGLN ABS *-MSGBF END #SEND   91750-18210 2013 S C0122 &#NRV2              H0101 HASMB,Q NAM #NRVS,30 91750-1X210 REV.2013 791228 MEF W/3K & NO RTE LINKS SPC 2 ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * ******************************************************************* SPC 2 ENT #NRVS A EQU 0 * * NAME: #NRVS * SOURCE: 91750-18210 * BINARY: 91750-1X210 * PRGMR: DAVE TRIBBY * * * DUMMY #NRVS FOR SYSTEMS WITH 1000-3000 LINKS ONLY. * #NRVS NOP LDB DS07 LOAD ERROR CODE FOR DS07. LDA #NRVS,I JMP A,I TAKE ERROR RETURN. * DS07 ASC 1,07 END   91750-18211 2013 S C0122 &#PUTD              H0101 ]ASMB,R,Q,C HED <#PUTD> DS "PUT" SUBROUTINE * (C) HEWLETT-PACKARD CO. 1980* NAM #PUTD,7 91750-1X211 REV 2013 800110 ALL * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 #PUTD SPC 1 EXT .ENTR,$LIBR,$LIBX EXT #SBFA,#SDAL EXT $OPSY EXT .MVW,.LDX * * NAME: #PUTD * SOURCE: 91750-18211 * RELOC: 91750-1X211 * PGMR: DOUG W. TSUI NOV. 1979 * * * * PURPOSE: * #PUTD IS CALLED BY GRPM WHEN IT NEEDS TO MODIFY PART * OF THE DATA AREA IN DS MESSAGE. IT IS SIMILIAR TO * #PUTR WHICH MODIFIES THE HEADER PORTION. * * ****WARNING**** * #PUTD ASSUMES THE Z BUFFER (DS HEADER) OF CLASS I/O * FOLLOWS IMMEDIATELY AFTER THE USER BUFFER (DS DATA). * IF THIS STRUCTURE SHOULD CHANGE IN THE FUTURE RTE * STSTEM, #PUTD NEEDS TO CHANGE ALSO. * * CALLING SEQUENCE: * JSB #PUTD * DEF *+4 * DEF OFFSET INTO DATA AREA TO START WRITING ( >= 0) * DEF DATA TO OVERLAY DS AREA IN SAM * DEF * ATTEMPT MADE TO WRITE PAST END OF BUFFER * (A) & (B) MEANINGLESS * SKP @OFST NOP OFFSET @DATA NOP OVERLAY DATA @LEN NOP OVERLAY LEN * #PUTD NOP JSB .ENTR GET PARAMETER ADDRESSES DEF @OFST * NOP JSB CONFG CONFIGURE DMS/NON-DMS ('NOP' AFTER 1ST CALL) * LDB @OFST,I LOAD OFFSET LDA #SDAL SSB,RSS CMA,INA,SZA,RSS JMP #PUTD,I IF NEGATIVE OFFSET OR NO BUF, ERR RETN ADA @OFST,I SSA,RSS PAST END OF BU  FFER? JMP #PUTD,I ERR RETN LDA @LEN,I GET DATA STA SSLEN STORE AS MOVE LEN LDB #SDAL CMB,INB ADB #SBFA FIND DATA AREA ADDR ADB @OFST,I ADD OFFSET LDA @DATA OVERLAY ADDRESS JSB STWS OVERLAY SAM WORDS ISZ #PUTD ADJUST RETURN JMP #PUTD,I SKP * * CONFIGURE THE SYSTEM ENVIRONMENT * CONFG NOP CLB STB NOP LDA $OPSY RAR,SLA STB SSMOD JMP CONFG,I *** * * STWS MOVES WORDS FROM LOCAL BUFFER TO SAM BUFFER * * CALLING SEQUENCE: * * ==> LOCAL BUFFER * ==> SAM BUFFER * STWS NOP JSB $LIBR NOP SSMOD JMP SSMVW JSB .LDX DEF SSLEN MWI JMP SSJSB SSMVW JSB .MVW DEF SSLEN NOP SSJSB JSB $LIBX DEF STWS * SSLEN DEC 2 2 WORD MOVE * *** END ?   91750-18212 2013 S C0122 &MVCP3 +              H0101 oFTN4,L,T PROGRAM MVCP3(19,90),91750-16212 REV.2013 800409 C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. 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 PROGRAM TO MOVE ABSOLUTE RTE FILE !COPY3 TO MPE PROG FILE C COPY3K.PUB.SYS. THE PROG IS USED AS P-TO-P SLAVE FOR C RMOTE'S MO (FILE MOVE) COMMAND. C C SOURCE: 91750-18212 C C RELOCATABLE: 91750-16212 C C DATE: JULY 12, 1979 C C PROGRAMMER: DMT C C C RUN FROM RMOTE WITH C $RU,MVCP3,,, C ALL THREE PARAMETERS ARE OPTIONAL. IS USED TO REPORT C ERROR MESSAGES. DEFAULT IS THE VALUE RETURNED FROM LOGLU. C IS THE FMP SECURITY CODE FOR !COPY3. DEFAULT IS 0. C IS THE FMP CARTRIDGE FOR !COPY3. DEFAULT IS 0. C INTEGER FOPEN INTEGER DCB(144), P(5), BUFFER(128), NAME(3), MNAME(8), SIZE(2) C C RTE FILE NAME (!COPY3) DATA NAME/2H!C,2HOP,2HY3/ C MPE FILE NAME DATA MNAME/2HCO,2HPY,2H3K,2H.P,2HUB,2H.S,2HYS,0/, SIZE/0,0/ C C PICK UP SCHEDULING PARAMETERS CALL RMPAR(P) LULOG = P(1) IF(LULOG.LT.1)LULOG = LOGLU(IDUMMY) C C RESUME RMOTE'S SESSION VIA CALL TO PRCNM WITH 5TH PRAM IF(P(5) .GE. 0) GO TO 960 CALL PRCNM(P(5)) C OPEN UP THE RTE FILE CALL OPEN(DCB,IERR,NAME,0,P(2),P(3)) IF(IERR.GE.0) GO TO 10 C RTE FILE ERROR! REPORT IT... WRITE(LULOG,125)IERR,NAME,P(2),P(3) 125 FORMAT(10X"FMP ERROR"I6" OPENING "3A2":"I5":"I5) GO TO 910 C C MAKE SURE THE RTE FILE'S TYPE IS 1 10 IF(IERR .EQ. 1)GO TO 15 WRITE(LULOG,127)NAME,IERR 127 FORMAT(1=0X,3A2" IS FILE TYPE"I6", NOT TYPE 1") GO TO 910 C C GET THE SIZE OF THE TYPE-1 RTE FILE TO DETERMINE MPE SIZE 15 CALL LOCF(DCB,IERR,IREC,IRB,IOFF,JSEC) IF(IERR .GE. 0) GO TO 20 WRITE(LULOG,130)IERR,NAME 130 FORMAT(10X"FMP ERROR"I6" ON LOCF TO "3A2) GO TO 910 20 SIZE(2) = JSEC/2 C CREATE THE MPE FILE IFNUM = FOPEN(MNAME,2000B,104B,128,0,0,0,1,1,SIZE,1,1,1029) IF(ICC(M).EQ.0) GO TO 25 C MPE FILE ERROR! REPORT IT... CALL FCHEK(IFNUM,IERR) WRITE(LULOG,135)IERR,(MNAME(I), I=1,7) 135 FORMAT(10X"MPE ERROR"I6" OPENING "7A2) GO TO 910 C C TRANSFER DATA 25 WRITE(LULOG,137)NAME,(MNAME(I), I=1,7) 137 FORMAT(10X"BEGINNING TRANSFER OF "3A2" TO "7A2) 30 CALL READF(DCB,IERR,BUFFER,128,LGTH) C CHECK FOR END-OF-FILE IF(IERR .EQ. -12) GO TO 1000 C CHECK FOR ERROR IF(IERR .GE. 0) GO TO 40 C ERROR IN READING RTE FILE... WRITE(LULOG,140)IERR,NAME 140 FORMAT(10X"FMP ERROR"I6" READING "3A2) GO TO 900 C MAKE SURE RTE FILE IS THE PROPER FORMAT 40 IF(LGTH .EQ. 128) GO TO 60 C BAD LENGTH WRITE(LULOG,145)NAME 145 FORMAT(10X"BAD LENGTH IN FILE "3A2) GO TO 900 60 CALL FWRIT(IFNUM,BUFFER,128,0) IF(ICC(M).GE.0) GO TO 30 C ERROR IN WRITING MPE FILE... CALL FCHEK(IFNUM,IERR) WRITE(LULOG,150)IERR,(MNAME(I), I=1,7) 150 FORMAT(10X"MPE ERROR"I6" WRITING "7A2) C C ERROR. CLOSE BOTH FILES AND ABORT. 900 CALL FCLOS(IFNUM,4,0) 910 CALL CLOSE(DCB) 950 CALL EXEC(6,0,3) C 960 WRITE(LULOG,961) 961 FORMAT(/10X"MVCP3 MUST BE RUN FROM RMOTE (AFTER LOGON TO MPE)"/) GO TO 950 C 970 CALL FCHEK(IFNUM,IERR) WRITE(LULOG,971)IERR,(MNAME(I), I=1,7) 971 FORMAT(10X"MPE ERROR"I6" CLOSING "7A2) GO TO 950 C C GOOD COMPLETION... 1000 CALL CLOSE(DCB) CALL FCLOS(IFNUM,11B,0) IF(ICC(M) .NE. 0)GO TO 970 END    91750-18213 2013 S C0122 ©3 +              H0101 r$CONTROL USLINIT,MAIN=COPY3K,LINES=56 $COPYRIGHT "91750-18213 REV.2013 800319 " ,& $ "(C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS " ,& $ "RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, " ,& $ "REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT ",& $ "THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY." BEGIN COMMENT VERSION 2-19-80 D.M.T./DATA SYSTEMS DIVISION THIS IS A SLAVE PROGRAM USED TO TRANSFER FILES BETWEEN HP 1000 AND HP 3000 COMPUTERS. THIS PROGRAM BLOCKS OR DEBLOCKS RECORDS IN TRANSFER BUFFERS AND TRANSLATES I/O CONTROL CODES FROM RTE TO MPE; << THE RECORD LENGTH (BYTES) IS STORED IN RECORD(0) >> BYTE ARRAY BRECORD(0:769); INTEGER ARRAY RECORD(*)=BRECORD; INTEGER ARRAY BUFFER(0:4095), << TRANSMISSION BUFFER >> TAG(0:19); << P-TO-P TAG FIELD >> COMMENT THE TAG FIELD ELEMENTS HAVE THE FOLLOWING MEANINGS-- TAG(0) MPE FOPTIONS TAG(1) OPERATION: 2=READ, 3=WRITE TAG(2) RTE FILE TYPE (USED FOR READ) TAG(3) 0 UNTIL END OF FILE TAG(4) 0 UNTIL ERROR OCCURS TAG(5) "UN" IF LAST 8 COLS ARE REMOVED (USED ON READ) TAG(6) MPE RECSIZE TAG(7) LENGTH OF DATA IN PREAD (WORDS) TAG(8) SPECIFIC ERROR CODE (SEE 4) TAG(9) OLD(0)/NEW(-1) INDICATOR TAG(10) P-TO-P BUFFER SIZE (MAX BLOCK SIZE) TAG(11) "SP" IF RTE FILE IS SPOOLED, "CC" FOR CARRIAGE CONTROL TAG(12) RECORD COUNT; INTEGER FUNCTION, << FUNCTION FROM "GET" >> WRDLEN, << NUMBER OF WORDS READ >> BYTLEN, << NUMBER OF BYTES READ >> TOTLEN, << TOTAL LENGTH OF TRANSMISSION BUFFER >> ERROR, << ERRORv INDICATOR >> FILENUM, << MPE FILE NUMBER >> OPERATION, << OPERATION CODE PASSED IN POPEN TAG FIELD >> DISPOSITION, << DISPOSITION OF MPE FILE UPON CLOSE >> CC, << CONDITION CODE AFTER FOPEN >> FILEERROR, << MPE FILE ERROR CODE >> CONTROL, << MPE I/O CONTROL WORD >> CONWD; << RTE I/O CONTROL WORD >> LOGICAL DEVTYPE, << USED IN FGETINFO CALL >> HDADDR, << USED IN FGETINFO CALL >> COUNT, << NUMBER OF RECORDS READ/WRITTEN >> PRESPC:=%401, << PRESPACING CARRIAGE CNTRL>> KILL, << FALSE UNTIL ERROR OCCURS >> UNNUMBERED; << TRUE IF LAST 8 COLUMNS ARE TO BE REMOVED>> << P-TO-P INTRINSICS >> INTRINSIC GET,ACCEPT,REJECT,PCHECK; << FILE INTRINSICS >> INTRINSIC FREAD,FWRITE,FCONTROL,FCHECK,FOPEN,FCLOSE,FGETINFO; $PAGE " * * * C H E C K / R E P O R T E R R O R S * * *" PROCEDURE REPORTMPE; BEGIN << REPORT MPE FILE ERROR >> FCHECK(FILENUM,FILEERROR); KILL := TRUE; END; << OF REPORTMPE >> PROCEDURE CHECKDS; BEGIN << CHECK FOR ERROR. PASS BACK THESE INDICATORS: CONDITION TAG(4) TAG(8) BAD MASTER CALL 1 0 DS ERROR 2 PCHECK() FILE ERROR 3 FCHECK() >> IF < THEN BEGIN TAG(4) := 2; TAG(8) := PCHECK(0); END ELSE IF FILEERROR <> 0 THEN BEGIN TAG(4) := 3; TAG(8) := FILEERROR; FILEERROR := 0; END ELSE IF FUNCTION <> OPERATION THEN TAG(4) := 1; IF TAG(4) <> 0 THEN BEGIN KILL := TRUE; REJECT(TAG); END END; << OF CHECKDS >> $PAGE " * * * R E A D D A T A (FROM MPE TO RTE) * * *" PROCEDURE READDATA; BEGIN << USED WHEN TAG(1) SPECIFIES FILE IS TO BE READ >> LOGICAL MPEASCII; << TRUE WHEN MPE ASCII FOPTION BIT SET. >>  MPEASCII := TAG(0).(13:1) = 1; TOTLEN := 0; WHILE TAG(3)>=0 AND NOT KILL DO BEGIN BYTLEN := FREAD(FILENUM,RECORD(1),-768); IF = THEN BEGIN << FILE READ WAS OK >> COUNT := COUNT + 1; << CHECK FOR ODD # OF BYTES >> IF BYTLEN.(15:1)=1 THEN BRECORD(BYTLEN+2) := " "; << IS IT AN ASCII FILE? >> IF TAG(2)=4 OR MPEASCII THEN BEGIN << GET RID OF TRAILING BLANKS >> IF UNNUMBERED AND BYTLEN>=8 THEN BYTLEN := BYTLEN - 8; WHILE BRECORD(BYTLEN+1)=" " AND BYTLEN>1 DO BYTLEN := BYTLEN - 1; END; RECORD(0) := BYTLEN; WRDLEN := (BYTLEN+3)/2; << ADD 1 FOR LENGTH WORD >> IF TOTLEN+WRDLEN > TAG(10) THEN BEGIN << TIME TO TRANSFER DATA TO HP 1000 >> FUNCTION := GET(TAG); TAG(12) := COUNT; CHECKDS; TAG(7) := TOTLEN; IF NOT KILL THEN ACCEPT(TAG,BUFFER,TOTLEN); TOTLEN := 0; END; MOVE BUFFER(TOTLEN) := RECORD(0),(WRDLEN); TOTLEN := TOTLEN + WRDLEN; END ELSE BEGIN IF < THEN << FILE ERROR >> REPORTMPE ELSE BEGIN << END OF FILE >> FUNCTION := GET(TAG); TAG(12) := COUNT; CHECKDS; TAG(3) := -1; TAG(7) := TOTLEN; IF NOT KILL THEN ACCEPT(TAG,BUFFER,TOTLEN); END; END; END; << WHILE STATEMENT >> END; << OF READDATA >> $PAGE " * * * W R I T E D A T A (FROM RTE TO MPE) * * *" PROCEDURE WRITEDATA; BEGIN << USED WHEN TAG(1) SPECIFIES FILE IS TO BE WRITTEN >> INTEGER I; << IF CARRIAGE CONTROL OK, SET FOR PRESPACE (SO LINEPRINTER OUTPUT WILL MATCH RTE) >> IF TAG(0).(7:1)=1 THEN FWRITE(FILENUM,PRESPC,0,PRESPC); WHILE TAG(3)>=0 AND NOT KILL DO BEGIN FUNCTION := GET(TAG,TOTLEN); TAG(12) := COUNT; CHECKDS; IF NOT KILL THEN ACCEPT(TAG,BUFFER,TOTLEN); I := 0; WHILE I> IF BUFFER(I+1).(10:6) = 2 THEN BEGIN << WRITE REQUEST >> CONWD := BUFFER(I+1); IF CONWD.(5:1)=1 THEN CONTROL := %320 << SUPRESS LINE FEED >> ELSE IF CONWD.(8:1)=0 THEN BEGIN << COLUMN 1 IS CARRIAGE CONTROL >> CONTROL := 1; IF BUFFER(I+3).(0:8)="*" THEN BUFFER(I+3).(0:8):="+"; END ELSE CONTROL := %40; << SINGLE SPACE >> FWRITE(FILENUM,BUFFER(I+3),BUFFER(I+2),CONTROL); END ELSE IF BUFFER(I+1).(4:6) = %11 THEN BEGIN << SPACING CONTROL >> CONWD := BUFFER(I+2); IF CONWD<0 OR CONWD=63 THEN CONTROL := %300 ELSE IF 1<=CONWD<=55 THEN CONTROL := CONWD+%200 ELSE IF 56<=CONWD<=61 THEN CONTROL := CONWD + %212 ELSE IF CONWD=62 THEN CONTROL := %301 ELSE IF CONWD=64 THEN CONTROL := %102 ELSE IF CONWD=65 THEN CONTROL := %103 ELSE IF 66<=CONWD<=69 THEN CONTROL := CONWD + %206 ELSE CONWD := %40; FWRITE(FILENUM,BUFFER,0,CONTROL); END; END ELSE << REGULAR RTE FILE >> BEGIN IF TAG(11)="CC" THEN BEGIN << COLUMN 1 IS CARRIAGE CONTROL >> CONTROL := 1; IF BUFFER(I+1).(0:8)="*" THEN BUFFER(I+1).(0:8):="+"; END ELSE CONTROL := %40; << SINGLE SPACE >> FWRITE(FILENUM,BUFFER(I+1),-BUFFER(I),CONTROL); END; IF <> THEN << FILE ERROR >> REPORTMPE ELSE << BUMP RECORD COUNTER >> COUNT := COUNT + 1; << INCREMENT I (LENGTH COUNT). ALLOW FOR ODD BYTE AND COUNT WORD. >> I := I + (BUFFER(I)+3)/2; END; << OF WHILE >> END; << OF WHILE >> << WRITE EOF >> FCONTROL(FILENUM,6,I); END; << OF WRITEDATA >> $PAGE " * * * M A I N * * *" << BEGINNING OF MAIN PROGRAM >> FILEERROR := 0; DO BEGIN << WAIT FOR A POPEN >> KILL := FALSE; OPERATION := 1; FUNCTION:=GET(TAG); CHECKDS; END UNTIL KILL=FALSE; << TOO BIG? >> IF TAG(10) > 4096 THEN TAG(10) := 4096; ACCEPT(TAG); << WE TERMINATE WHEN MASTER SENDS PCLOSE >> WHILE TRUE DO BEGIN FILEERROR := 0; DO BEGIN << WAIT FOR PWRITE. >> KILL := FALSE; OPERATION := 3; FUNCTION:=GET(TAG,TOTLEN); CHECKDS; END UNTIL NOT KILL; << READY TO GO! SET UP TAG FIELDS AND OPEN FILE. >> ACCEPT(TAG,BUFFER,TOTLEN); UNNUMBERED := TAG(5) = "UN"; FILENUM := FOPEN(BUFFER,3,4); IF < THEN BEGIN << FILE DOES NOT EXIST >> CC := -1; IF TAG(1)= 3 THEN << WRITE SPECIFIED >> BEGIN << CREATE THE FILE >> FILENUM := FOPEN(BUFFER,TAG(0),1,TAG(6)); IF < THEN REPORTMPE ELSE DISPOSITION := %11; END ELSE << READ SPECIFIED, BUT FILE DOES NOT EXIST >> REPORTMPE; END ELSE BEGIN << FILE EXISTS >> CC := DISPOSITION := 0; IF TAG(1)=3 THEN << OK TO OVERWRITE? >> BEGIN FGETINFO(FILENUM,,,,,DEVTYPE,,HDADDR); IF HDADDR.(0:8)=0 << SPOOLED DEVICE >> OR DEVTYPE.(8:8)>1 THEN << NON-DISC DEVICE >> CC := -1; << TREAT LIKE NEW FILE >> END; END; << WAIT FOR PCONTROL. SEND BACK FILE OPEN INDICATOR >> $" OPERATION := 4; FUNCTION := GET(TAG); CHECKDS; FGETINFO(FILENUM,,TAG(0),,TAG(6)); TAG(9) := CC; IF NOT KILL THEN ACCEPT(TAG); OPERATION := TAG(1); COUNT := 0; IF OPERATION=2 THEN READDATA ELSE IF OPERATION=3 THEN WRITEDATA; KILL := FALSE; IF FILENUM<>0 THEN BEGIN FCLOSE(FILENUM,DISPOSITION,0); IF < THEN REPORTMPE; END; << MASTER SHOULD SEND PCONTROL >> OPERATION := 4; FUNCTION := GET(TAG); TAG(12) := COUNT; CHECKDS; IF NOT KILL THEN ACCEPT(TAG); END << GO BACK TO "WHILE TRUE" >> ; END. 3$  91750-18215 2013 S C0122 &GETKY &GETKY             H0101 )ASMB HED GETKY UTILITY SUBROUTINE FOR RDBAP NAM GETKY,7 91750-1X215 REV.2013 790130 * * ******************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. * NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR * TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY. ******************************************************************* * * * SOURCE: 91750-18215 * RELOC: 91750-1X215 * * PRGMR: CEJ * * ******************************************************************* * * * * GET KeY is a utility subroutine for the use of RDBAP servicing a remote * DBOPN. Its function is to determine the length of the key item be- * longing to the master data set whose number is the only parameter. * This key item length is returned in the A register. * ENT GETKY EXT .ENTR,AIRUN,DBFDI,DBFDS * B EQU 1 * SET NOP * GETKY NOP JSB .ENTR Retrieve the data set DEF SET number's address. * JSB DBFDS Ask DBFDS to calculate the set's DEF *+5 DEF SET,I DSCB relative address. DEF DUMMY DEF DUMMY DEF ADDRS * LDB ADDRS Add the relative addr. to the ADB AIRUN Run Table addr. to get true addr. * ADB DSCCT Get the key item's number LDA B,I from the high order byte of ALF,ALF the 11th word of the DSCB. AND LOBYT STA KEY * JSB DBFDI Ask DBFDI to calculate DEF *+5 the item's Data Item DEF KEY Table relative address. DEF DUMMY DEF DUMMY DEF ADDRS * LDB ADDRS Add to Run Table address to ADB AIRUN get true address. ADB ITLNG Get item's length from the 7th LDA B,I word of the entry * JMP GETKY,I and return. *    * Constants and variables. * ITLNG DEC 6 DSCCT DEC 10 * LOBYT OCT 377 * ADDRS NOP KEY NOP DUMMY NOP END GETKY   91750-18216 2013 S C0122 &DUMRR +              H0101 ASMB,R,Q,C HED DUMMY REROUTING ROUTINE * (C) HEWLETT-PACKARD CO. 1979* NAM DUMRR,30 91750-1X216 REV 2013 800821 ALL SPC 1 * * NAME: DUMRR * SOURCE: 91750-18216 * RELOC: 91750-1X216 * PGMR: DWT ENT #RR1,#RR2,#RR3,#RR4,#RR5,#RR6,#RR7 #RR1 RPL 2400B #RR2 RPL 0 #RR3 RPL 0 #RR4 RPL 0 #RR5 RPL 0 #RR6 RPL 0 #RR7 RPL 0 ENT #UP,#UPDA,#DOWN #UP RPL 0 #UPDA RPL 0 #DOWN RPL 0 END _  91750-18217 2013 S C0122 &WHZDS +              H0101 wASMB,R,Q,C NAM WHZAT,17,1 91750-16217 REV 2013 791219 * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 * * NAME: WHZAT * SOURCE: 91750-18217 * RELOC: 91750-16217 * PRGMR: E.J.W.,D.B. * SUP PRESS ALL EXTRANEOUS LISTING EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL EXT $ELTB EXT $MATA,$MNP EXT DEXEC,#CNOD,#NODE * 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: * RU,WHZAT,LU,AL * * * *13:37: 1:770 *------------------------------------------------------------------------ * PRGRM T PRIOR PT SZ DO.SC.IO.WT.ME.DS.OP. .PRG CNTR. .NEXT TIME. *------------------------------------------------------------------------ ***FMG73 3 00051 22 10 * * * * 3,WHZ73 * * * * * P:42274 * WHZ73 3 00001 13 4 . 1, . . . . . . . . . . . P:37045 *. *. ***FMG18 3 00051 20 10 * * * * 3,REA18 * * * * * P:42274 * REA18 3 00090 9 16 . . . 2,EQ: 8,AV:2,ST:004 P:61106 ***FMG66 3 00051 14 10 * * * * 3,EDI66 * * * * * P:42274 * EDI66 3 00051 21 7 . . . 2,EQ: 12,AV:2,ST:002 P:42704 ***FMG78 3 00051 29 10 * * * * 3,SNGGN * * * * * P:42274 * SNGGN 3 00099 18 14 . . . 2,EQ: 23,AV:2,ST:002 P:52640 ***FMG84 3 00051 41 10 * * * * 3,EDI84 * * * * * P:42274 * EDI84 3 00051 36 15 . . . 2,EQ: 30,AV:2,ST:002 P:45055 ***FMG70 3 00051 32 10 * * * * 3,EDI70 * * * * * P:42274 * EDI70 3 00051 35 15 . . . 2,EQ: 15,AV:2,ST:002 P:45055 ***FMG74 3 00051 31 10 * * * * 3,SHE74 * * * * * P:42274 * SHE74 3 00051 27 14 . . . 2,EQ: 19,AV:2,ST:002 P:55304 *. * R$PN$ 1 00010 0 . . . . . 3,CL 025 . . . . P:41016 * UPLIN 1 00003 0 . 0, . . . . . . . . . . . . P:00000 13:37: 4:120 * GRPM 1 00004 0 . . . . . 3,CL 039 . . . . P:45600 * RTRY 1 00020 0 . . . . . 3,CL 038 . . . . P:46366 * SPOUT 2 00011 4 3 . . . . 3,CL 024 . . . . P:34250 * LOGON 3 00049 30 11 . . . . 3,CL 026 . . . . P:35616 * LGOFF 3 00051 40 9 . . . . 3,CL 027 . . . . P:35133 * QCLM 3 00028 20 2 . . . . 3,CL 037 . . . . P:34045SWP * DLIST 3 00030 13 3 . . . . 3,CL 036 . . . . P:37113SWP * PROGL 3 00030 29 5 . . . . 3,CL 030 . . . . P:34065SWP * RFAM 3 00030 30 8 . . . . 3,CL 032 . . . . P:47203SWP * EXECM 3 00030 21 3 . . . . 3,CL 033 . . . . P:34054SWP * EXECW 3 00030 20 2 . . . . 3,CL 035 . . . . P:35614SWP * OPERM 3 00030 20 2 . . . . 3,CL 031 . . . . P:35377SWP * PTOPM 3 00030 47 2 . . . . 3,CL 034 . . . . P:34052 * FMG81 3 00051 45 10 . . . 2,EQ: 27,AV:2,ST:002 P:52220 *------------------------------------------------------------------------ *ALL LU'S OK *ALL EQT'S OK *LOCKED LU'S (PROG NAME) 8(REA18), *MAX CONT. FREE TRKS : 127, LU 3 *------------------------------------------------------------------------ *13:37: 2:170 * * * * FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-IVB * RU,WHZAT,LU,PA * * 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 y 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 RAL CHECK IF ASCHII SSA JMP WHASC YES,TREAT THIS AS SECOND PARAMETER INB RAR RESTORE A REGISTER CLE,SZA,RSS SCHED W PRAM ? CLA,CCE,INA NO-DEFAULT TO LU 1 WHT0 STA CRTLU SAVE LU FOR OUTPUT XLA B,I STA PARM2 SAVE SECOND PARAMETER INB XLA B,I GET SPECIAL LU PARAM INB STB PARMA SAVE PARAMETER ADDRESS ISZ PARMA & UPDATE FOR PARM 5 SZA NON ZERO NODE SPECIFIED JMP CONT YES, JUST CONTINUE XCA B,I NO, FLAG WAS SET JSB PANOD CONT CPA M1 -1 WAS SPECIFIED LDA #NODE YES, THEN GET THE LOCAL NODE STA DNODE SAVE NODE FOR EXEC CALLS XLA PARMA,I GET SPECIAL LU PARAM SZA,RSS IN CASE OF PREV RUN LDA CRTLU SEZ DEFAULT NEEDED? STA CRTLU YES INB PICK UP THE XLB B,I SESID FROM LAST TIME STB SESID AND SAVE FOR NOW IF NEEDED JMP WHT1 * WHASC CLE CLA,INA CRTLU = 1 JMP WHT0 * SPC 2 WHT1 LDA .EOF SEND BLANK LINE LDB DM6 JSB PRINT USE STD PRINT SUB JSB TOD PRINT TIME-OF-DAY AS NEXT LINE LDA DNODE IF WE WERE RUNNING REMOTELY CPA #NODE PRINT PROGRAM AND NODE ID RSS JSB PGID JSB DASHS ERASE EOL + A LINE OF DASHES * LDA PARM2 CPA "PA" PARTITION REPORT REQUEST ? JMP WHATP YES. * LDA .HEAD GET THE HEAD LDB DM76 AND JSB PRINT PRINT IT JSB DASHS PRINT A LINE * LDA NAMSB CLEAR THE ID STACK STA NAMST (STACK OF PROCESSED ID'S) STA DLKFL SET THE DEAD LOCK FLAG * LDA PARM2 GET THE SECOND PARAMETER CPA "AL" IF ALL CODED,THEN GO REPORT ALL JMP FULL * CPA "SM" ALMOST ALL ? JMP FULL YES, GO DO IT. * LDA XEQT GET CURRENT SESSION ADD ADA D32 XLA A,I FROM THE ID SZA IF NOT ZERO STA SESID SAVE IT LDA SESID WELL, WHAT DO WE HAVE ?? SZA,RSS IF ZERO JMP FULL1 REPORT ALL ACTIVE PROGRAMS JMP SES * FULL EQU * LDA XEQT GET THE SESSION ADDRESS AGAIN ADA D32 XLA A,I SZA,RSS IF ZERO,NON SESSION JMP FULL1 ZERO SO REPORT ALL THE PROGRAMS * STA SESID SAVE IT JSB DOIT DISPLAY THE SESSION RELATED PROGRAMS FIRST JSB ODTSP OUTPUT AN ADDITIONAL LINE * FULL1 CLA NOW DISPLAY REST OF THE PROGRAMS STA SESID JSB DOIT YES, DO IT JMP FINIS EXIT * SES EQU * JSB DOIT DISPLAY ONLY SESSION RELATED PROGRAMS JMP FINIS * * * SUBROUTINE DO IT * DOIT NOP CLA STA IDCNT SET UP TO START THE ID SCAN STA ALL * * NXSES LDA KEYWD START THE SCAN ADA IDCNT GET KEY WORD ADDRESS XLA A,I GET THE ID ADDRESS STA IDPNT SET IT DOWN IN CASE THIS IS IT SZA,RSS END OF LIST?? JMP FINX YES GO CHECK ALL FLAG * ADA D14 IS A SHORT ID XLB A,I GET FLAG WORD BLF,BLF ROTATE IT AROUND BLF,SLB,BLF WELL?? JMP FINX YES END OF USEFUL ID'S * INA CHECK IF ID IS IN USE XLB A,I GET STATUS SZB ZERO DORMANT JMP NOTDM NOT DORMANT CONSIDER IT * ADA D2 GET THE TIME LIST WORD XLB A,I GOT IT BLF,SLB IN THE TIME LIST?? RSS YES JMP NOYET NO DON'T WORRY ABOUT THIS ONE * * * NOTDM LDA IDPNT RESTORE A TO THE ID ADDRESS LDB SESID GET THE SESSION ID SZB,RSS IF ZERO JMP MAIN GO DO THE ALL TESTS * ADA D32 INDEX TO THE SESSION WORD XLA A,I GET THE WORD CPA B IN THE SESSION?? JMP THISS YES GO DO IT * NOYET ISZ IDCNT NO INDEX THE COUNT JMP NXSES AND TRY AGAIN * * THISS JSB THIS CHECK IF ALREADY REPORTED JMP NOYET ALREADY DONE DON'T DO IT TWICE * THIS1 LDB IDPNT CHECK IF THE PROGRAM IN IN A FATHER SON ADB D20 CHAIN XLA B,I GET FATHER POINTER RAL POSITION THE BIT SSA IS THEIR A FATHER? JMP POP YES GO TRY HIM * ADB DM5 NO TRY FOR A SON XLA B,I GET STATUS WORD AND B10K ISOLATE THE WAITING BIT SZA SET?? JMP PRGN1 YES THIS IS A PROGININATOR * LDA ALL AN INDEPENDENT PROG. CHECK IF OK TO REPORT SZA WELL? JMP PRGN1 YES GO DO IT * JMP NOYET NO SKIP IT * POP RAR THERE IS A FATHER GO UP TO GET HIM AND B377 ISOLATE HIS NUMBER ADA M1 AND COMPUTE HIS ADA KEYWD ADDRESS XLA A,I GET HIS ID ADDRESS LDB IDPNT SAVE THE CURRENT ONE STB PROCS IN TEMP STA IDPNT AND SET IT UP JSB THIS HAVE WE BEEN HERE BEFORE?? RSS YES SKIP FOR FURTHER TESTS JMP THIS1 NO GO CHECK IF THE PROGIN. YET * LDB ALL CHECK IS SECOND SCAN CPKlB D2 IF SO THEN IT IS NOT AN ERROR RSS ELSE LET JMP THIS1 NATURE TAKE ITS COURSE * LDA PROCS NOT ERROR STA IDPNT RESTORE THE SON AND * PRGN1 CLA STA PRGFL INITIALIZE THE 'PROGINATOR' FLAG * PROGN JSB THIS MAKE SURE WE ARE NOT IN A LOOP JMP DEAD REPORT A DEAD LOCK * JSB STKNA WE ARE GOING TO PRINT THIS ONE LDB D15 GET STATUS JSB IDWRD AND AND B17 SET IT UP STA STATS FOR THE PROCS SUB. JSB PROCS PROCESS IT LDA SON CHECK IF A SON FOUND SZA IF SO STA IDPNT SET UP TO PRINT HIM SZA WELL?? JMP PRGN1+1 YES GO DO IT * LDB ALL IF ALL IS 2 THEN CPB D2 DON'T RESET IT LDA B STA ALL CLEAR ALL IF NOT 2 LDB LNAID IF LAST NAME PRINTED WAS NOT SZB,RSS THE ONE WE WERE REPORTING JMP ENDBL (IT WAS SKIP IT) * STB IDPNT AND SET UP TO RUN DOWN THE BLOCK CPA D2 IF ALREADY IN INDEPENDENTS RSS DON'T STEP ALL ISZ ALL ELSE SET THE ALL FLAG DLD BLOCK TELL HIM WHAT WE ARE DOINT JSB PRINT JMP THIS1 * ENDBL EQU * CLA STA PRGFL INITIALIZE THE PROG FLAG LDA NAMST UP DATE THE STA DLKFL THE DEAD LOCK FLAG JMP NOYET AND CONTINUE SCAN * * FINX CLA STA IDCNT START THE SCAN ALL OVER CPA ALL IF ALL READY DONE RSS THEN JMP DOIT,I RETURN FROM THE SUBROUTINE * LDA D2 AND STA ALL SET UP TO PICK UP THE INDEPENDENTS JSB ODTSP OUTPUT A SEPARATION LINE JMP NXSES GO DO IT * * DEAD CMA CHECK IF A TRUE DEAD LOCK ADA DLKFL TRUE IF IN SAME DEPEND LOOP SSA,RSS WELL JMP DEAD2 NO JUST A COLISION * DLD DEMES SEND THE DEAD LOCK MESSAGE JSB PRINT DEAD2 JSB SETPT SEND A WARNING MESSAGE AND LDA .SEAB SET UP THE SEE ABOVE MESSAGE JSB MVBYT MOVE IT IN DEF .SEAB+1 LDA IDPNT GET THE NAME TO REFERENCE JSB MVNAM AND MOVE IT INTO THE MESSAGE CLA STA LNAID CLEAR THE FLAG WORD JSB OUTPT SEND THE LINE TO THE DEVICE LDB ALL IF DOING ALL CPB D2 THEN JMP ENDBL JUST CONTINUE * CLA ELSE CLEAR STA ALL THE FLAG JMP ENDBL AND CONTINUE * * STKNA NOP STACK AN ID SEGMENT ADDRESS LDA IDPNT STA NAMST,I ISZ NAMST PUSH POINTER JMP STKNA,I AND RETURN * * THIS NOP CHECK IF ID IS IN STACK (P+1 IF SO, ELSE P+2) LDA NAMSB GET STACK BASE THISO CPA NAMST END OF STACK? JMP THISX YES ALL OK * LDB A,I NO GET THE ENTRY CPB IDPNT HERE ALREADY? JMP THIS,I YES EXIT * INA NO TRY NEXT ONE JMP THISO * THISX ISZ THIS NOT FOUND EXIT JMP THIS,I * PRGFL NOP SON NOP LNAID NOP ID ADDRESS OF LAST NAME PRINTED XEQT EQU 1717B SESID NOP B10K OCT 10000 DM5 DEC -5 ALL NOP "AL" ASC 1,AL "SM" ASC 1,SM "PA" ASC 1,PA * BLOCK DEF *+2 DEC -15 OCT 0,0 ASC 6,** BLOCK ** INDEP DEF *+2 DEC -6 OCT 0,0 ASC 1,** DEMES DEF *+2 DEC -28 OCT 0,0 ASC 12,*********** DEAD LOCK ** .SEAB DEF *+2 DEC 32 OCT 0,0 ASC 14,*** SEE ABOVE FOR REPORT ON NAMST NOP DLKFL NOP NAMSB DEF *+1 BSS 256 SPC 2 * MAIN ADA D15 VERIFY XLA A,I THAT THIS AND B17 IDSEG(16[4-0])=PROG STATUS CPA D3 IF IN GEN WAIT JMP MAYBE GO TEST FOR "SOME OPTION" * SZA NOT DORMANT ? JMP THISS ACTIVE SO PROCESS IT ! * LDB D17 VERIFY JSB IDWRD THAT THIS ALF,SLA IDSEG(18[12])=TIME LIST INDICATOR JMP THISS PROG IS IN TIME LIST ! * JMP NOYET ELSE GO TRY THE NEXT ONE * MAYBE LDA ALL IF DOING FATHER SON TYPES LDB PARM2 OR IF NOT "SOME OPTION CPB "SM" THEN SZA,RSS GO JMP THISS GO DO IT * JMP NOYET ELSE TRY NEXT ONE * * ********************************************************************** * SUBROUTINE ODTSP * OUTPUTS A LINE CONTAINING ONLY A DOT AND A SPACE ************************************************************************ * ODTSP NOP RETURN ADDRESS JSB SETPT RESET STACK LDA .DTSP DOT & SPACE JSB MVBYT PUSH ON THE STACK DEF D2 JSB OUTPT OUTPUT JMP ODTSP,I RETURN * * D2 DEC 2 D3 DEC 3 D5 DEC 5 D6 DEC 6 D8 DEC 8 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 PARMA NOP DNODE NOP IDCNT NOP IDPNT NOP STATS NOP STACK OCT 0,0 BSS 36 .STAK DEF STACK STKPT NOP .TM. DEF STACK+32 .DNTM DEF STACK+27 .PR. DEF STACK+27 .LAST DEF STACK+37 NDID ASC 9,REMOTE WHZAT NODE .NDID DEF NDID EXW ASC 3,EXECW .EXW DBL EXW ADASH OCT 0,0 UNL REP 36 ASC 1,-- LST .ASTE DEF ADASH * .SPAC DEF *+1 UNL REP 36 ASC 1, LST * .DTSP DEF *+1 UNL REP 20 ASC 1,. LST * .STSP DEF *+1 UNL REP 20 ASC 1,* LST DM4 DEC -4 D7 DEC 7 SPC 4 PROCS NOP JSB SETPT CLEAR THE STACK CLB AND STB SON THE SON FLAG * JSB PSPAC PUSH 2 SPACES JSB PSPAC * * * DISPLAY PROGRAM'S NAME * LDA IDPNT ID SEG A|DDRESS JSB MVNAM MOVE NAME TO OUTPUT STACK CLA STA LNAID CLEAR NAME MOVED FLAG FOR SESSION REPORTS JSB PSPAC PUSH A SPACE * * PUSH THE TYPE TYPE LDB D14 GET PROGRAM TYPE JSB IDWRD AND D7 MASK OFF IDSEG(15[2-0]) STA TYP SAVE IT JSB .ASC1 & STORE THE BYTE LDB D28 LDA TYP GET THE TYPE CPA D1 IS IT MEMORY RESIDENT ? 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 THE SPACE JSB MVBYT PUSH IT DEF D1 * * NOW, PUSH IN THE PRIORITY PRIOR LDB D6 GET PROGRAM PRIORITY JSB IDWRD IN A-REG JSB ZASC5 CONVERT TO ASCII & ADD TO STACK * LDB D20 JSB IDWRD GET (IDWRD+20) LDB .SPAC SSA IF RUNNING UNDER BATCH LDB .B PRINT 'B' LDA B ELSE PRINT SPACE JSB MVBYT PUSH IT DEF D1 * * NOW, PUSH THE PARTITION SIZE LDB D14 JSB IDWRD GET PROG TYPE AND D7 CPA D1 RESIDENT PROGRAM ? RSS JMP PRLNG NO, PROCESS DISK RESIDENT * LDA .RSDT YES,RESIDENT PROGRAM JSB MVBYT PRINT IT IN PARTITION 0 DEF D6 JMP STAT * PRLNG LDB D21 GET CONTENTS JSB IDWRD OF WORD 22 STA NUM STA B AND B77 SSB,RSS WAS PROG ASSIGNED TO PARTITION SZA NO, WAS IT IN ANY PTTN JMP PRPTN YES, ASSIGNED OR IN PTTN * LDB D8 JSB IDWRD , HAS PROG BEEN SUSPENDED BEFORE SZA JMP PRPT YES, THEN PARTITION # 1 IS OK * LDA .SPAC NO,PROGRAM MAY NOT HAVE BEEN LOADED JSB MVBYT DEF D2 JMP PRASG 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 LINE DEF D1 * LDA NUM ALF,RAL GET NUMBER OF PAGES RAL IN PARTITION AND B37 INA ADD 1 FOR BASE PAGE JSB .ASC2 JSB PSPAC SPACE * * STAT EQU * CLA INITIALIZE THE STR VAR.(DEFAULT IS DOTS) STA STR * LDA STATS CALCULATE STATUS COLM. SZA,RSS DORMANT ? JMP M NO DOTS/STARS NECESSARY MPY D3 3 CHAR PER COLUMN SLA IF ODD,SUBTRACT 1 FROM IT ADA M1 STA NUM * LDA STKPT SAVE THE CURRENT STACK POINTER STA PTR * LDA .DTSP FOR OTHERS PUSH DOTS AND SPACES JSB MVBYT DEF NUM # OF BYTES. * LDB STATS IF STATUS ODD,ADD ADDITIONAL SPACE SLB JSB PSPAC PUSH ADDITIONAL SPACE * M LDA STATS CONVERT STATUS TO ASCII JSB .ASC1 & PUSH ONTO STACK * LDA .CMBL PUSH COMMA JSB MVBYT DEF D1 * LDA STATS GET STATUS CPA D2 I/O SUSPEND ? JMP EQT YES, PROCESS EQT # CPA D3 GENERAL WAIT ? JMP WAIT YES. JMP TLIST JUMP TO TLIST TO PROCESS PROG CNT & TIME * TYP NOP EQTPT NOP #EQTS NOP G.RSDT DEF *+1 ASC 3, 0 . .A DEF *+1 ASC 1,AA .B DEF *+1 ASC 1,BB .E DEF *+1 ASC 1,EE D28 DEC 28 D50 DEC 50 DM100 DEC -100 * * STATE 2 - I/O WAIT PROCESSING EQT CLA STA #EQTS SET UP EQT INDEX * EQTLP LDA #EQTS GET EQT INDEX MPY D15 15 WORD EQT ADA EQTA STA EQTPT SAVE THIS EQT7S 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, POINT 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 COUNTER LDA #EQTS ARE WE THROUGH ? CPA EQT# COMPARE WITH BASE PAGE COUNT JMP OSCAR YES, MUST BE OSCAR JMP EQTLP NO GO TO EQT LOOP * OSCAR LDA .EXEC MOVE EXEC ON STACK JSB MVBYT DEF D6 JMP TLIST & CHECK TIME LIST & PROG CNTR * * .EXEC DEF *+1 ASC 3,EXEC B140K ABS 140000B .LPAR DEF *+1 ASC 1,( * .EQ DEF *+1 ASC 2,EQ: .AV DEF *+1 ASC 2,,AV: .CMBL EQU .AV .ST DEF *+1 ASC 2,,ST: B300 ABS 300B B70 ABS 70B * FNDEQ EQU * * FDEQ0 LDA .EQ MOVE EQ: JSB MVBYT DEF D3 * LDA #EQTS CALCULATE EQT# INA JSB .ASC3 CONVERT TO ASCII * FDEQ1 LDA .AV PUSH ',AV:' ON THE STACK JSB MVBYT DEF D4 * LDB EQTPT GET DEVICE LOG STATUS ADB D4 LDA B,I GET THE STATUS WORD STA EQST SAVE IT AND ]B140K MASK OFF LOGICAL STATUS RAL,RAL RIGHT JUSTIFY IN WORD JSB .ASC1 CONVERT TO ASCII & STORE * LDA .ST PUSH ',ST:' ON STACK JSB MVBYT DEF D4 * * NOW, CONVERT THE STATUS WORD INTO THE OCTAL ADDRESS LDA EQST STATUS WORD AND B300 ISOLATE THE STATUS WORD CLB RRR 6 SHIFT IT RIGHT BY 6 JSB .ASC1 PRINT IT * LDA EQST STATUS WORD AND B70 CLB RRR 3 JSB .ASC1 PRINT SECOND OCTAL DIGIT LDA EQST AND D7 CLB JSB .ASC1 PRINT THE THIRD DIGIT * JMP TLIST PROCESS PRG CNT & TIME LIST * DM8 DEC -8 D20 DEC 20 D27 DEC 27 REASN NOP TEST EQU REASN EQST NOP * WAIT EQU * XLB $ELTB GET THE ADDRESS OF THE EQT LOCK TABLE STB .ELTB SAVE IT 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 .ELTB CHECK IF EQT LOCK TABLE FULL JMP LKWT YES, DISPLAY THAT MESSAGE * 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 * JSB TSTWD EQTLOCK <=IDSEG(2)<=[EQTLOCK] .ELTB NOP JMP EQLK * 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 EQU * LDB D15 JSB IDWRD CHECK IF BIT 12 SET ALF,SLA JMP SNID1 SET * CLA STA SON LDA REASN PUSH THE NAME OF THE PROG JSB MVNAM LDA .QUE JMP PUSH8 * SNID1 JSB PSTR PUSH STARS LDA REASN STA SON JSB MVNAM MOVE SON'S NAME ON THE STACK JMP TLIST * SPC 2 .BLIM DEF *+1 ASC 3,BL,EQT00 * BL EQU * LDA .BLIM SET UP BUFFER LIMIT MESSAGE JSB MVBYT DEF D6 LDA TEMP JSB .ASC3 CONVERT EQT# & PUSH JMP TLIST TEMP NOP SPC 2 .QUE DEF *+1 ASC 4,'S QUEUE .RN?? DEF *+1 ASC 4,RESOURCE * * RESOURCE LOCK RESLK EQU * LDA .RN?? PUSH 'RN ??' ONTO STACK JMP PUSH8 SPC 2 .CL?? DEF *+1 ASC 4,CLASS # CLSLK EQU * LDA .CL?? PUSH 'CL ??' ONTO STACK PUSH8 JSB MVBYT PUSH 8 CHARS ONTO STACK DEF D8 JMP TLIST * * EQT LOCK WAIT,NO ENTRY AVAILABLE IN $ELTB LKWT EQU * LDA .EQWT PUSH THE MESSAGE ON THE STACK JSB MVBYT DEF D15 * JMP TLIST * .EQWT DEF *+1 ASC 8,EQLK TABLE FULL * SPC 2 .LU DEF *+1 ASC 2,LU: .DN DEF *+1 ASC 2, DN, * DEVDN EQU * * LDB D2 JSB IDWRD GET LU# FROM SUSPENDED ID STA REASN SAVE IT TEMPORARILY SSA IF NEGATIVE,IT IS THE EQT ADDR OF DOWN DEVICE JMP DVDNE * LDA .LU PUSH ',LU:' ON STACK JSB MVBYT DEF D3 * LDA REASN PUSH THE LOGICAL UNIT NO JSB .ASC3 * LDA .DN PUSH ' DN,' JSB MVBYT bDEF D4 * CCA FIND EQT NO FOR LU ADA REASN ADA DRT LDA A,I AND B77 ADA M1 STA #EQTS * MPY D15 ADA EQTA STA EQTPT SAVE IT IN 'EQTPT' JMP FDEQ0 * DVDNE EQU * CMA,INA STA EQTPT LDA REASN CONVERT EQT ADDR TO EQT # ADA EQTA BY SUBTRACTING EQT BASE ADDR. CMA,INA CLB DIV D15 AND DIVIDING BY 15 INA OFFSET IT BY 1 STA #EQTS SAVE IT * LDA .EQ PUSH EQ: JSB MVBYT DEF D3 * LDA #EQTS EQT NO JSB .ASC3 DISPLAY IT * LDA .DN DISPLAY ' DN,' JSB MVBYT DEF D3 JMP FDEQ1 * 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 EQU * 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 * LDA PTR,I SEARCH FOR LU LOCK,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 D4 LDA CNT PROCESS LU LOCK - FIND ADA @LUMX OWNER'S NAME INA JSB .ASC3 PUT LU# IN MESSAGE JSB PLOCK PUT PROGRAM NAME IN MESSAGE JMP TLIST * * EQT LOCK, PUSH IT ON THE STACK@9 EQLK EQU * XLB REASN,I GET THE EQT NO STB EQNO SAVE IT * XLA $ELTB,I GET THE TABLE LENGTH AND B77K MASK OUT THE MSB ADA REASN POINT TO LOCKER'S ID NO XLA A,I AND B77K ISOLATE THE IDNSEG NO. STA IDNO SAVE IT * PUSH THE MESSAGE EQLK XXX,LKPRG = PROGA ON THE STACK LDA .EQLK JSB MVBYT MOVE THE MESSAGE DEF D4 * LDA EQNO PROCESS EQT NO JSB .ASC3 * LDA .LKPR PUSH ',LKPRG=' JSB MVBYT DEF D7 * GET THE ID ADDRESS & PUSH THE PROG NAME ON THE STACK LDA IDNO JSB MVNAM MOVE NAME * JMP TLIST * .EQLK DEF *+1 ASC 2,EQLK * IDNO BSS 1 EQNO BSS 1 * ************************************************************************* * SUBROUTINE - PSTR PUSHES STARS ON THE STACK(OVERWRITES * THE PREVIOUSLY PUSHED DOTS) ************************************************************************* .STST DEF *+1 ASC 1,** * PSTR NOP LDA PRGFL GET THE PROGINATOR FLAG SZA IF ZERO,IT IS AN ACTUAL PROGINATOR JMP PSTEX OTHERWISE,IT ITSELF WAS A SON JSB SETPT PUSH 2 STARS IN THE BEGINNING OF LINE LDA .STST JSB MVBYT DEF D2 * LDA PTR RESTORE THE OLD VALUE OF STACK POINTER STA STKPT * LDA .STSP PUSH STARS & SPACES JSB MVBYT DEF NUM * JSB PSPAC PUSH ADDITIONAL SPACE AS STATE IS ODD LDA D3 STA STR MAKE STR NON-ZERO FOR SUB PFILL JSB .ASC1 PUSH THE STATE NO ON THE STACK * LDA .CMBL PUSH COMMA JSB MVBYT DEF D1 PSTEX JMP PSTR,I RETURN * STR NOP * 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 PTSSP NOP .CLGT DEF *+1 ASC 3,CL CL# NOP * CLGET EQU * STA CL# LDA .CLGT PUSH "CL " ONTO STACK JSB MVBYT DEF D4 LDA CL# JSB ZASC3 JMP TLIST * * TLIST EQU * JSB PSPAC PUSH A SPACE LDA .PR. PROGRAM COUNTER'S LOCATION CLE,ELA CONVERT TO BYTES CMA,INA MAKE IT NEGATIVE ADA STKPT COMPUTE STKPT-PR CMA,INA COMPUTE # OF DOTS OR STARS TO BE PUT IN SSA,RSS MORE THAN WE CAN FIT IN JMP NXTM2 YES,WE ARE OK. * NO, WE CAN NOT PUT PROGRAM COUNTER IN THIS LINE,GOTO NEXT JSB OUTPT PRINT THIS LINE FIRST JSB SETPT INITIALIZE THE STACK POINTER LDA .SPAC JSB MVBYT PUT SPACES IN THE NEXT LINE DEF D50 JMP NXTM3 NXTM2 JSB PFILL PUSH STARS/DOTS DEPENDING UPON THE CASE NXTM3 LDA .P PUSH P: JSB MVBYT DEF D2 * NOW GET THE POINT OF SUSPENSION FROM ID SEGMENT LDB D8 GET POINT OF SUSPENSION JSB IDWRD RAL STA PTSSP POINT OF SUSPENSION * LDB DM5 LOOP COUNT STB CNT NXLLP LDA PTSSP LOOP,GET POINT OF SUSPENSION ALF ROTATE LEFT 4 TIMES RAR EFFECTIVELY ROTATE LEFT 3 TIMES STA PTSSP SAVE IT AND D7 ISOLATE THE DIGIT JSB .ASC1 DISPLAY THE OCTAL DIGIT ISZ CNT INCREMENT THE LOOP COUNT JMP NXLLP DISPLAY THE NEXT DIGIT * * NOW DETERMINE IF THE PROGRAM SWAPPED OUT * IF SO,PUSH SWP O/N THE STACK LDA .SPAC LDB TYP GET TYPE OF THE PROGRAM CPB D1 JMP NXTM4 * LDB D27 JSB IDWRD GET THE SWAP TRACK ADDRESS AND B77K LDB A B GETS CONTENTS OF A-REG LDA .SPAC SZB,RSS IF ZERO, NOT SWAPPED OUT JMP NXTM4 * LDA .SWP PUSH, SWP ON THE STACK NXTM4 JSB MVBYT DEF D3 * LDB D17 TIME LIST INDICATOR JSB IDWRD ALF,SLA SET ? JMP NXTM5 JMP DUMP NO, DUMP THE CURRENT LINE NXTM5 EQU * * NXTM6 LDA IDPNT ADA D18 JSB CNVTM CONVERT TIME * DUMP JSB OUTPT DISPLAY THE CURRENT LINE JMP PROCS,I * SPC 2 FINIS JSB DASHS * DNDEV JSB SETPT RESET STACK FOR DOWN LU'S. CLA INITIALIZE NOOUT STA NOOUT 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. * ISZ NOOUT INCREMENT THE COUNT 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.3 JMP DNLU1 ELSE CONTINUE. LDA NOOUT FETCH THE COUNT OF DOWN LU'S SZA ZERO ? JMP NXTLO NO, PRINT THE LINE JSB SETPT YES, DISPLAY THE MESSAGE 'ALL LU'S OK' LDA .LUOK JSB MVBYT DEF D12 * NXTLO JSB OUTPT PRINT STACK. * JSB SETPT RESET STACK FOR DOWN EQTS CLA INITIALIZE THE COUNT OF DOWN EQT STA NOOUT * 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 & MASK CPA D1 IS IT DOWN RSS YES-PROCESS JMP NXTDV NO-NEXT EQT * ISZ NOOUT INCREMENT THE COUNT 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 LDA NOOUT FETCH THE COUNT OF DOWN EQT'S SZA ZERO ? JMP DONE NO, PRINT THE LINE AS IT IS JSB SETPT INITIALIZE THE POINTER LDA .EQOK MESSAGE 'ALL EQT'S OK' JSB MVBYT DEF D12 SPC 2 DONE JSB OUTPT PRINT STACK DONE1 EQU *  JSB LOCLU DISPLAY ALL LOCKED LU'S JSB LOCEQ DISPLAY ALL LOCKED EQT'S JSB CMTRK COMPUTE FREE TRACKS AVAILABLE JSB COMSM DISPLAY SAM RELATED INFO IF NEED BE DONE2 JSB DASHS * EXIT JSB TOD FINALLY TIME OF DAY LDA .EOF ANOTHER BLANK LINE LDB DM6 JSB PRINT SPC 2 LDA XEQT CHECK IF I AM IN TIME LIST ADA D17 XLA A,I GET THE WORD ALF,SLA WELL?? LDA PARM2 YES USE CURRENT PRAM2 STA PARM2 NO RESET PARM2 JSB EXEC I AM SERIALLY REUSABLE DEF RSTRT DEF D6 DEF ZERO DEF M1 DEF ZERO DEF PARM2 DEF #NODE DEF ZERO 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 .EQOK DEF *+1 ASC 6,ALL EQT'S OK .LUOK DEF *+1 ASC 6,ALL LU'S OK .SWP DEF *+1 ASC 2,SWP .P DEF *+1 ASC 1,P: D9 DEC 9 * .EOF DEF *+1 OCT 0,0,20040 .HEAD DEF *+1 OCT 0,0 ASC 11, PRGRM T PRIOR PT SZ ASC 10,DO.SC.IO.WT.ME.DS.OP ASC 10,. .PRG CNTR. . ASC 5,NEXT TIME. SKP SPC 2 FROM BSS 2 TO EQU FROM+1 B377 OCT 377 B7K OCT 7777 B77K OCT 77777 SPC 2 * ************************************************************************* * SUBROUTINE PFILL PUSHES EITHER THE STARS OR DOTS ON THE STACK * DEPENDING ON THE CASE(STR NONZERO OR ZERO) * ARG: A-REG CONTAINS NO OF PLACES TO BE FILLED IN ************************************************************************* * PFILL NOP SZA,RSS IF ZERO,EXIT JMP PFLEX YES STA NUM SAVE NO OF SPACES TO BE FILLED IN LDA STKPT CHECK IF STKPT ODD OR EVEN SLA,RSS Q IF ODD ,IT IS POINTING TO ODD COLM JMP PFL1 THE STARS/DOTS START AT EVEN COLM JSB PSPAC PUSH ADDITIONAL SPACE TO MAKE IT EVEN LDA NUM ADA M1 NUM = NUM-1 SZA,RSS IF ZERO,FORGET IT JMP PFLEX YES STA NUM PFL1 LDA .DTSP PICK APPROPRIATE TEXT DEPENDING ON STR LDB STR SZB LDA .STSP TAKE STARS AS STR NON ZERO JSB MVBYT DEF NUM * PFLEX JMP PFILL,I RETURN 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 NOP STB STKPT JMP MVBYT,I SPC 2 SPC 2 PSPAC NOP LDA .SPAC PUSH A SPACE JSB MVBYT DEF D1 JMP PSPAC,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 DASHS NOP LDA .ASTE LDB DM76 JSB PRINT JMP DASHS,I * DM76 DEC -76 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 AND B77K MASK OUT THE MSB ADMA 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 STA LNAID SAVE LAST ID NAME USED 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 DEXEC DEF *+1+5 DEF DNODE DEF D2 DEF CRTLU .BUFF DEF STACK DEF CNT JMP PRINT,I * * PGID NOP JSB SETPT SET STACK POINTER LDA .NDID MOVE PROGRAM ID JSB MVBYT STRING TO STACK DEF D18 LDA #NODE GET LOCAL NODE NUMBER JSB .ASC2 CONVERT TO ASCII & ADD TO STACK JSB OUTPT JMP PGID,I AND RETURN * 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 NOP 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 * * PANOD NOP LDB XEQT GET ADDR OF PROG'S ID SEG ADB D20 PA'S ID SEG #= SON'S IDSEG(WRD 21) XLA B,I GET PA'S SEG # AND B377 AND ISOLATE IT SZA,RSS IF ZERO, WE ARE LOCAL JMP LOCAL ADA M1 ELSE,SET INDEX INTO IDSEGS ADA KEYWD ADD TO KEYWD TO GET PROPER IDSEG XLA A,I ADA D12 PA'S NAME= PA'S IDSEG(WRD 13-15) LDB D3 SET UP X REG FOR X MOVE CBX LDB .PAW GET ADDRESS OF LOCAL STORAGE MWF AND MOVE PA'S NAME INTO PROGRAM LDB .PAB GET BYTE ADDR. OF LOCAL STORAGE LDA .EXW AND OF EXEC CBT D5 STRINGS (NAMES) THE SAME ? JMP NTLOC YES-- NOT A LOCAL CALL NOP LOCAL LDA #NODE DEST NODE # = #NODE JMP PANOD,I NTLOC LDA #CNOD DEST NODE # = #CNOD JMP PANOD,I * .PAW DEF WORD1 .PAB DEF WORD1 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 WANTEcD? 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 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 D32 EQU B40 B60 OCT 60 SKP WHATP LDA .PHED LDB DM38 JSB PRINT PRINT HEADING FOR PARTITION STUFF JSB DASHS '----------' * CLA,INA STA PTN# INIT PARTITION NUMBER CLA SET STA UFLAG NO. UNDEFINED TO ZERO 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 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 ISZ UFLAG STEP UNDEFINED FLAG JMP DMP0 GO STEP THE PT. NO. * * CKPTN JSB FLUSU FLUSE UNDEFINED IF ANY JSB SETPT SET UP THE NEW LINE LDA PTN# JSB .ASC2 PUT PART. NO. ON LINE 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# i 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 .RT ' 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 DMP0 ISZ PTN# INCRE PARTITION # LDA PTNAD ADA D7 INCRE TO NEXT PARTITION ADDR STA PTNAD CPA LPTAD DONE YET? RSS YES. PRINT TIME, EXIT JMP NXPTN NO. DO NEXT PARTITION * JSB FLUSU FLUSH FINAL UNDEFS IF ANY JMP DONE2 AND GO EXIT * NOPRG LDA .NONE JSB MVBYT DEF D6 JMP DMPTN SPC 2 PTNWD NOP ADB PTNAD XLA B,I JMP PTNWD,I * * FLUSU NOP ROUTINE TO PUT OUT LINE FOR UNDEFINED PART. LDA UFLAG ARE THERE ANY? SZA,RSS WELL? JMP FLUSU,I NO JUST RETURN * JSB SETPT YES START A LINE LDA UFLAG CACULATE THE FIRST PT. NO. CMA,INA FROM COUNT AND CURRENT #. ADA PTN# THERE JSB .ASC2 SEND IT OUT LDA UFLAG CHECK IF MORE THAN 1 CPA D1 WELL JMP ONLY1 NO JUST ONE * LDA .MINU ELSE SEND RANGE '-' JSB MVBYT TO THE LINE DEF D1 CCA NOW GET THE LAST NUMBER ADA PTN# AND SEND IT JSB .ASC2 TO THE LINE ONLY1 LDA .UNDF SEND THE UNDEF LINE JSB MVBYT DEF D14 CLA STA UFLAG JSB OUTPT SEND THE LINE JMP FLUSU,I ALL DONE EXIT r)SPC 2 .PHED DEF *+1 OCT 0,0 ASC 17,PTN# SIZE PAGES BG/RT PRGRM * .MINU DEF *+1 ASC 1,-- UFLAG NOP .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 * * ************************************************************************* * * SUBROUTINE - LOCEQ * SUBROUTINE TO PRINT THE LOCKED EQTS * * IF NO EQT IS LOCKED,IT DOES NOT PRINT ANYTHING.THE SUBROUTINE * ACCESSES A TABLE ($ELTB) IN TABLE AREA II.IF THE MOST SIGNIFICANT * BIT OF THE FIRST WORD OF THIS TABLE SET,THE TABLE HAS ATLEAST * ONE ENTRY,OTHERWISE THE TABLE IS EMPTY. * * DATE : 6/25/79 DB ************************************************************************* * * LOCEQ NOP RETURN ADDRESS XLB $ELTB GET THE ADDRESS LDA B,I GET THE FIRST WORD OF THE TABLE. SSA,RSS IF M.S.B. NOT SET,SKIP THE SUBROUTINE. JMP LCEEX YES,EXIT * * THE TABLE HAS ATLEST ONE NON-ZERO ENTRY.BUT WE HAVE TO BE CAREFULL * BECAUSE BY THE TIME WE PICK UP THE ENTREE, THE ENTREES MIGHT * BECOME ZERO(BECAUSE OF INTERRUPT).THEREFORE, IF ALL THE ENTRIES * ARE ZEROS, NO MESSAGE IS PRINTED. * JSB SETPT RESET THE STACK LDA .LKEQ LOCKED EQT MESSAGE. JSB MVBYT MOVE THE MESSAGE ON THE STACK DEF D24 * XLB $ELTB GET THE TABLE ADDRESS AGAIN XLA B,I GET THE FIRST WORD AND B77K  A-REG CONTAINS THE NO OF ENTRIES. STA LENTH SAVE IT * ADA B CREATE THE LAST POINTER INA STA TBLST SAVE IT AS THE LAST POINTER INB B-REG POINTS TO FIRST EQT NO STB TBPTR STORE IT AS A TABLE POINTER * LCLP0 CLA STA NOOUT INITIALIZE THE 'NOOUT' * * LCLP1 LDB TBPTR PICK UP THE POINTER CPB TBLST COMPARE IT AGAINST THE LAST POINTER JMP LOCN2 YES, SKIP * LDB NOOUT NUMBER OF LOCKED EQT OUTPUT IN THIS LINE CPB D4 IS IT ONLY 4 (ALLOWS 4 PER LINE) JMP LOCN3 YES * XLA TBPTR,I GET THE EQT SZA,RSS IF ZERO, NOT A VALID ENTRY JMP LOCN1 YES, GET THE NEXT ENTREE ISZ NOOUT MAKE IT NON ZERO AS ATLEAST 1 LOCKED EQT JSB .ASC3 CONVERT TO ASCHII * LDA .LPAR PUSH LEFT PARENTHESIS JSB MVBYT MOVE BYTES DEF D1 * * NOW DETERMINE THE PROGRAM'S NAME & PUSH IT ON THE STACK. LDB TBPTR PICK UP THE POINTER ADB LENTH POINT TO ID-ADDRESS XLA B,I GET THE ID-ADDRESS AND B77K MASK OUT THE M.S.B JSB MVNAM MOVE THE NAME ON THE STACK * LDA .RPAR PUSH RIGHT PARANTHESIS,COMMA & SPACE JSB MVBYT MOVE THE BYTES DEF D2 * LOCN1 ISZ TBPTR BUMP THE POINTER JMP LCLP1 CONTINUE THE LOOP * * TABLE PROCESSED COMPLETELY,FLUSH THE MESSAGE OUT. LOCN2 LDA NOOUT ARE ALL ZEROS ? SZA JSB OUTPT DISPLAY THE LINE LCEEX JMP LOCEQ,I EXIT * * ONE LINE FULL,GO TO THE NEXT LINE LOCN3 JSB OUTPT OUTPUT THE LINE JSB SETPT G INITIALIZE THE STACK POINTER LDA .SPAC NEXT LINE WITH SPACES JSB MVBYT MOVE THE SPACES DEF D24 JMP LCLP0 GO & PROCESS MORE * * D26 DEC 26 * * ************************************************************************** * * SUBROUTINE - LOCLU * IT PRINTS THE LOCKED LU'S. * THE SUBROUTINE SEARCHES THE DRT TABLE,PICKS OUT THE RESOURCE * NO & FROM THE RESOURCE TABLE, PICKS OUT THE LOCKER'S ID-SEGMENT * NO. THEN THE CORRESPONDING NAME IS DISPLAYED * THE MESSAGE IS: * LOCKED LU'S(PROG NAME) XXX(PROGA),XXX(PROGB) * * IF NONE OF THE LU'S ARE LOCKED,NO MESSAGE IS DISPLAYED. * ************************************************************************ * RNTB DEF $RNTB+0 LOCLU NOP RETURN ADDRESS JSB SETPT RESET THE STACK LDA .LKLU PUSH THE TITLE 'LOCKED LU'S' JSB MVBYT DEF D24 * LDA @DRT GET THE DRT ADDRESS STA TBPTR SAVE IT AS THE TABLE POINTER * LDA @LUMX GET MAX # OF LU'S CMA,INA SAVE NEGATIVE OF THAT STA CNT1 * LULP0 CLA INITIALIZE THE 'NOOUT' STA NOOUT * LULP1 EQU * LDB NOOUT NUMBER CPB D4 ALLOW 4 PER LINE JMP LUCN3 YES,PRINT NEW LINE * XLA TBPTR,I GET THE WORD FROM THE DRT TABLE RRR 6 AND B37 ISOLATE THE RESOURCE NO SZA,RSS IF ZERO,IT IS NOT LOCKED JMP LUCN1 YES, PICK THE NEXT ONE * * LOOK INTO THE RNTB TO MAKE SURE THAT THE ENTREE IS VALID ADA RNTB POINT TO THE RESOURCE NO ENTREE XLA A,I GET THE ENTREE AND B377 ISOLATE THE LOCKER'S ID SEG NO SZA,RSS IF IT IS ZERO,IT IS NOT OWNED. JMP LUCN1 YES,LOOK INTO THE NEXT ENTREE STA IDNO1 SAVE IT ISZ NOOUT * * NOW PUSH THE LU NO & THE CORRESPONDING PROGRAM NAME. * LDA CNT1 ADA @LUMX LU NO : @LUMX-CNT INA JSB .ASC3 CONVERT TO ASCHII & PUSH IT ON STACK * LDA .LPAR PUSH LEFT PARENTHESIS JSB MVBYT DEF D1 * LDA IDNO1 GET THE IDNO CPA B377 IS IT GLOBAL JMP LUGLB YES ADA M1 CREATE A POINTER IN KEYWORD BLOCK ADA KEYWD XLA A,I GET THE ID-NUMBER JSB MVNAM MOVE THE NAME ON THE STACK JMP LUCN0 * LUGLB LDA .GLBL GLOBAL JSB MVBYT MOVE THE WORD 'GLOBAL' DEF D5 * LUCN0 LDA .RPAR PUSH RIGHT PARENTHESIS,COMMA & SPACE JSB MVBYT DEF D2 * LUCN1 ISZ TBPTR INCREMENT THE TABLE POINTER ISZ CNT1 INCREMENT THE -VE COUNT JMP LULP1 CONTINUE * * TABLE PROCESSED COMPLETELY,FLUSH THE MESSAGE OUT LDA NOOUT CHECK IF IT IS ZERO SZA IF ZERO,THIS LINE NOT TO BE OUTPUT JSB OUTPT OUTPUT THE LINE LCLEX JMP LOCLU,I RETURN FROM THE SUBROUTINE * * THIS LINE OF DISPLAY FULL, GO TO NEXT LINE LUCN3 JSB OUTPT OUTPUT THIS LINE JSB SETPT INITIALIZE THE STACK POINTER AGAIN LDA .SPAC NEXT LINE WITH SPACES JSB MVBYT MOVE THE SPACES DEF D24 JMP LULP0 JUMP BACK. * .RPAR DEF *+1 ASC 2,), * .LKEQ DEF *+1 ASC 12,LOCKED EQT'S (PROG NAME) * * .LKLU DEF *+1 ASC 12,LOCKED LU'S (PROG NAME) TBPTR BSS 1 TABLE POINTER LENTH BSS 1 LENGTH OF THE ENTRIES NOOUT BSS 1 TBLST BSS 1 CNT1 BSS 1 IDNO1 BSS 1 * * ***************************************************************************** * * SUBROUTINE - CMTRK * * SUBROUTINE TO COMPUTE TOTAL NO OF ?CONTIGOUS FREE TRACKS * AVAILABLE ON EITHER LU2 (SYSTEM DISK) OR LU3 (AUX. DISK). * ***************************************************************************** * TAT EQU 1656B TATSD EQU 1756B TATLG EQU 1755B * CMTRK NOP RETURN ADDRESS JSB SETPT INITIALIZE THE STACK POINTER LDA .FRTR FREE TRACKS MESSAGE JSB MVBYT PUSH IT ON THE STACK DEF D24 * * COMPUTE MAX. NO OF FREE TRKS ON SYSTEM DISK. * LDA TAT GET THE TRACK ASSIGNMENT TABLE ADDRESS LDB TATSD NO OF TRACKS ON THE SYSTEM DISK. JSB COMPT COMPUTE NO OF FREE CONTIGOUS TRACKS AVAILABLE STA MAXL2 RESULT IN A-REG.(SAVE IT) * * NOW DO THE SAME FOR THE AUXILIARY DISK (LU 3) * LDA TAT TRACK ASSIGNMENT TABLE ADDRESS ADA TATSD CREATE POINTER (EQ TO TAT+TATSD) LDB TATSD NO OF TRACKS ON AUX DISK = TATLG-TATSD ADB TATLG COMPUTE TATSD-TATLG CMB,INB NEGATE IT SZB,RSS IF AUX NOT DEFINED, FORGET IT JMP CM1 JSB COMPT COMPUTE FREE TRACKS ON AUX DISK STA MAXL3 SAVE IT * * CHECK WHICH IS GREATER CMA,INA -MAXL3 ADA MAXL2 COMPUTE MAXL2-MAXL3 SSA,SZA JMP CM2 MAXL3 .GT. MAXL2 CM1 LDA MAXL2 MAXL2 .GT. MAXL3 LDB D2 LOGICAL UNIT NO JMP CM3 * CM2 LDA MAXL3 MAXL3 .GT. MAXL2 LDB D3 CM3 STB LUNO SAVE LOGICAL NO JSB .ASC3 PUSH THE NO OF TRACKS ON THE STACK * LDA .LU1 PUSH 'LU' ON THE STACK JSB MVBYT DEF D6 * LDA LUNO PUSH LOGICAL UNIT NO JSB .ASC3 ON THE STACK JSB OUTPT OUTPUT THE LINE JMP CMTRK,I RETURN * * MAXL2 NOP MAXL3 NOP D24 DEC 24 .LU1 DEF *+1 ASC =3,, LU * .FRTR DEF *+1 ASC 12,MAX CONT. FREE TRKS : * ************************************************************************* * SUBROUTINE - COMSM * COMPUTES THE MAX CONTIGOUS SAM,TOTAL SAM & * LARGEST SAM EVER AVAILABLE AT THE INSTANT OF TIME ************************************************************************* * SUSP3 EQU 01714B EXT $PNTI,$MAXI EXT $LIBR,$LIBX * COMSM NOP RETURN ADDRESS LDA SUSP3 CHECK THE MEMORY SUSPEND LIST SZA,RSS IF NO PROG MEM SUSPENDED,SKIP IT JMP SMEX * CLA CAX X-REG ACTS AS ACCUMULATOR FOR TATAL SAM CLB B- REG WOULD CONTAIN THE MAX CONT. SAM AVAIL XLA $PNTI,I GET THE SAM FREE LIST HEADER STA PNTR STORE IT LOCALLY * **************GO PRIVILEGED FROM HERE * JSB $LIBR NOP * CMM1 XLA PNTR,I PICK # OF FREE WORDS ADX A ADD TO ACCUMULATOR * ADA B COMPUTE (A-B):B-REG IS NEGATIVE SSA SKIP IF (A).GT.(B) JMP CMM2 NO,(A).LT.(B),B THEN REMAINS UNCHANGED CMA,INA MAKE IT -(A-B) ADB A B-REG = -B+[-(A-B)]=-A<=>MAX SAM SO FAR CMM2 ISZ PNTR BUMP THE POINTER XLA PNTR,I GET THE ADDRESS OF NEXT FREE BLOCK CPA B77K END OF LIST ? JMP SMEXT YES,PRINT THE STUFF & BUZZ 0FF STA PNTR UPDATE THE POINTER JMP CMM1 CONTINUE IN THE LOOP * ***************GO UNPRIVILEGED HERE * SMEXT JSB $LIBX DEF *+1 DEF *+1 * * X-REG CONTAINS TOTAL SAM AVAIL:B-REG CONTAINS -VE OF MAX * CONT. SAM AVAILABLE. * CMB,INB MAKE IT +VE STB MAXSM STX TOTSM SAVE B & X REGS * JSB SETPT INITIALIZE STACK POINTER LDA .MXSM JSB MVBYT PUSH TITLE ON THE STACK DEF D24 * LDA MAXSM PUSH MAXL SAM JSB .ASC5 * LDA .WRD PUSH 'WORDS' JSB MVBYT DEF D8 * JSB OUTPT FLUSH THE MESSAGE * JSB SETPT INITIALIZE THE STACK AGAIN LDA .TOSM PUSH THE TITLE FOR TOTAL SAM JSB MVBYT DEF D24 * LDA TOTSM JSB .ASC5 * LDA .WRD JSB MVBYT PUSH WORDS DEF D8 * JSB OUTPT FLUSH THE MESSAGE OUT * JSB SETPT INITIALIZE THE STACK POINTER AGAIN LDA .LRSM JSB MVBYT 'LARGEST SAM EVER AVAILABLE' DEF D28 * XLA $MAXI,I CMA,INA JSB .ASC5 * LDA .WRD JSB MVBYT DEF D8 * JSB OUTPT * SMEX JMP COMSM,I RETURN PNTR NOP MAXSM NOP TOTSM NOP .MXSM DEF *+1 ASC 12,MAX CONT. SAM AVAIL : .TOSM DEF *+1 ASC 12,TOTAL SAM AVAILABLE : .LRSM DEF *+1 ASC 14,MAX CONT. SAM EVER AVAIL : * * .WRD DEF *+1 ASC 4, WORDS * * * ************************************************************************* * * SUBROUTINE - COMPT * SUBROUTINE TO COMPUTE THE MAX NO OF CONTIGOUS FREE TRACKS * * ARGUMENTS: A-REG : ADDRESS FROM WHERE THE SEARCH TO BEGIN IN TAT * B-REG : TOTAL NO OF TRACKS ON THE DISK * * RESULT PASSED BACK IN A-REG * ************************************************************************* * COMPT NOP RETURN ADDRESS ADA M1 OFFSET THE BEGINNING SEARCH ADDRESS BY 1 STA BGADR SAVE THE BEGINNING SEARCH ADDRESS CMB,INB SAVE NEGATIVE OF TOTAL NO OF TRACKS AVAILABLE INB OFFSET IT BY 1(FOR LOOP END CHECK) STB TKCNT * CLA INITIALIZE VAR 'MAXTK' STA MAXTK * CMLP0 CLB B-REG WOULD HAVE NO OF FREE TRKS IN A LOOP CMLP1 ISZ BGADR INCREMENT BEGINNING ADDRESS ISZ TKCNT SEARCHING DONE ? JMP CM4  JMP CMEXT YES,EXIT CM4 XLA BGADR,I GET THE ENTREE FROM THE TRACK ASSIGN TABLE SZA JMP CM5 NON ZERO, COMPUTE IF .GT. THE PREVIOUS ONE INB INCREMENT B-REG. JMP CMLP1 FIND MORE * CM5 STB TEMP1 SAVE IT TEMPORARILY CMB,INB NEGATIVE OF FREE TRACKS FOUND ADB MAXTK MAXTK-FREE TRACKS FOUND SSB,RSS JMP CMLP0 OK,MAXTK .GT. FREE TRACKS FOUND LDB TEMP1 MAXTK = FREE TRACKS FOUND IN THIS LOOP STB MAXTK JMP CMLP0 * CMEXT LDA MAXTK PICK UP THE MAX FREE TRACKS FOUND JMP COMPT,I RETURN * MAXTK BSS 1 TEMP1 BSS 1 BGADR BSS 1 TKCNT BSS 1 LUNO BSS 1 * UNS END WHAT 7 % 91750-18218 2013 S C0122 &#OFF +              H0101 5ASMB,Q,C NAM #OFF,7 91750-1X218 REV.2013 800418 MEF HED <#OFF> OFF PROGRAM SUBROUTINE *(C) HEWLETT-PACKARD CO. 1980* ENT #OFF EXT EXEC,.ENTR SUP * NAME: #OFF * SOURCE: 91750-18218 * RELOC: 91750-1X218 * PGMR: D.W.T. [ 04/14/80 ] * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * #OFF TERMINATES A PROGRAM. * * #OFF CALLING SEQUENCE: * * JSB #OFF * DEF *+2 * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * SKP NAME NOP ASCII NAME ADDR. #OFF NOP ENTRY/EXIT JSB .ENTR OTBAIN DIRECT ADDRESSES DEF NAME DEFINE PARAMETER STORAGE AREA. JSB EXEC CALL EXEC TO DO THE FUNCTION DEF *+3 DEF K6N DEF NAME,I NOP IGNORE ERROR RETURN JMP #OFF,I RETURN * K6N OCT 100006 END M  91750-18219 2013 S C0122 &#OFF              H0101 *ASMB,Q,C HED <#OFF> OFF PROGRAM SUBROUTINE *(C) HEWLETT-PACKARD CO. 1980* NAM #OFF,7 91750-1X219 REV.2013 800418 L EXT .ENTR,MESSS ENT #OFF * NAME: #OFF * SOURCE: 91750-18219 * RELOC: 91750-1X219 * PGMR: D.W.T. [ 04/14/80 ] * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * #OFF TERMINATES A PROGRAM * * #OFF CALLING SEQUENCE: * * JSB #OFF * DEF *+2 * DEF NAME ADDRESS OF 3-WORD ASCII PROGRAM NAME ARRAY. * SKP SUP [SUPPRESS EXTENDED LISTING] NAME NOP ASCII NAME ADDR. #OFF NOP JSB .ENTR OBTAIN DIRECT ADDRESSES. DEF NAME DEFINE PARAMETER STORAGE AREA. DLD "OF GET "OF, " DST MBUF STORE IT IN MESSAGE BUFFER LDA NAME,I GET PASSED PROGRAM NAME STA MBUF+2 ISZ NAME UP ADDR DLD NAME,I DST MBUF+3 DLD "FL GET ",FL " DST MBUF+5 JSB MESSS CALL MESSAGE PROCESSOR TO TERMINATE PROG DEF *+3 DEF MBUF DEF K13 JMP #OFF,I RETURN * MBUF BSS 7 "OF ASC 2,OF, "FL ASC 2,,FL K13 DEC 13 END   91750-18221 2013 S C0122 &#SPLU +              H0101 uASMB,R,L,N IFN NAM #SPLU,15 91750-16221 REV 2013 800115 (IV,L LU MAPPING) XIF IFZ NAM #SPLU,0 91750-16222 REV 2013 800115 (M LU MAPPING) XIF * * ******************************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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: #SPLU * SOURCE: 91750-18203 * RELOC: 91750-16203 * PGMR: JOHN LAMPING * * WRITTEN BY JOHN LAMPING [OCTOBER 1979] * * N OPTION FOR RTE-IV'S AND RTE-L'S WITH LU MAPPING * Z OPTION FOR RTE-MII'S AND RTE-MIII'S WITH LU MAPPING * ENT #SPLU #SPLU NOP RESERVED LU END 7  91750-18223 2013 S C0122 &APLDX +              H0101 {ASMB,Q,C HED APLDX: MINI-APLDR FOR RTE-L *(C) HEWLETT-PACKARD CO. 1980* NAM APLDX,19,30 91750-16223 REV 2013 800625 (MEMORY-BASED L) * SPC 1 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME: APLDX * SOURCE: 91750-18223 * RELOC: 91750-16223 * PGMR: L. WEIMAN [6/6/80] * * IS THE DS/1000 MONITOR WHOSE FUNCTION IS TO PROCESS ALL * PROGRAM "LOAD" REQUESTS, EFFECTIVELY PROVIDING AN "RP," FUNCTION, * WHERE THE PROGRAM FILE EXISTS AT SOME REMOTE. THE MASTER REQUESTS ARE * ORIGINATED BY A USER RUNNING PROGRAM "RPRTL". THIS PROGRAM ONLY HANDLES * THE SLAVE SIDE OF ITS REQUESTS. SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & L@EVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * * GLBLK-END SKP * APBLK-START * ****************************************************************** * * * A P L D X G L O B A L B L O C K REV 2013 800611* * * * GLOBAL OFFSETS FOR APLDX MESSAGE BUFFERS, USED BY * * * * RPRTL APLDX * ****************************************************************** * * * DEFINE APLDX REQUEST BUFFER * #FCOD EQU #MHD FUNCTION CODE #ERCD EQU #FCOD ERROR-RETURN CODE #P1 EQU #ERCD+1 #P2 EQU #ERCD+2 #P3 EQU #ERCD+3 #P4 EQU #ERCD+4 #P5 EQU #ERCD+5 #P6 EQU #ERCD+6 #P7 EQU #ERCD+7 #P8 EQU #ERCD+8 #P9 EQU #ERCD+9 #P10 EQU #ERfRCD+10 #P11 EQU #ERCD+11 #P12 EQU #ERCD+12 #ADR EQU #P1 * ***************************************************** * * * APBLK-END SKP * REQUEST FORMAT: * * +--------------------------------------------+ * ! STREAM=11 ! * ! STD BEGINNING FORMAT FOR ALL ! * ! DS 1000 MSGS ! * ! ! * #MHD! ID ! FUNCTION CODE (8 BITS) ! * ! P1 ! * ! P2 ! * ! P3 ! * ! P4 ! * ! P5 ! * ! P6 ! * ! P7 ! * ! P8 ! * ! P9 ! * ! P10 ! * ! P11 ! * ! P12 ! * +--------------------------------------------+ SPC 2 * UNLESS OTHERWISE SPECIFIED, NO DATA BUFFERS ARE USED. * * FUNCTION CODES: * 0 = ID SEGMENT (IN DATA BUFFER) * ID = 31 TO IDENTIFY 'FATHER' AS RPRTL * * (SLAVE RETURNS MEMORY ADDRESS OF PROGRAM IN REPLY P1) * * 1 = PROGRAM CODE DATA * P1 = ADDRESS * DATA BUFFER CONTAINS 1 TO 128 DATA WORDS, TO BE LOADED * INTO MEMORY. * * 2 = PROGRAM BASE PAGE CODE * P1 = ADDRESS * DATA BUFFER CONTAINS 1 TO 128 DATA WORDS, TO BE LOADED * INTO MEMORY * * 3 = SHORT ID SEGMENTS/END * P1,P2,P3 = FILE NAME * P4 = FILE SECURITY CODE * P5 = FILE CARTRIDGE REFERENCE NUMBER * P6 = MASTER NODE # * P7 = NUMBER OF SHORT ID SEGMENTS (NEGATIVE) *  P8 = LOW MAIN * P9 = HIGH MAIN+1 * P10 = LOW BASE PAGE ADDRESS * P11 = HIGH BASE PAGE ADDRESS+1 * P12 = ID SEGMENT ADDRESS * * 4 = MASTER IS ABORTING. CLEAR ID SEGMENT, ADDRESS SUPPLIED * IN P1 * * P1 = ADDRESS OF ID SEGMENT TO BE CLEARING SKP * REPLY FORMAT * +--------------------------------------------+ * !01 STREAM ! * + STANDARD BEGINNING FORMAT FOR ALL DS 1000 + * + MSGS + * + + *#MHD + ERROR CODE + * + P1 + * + P2 + * + P3 + * + + * +--------------------------------------------+ * * ERROR CODES: * 0 = NO ERROR. ON FUNCTION CODE 0 RQSTS, RTE-L MEMORY ADDRESS * WHERE SLAVE IS PLACING ID SEGMENT IS RETURNED IN P1. * * 1=UNRECOGNIZED FUNCTION CODE (SERIOUS INTERNAL ERROR. SEE HP REP) * * 2=DUPLICATE PROGRAM NAME. A PROGRAM ALREADY EXISTS BY THE SAME * NAME. * * 3=NO BLANK ID SEGMENTS * * 4=PROGRAM CONFLICT. NAME OF PROGRAM OCCUPYING SAME MEMORY SPACE * AS THE ONE YOU WANTED RETURNED IN P1-P3 * * 5=PROGRAM NOT RELOCATED WITH CORRECT SNAPSHOT FILE: CHECKSUM * IN FILE DOES NOT MATCH SYSTEM CHECKSUM AT RTE-L. * * 6=ILLEGAL BG LOAD ATTEMPT: ATTEMPT TO LOAD PROGRAM IN BACKGROUND, * BUT LOAD/SWAP MODULES INCLUDED IN RTE-L GEN. SPC 2 SKP EXT #GET,#SLAV,.MVW,#RPB EXT $CKSM,$.LOA,$FWBG,$ID#,$IDA,$BGBP EXT $LIBR,$LIBX,IDSGA,IDMEM A EQU 0 B EQU 1 SUP SPC 2 APLDX EQU * LDA B,I RETRIEVE THE STREAM CLASS NUMBER STA SAVCL PARAMETER(S). * GET EQU * JSB #GET WE WAIIT FOR A REQUEST TO ARRIVE DEF *+6 DEF SAVCL MONITOR'S CLASS DEF #RPB REQUEST BUFFER ADDRESS. DEF L#MXR MAXIMUM REQUEST LENGTH. DABFA DEF DABUF DATA BUFFER ADDRESS. DEF DBMAX MAXIMUM DATA BUFFER SIZE. JMP GET IGNORE INITIAL ERRORS! * DST SAVA = REQUEST LENGTH; = DATA LENGTH. * LDA #RPB+#FCOD CHECK FUNCTION CODE AND B377 MASK FN CODE * SZA,RSS IS THIS AN ID SEGMENT? JMP WKID YES, WORK ON ID SEGMENT CPA D1 PROGRAM DATA AREA? JMP LODIT YES, LOAD IT. CPA D2 PROGRAM'S BASE PAGE? JMP LODIT YES, LOAD IT. CPA D3 SHORT ID SEGMENT/END? JMP SHTID YES CPA D4 ABORT? JMP ABORT * * UNRECOGNIZED FUNCTION CODE: REJECT W/ ERROR = 1 * BADMS EQU * CLA,INA REJECT REQUEST: CODE=1 * SRPL0 EQU * STA #RPB+#ERCD SPC 2 * SEND REPLY * SRPLY EQU * JSB #SLAV DEF *+4 DEF RQLEN REQUEST LENGTH DEF ZERO NO DATA DEF ZERO NOP --ERROR JMP GET SKP * HERE ON 1ST STEP IN PROGRAM LOAD SEQUENCE. * CHECK PROGRAM'S ID SEGMENT: * RELOCATED FOR THIS RTE-L SYSTEM? * MEMORY AREA DECLARED CONFLICT WITH ANY OTHER PROGRAM? * ETC. * WKID EQU * * VERIFY THAT FATHER IS 'RPRTL' LDA #RPB+#FCOD ALF,ALF ROTATE SPECIAL CODE AND B377 TO LOW BYTE & MASK CPA D31 IS IT? RSS JMP BADMS NO, RETURN ERROR CODE * * HAS THIS PROGRAM FILE BEEN RELOCATED FOR CORRECT SYSTEM? LDA $CKSM GET SYSTEM CHECKWORD CPA ID+31 COMPARE ? RSS JMP ERR12 * * TEST FOR BACKGROUND PROGRAM - IF SO, ONLY LEGAL * TO LOAD IF 'LOAD' & 'SWAP' MODULES NOT IN SYSTEM * AND NO OTHER BG PROGRAM IS LOADED * LDA $FWBG START OF BACKGROۙUND CMA,INA COMPARE WITH LOW MAIN ADA ID+21 SSA JMP LO..1 REAL TIME SO OK LDA $ID# GET NEGATIVE NUMBER CMA,INA OF ID SEGMENTS STA LPCNT FOR COUNTER LDB $IDA POINT TO LO MAIN ADDRESS ADB D20 OF FIRST ID SEGMENT LO..5 LDA B,I IS THIS CPA $FWBG A BACKGROUND PROGRAM? RSS YES JMP LO..6 NO, NO PROBLEM ADB M8 YES, GET FIRST WORD LDA B,I OF NAME SZA NON-ZERO? JMP ERR40 YES, PROGRAM CONFLICT ADB D8 NO, GO BACK TO LOW MAIN ADDRESS LO..6 ADB D30 ADVANCE TO NEXT ID SEGMENT ISZ LPCNT MORE TO DO? JMP LO..5 YES LDA $.LOA 'LOAD MODULE IN SYSTEM' FLAG SZA 0 IS YES JMP LO..2 BACKGROUND OK ! JMP ERR13 ILLEGAL BG LOAD ATTEMPT * * TEST FOR SEGMENTED PROGRAM AND IF SO RAISE HIGH * MAIN TO LIMIT OF REAL-TIME AREA FOR PROGRAM * CONFLICT CHECKS LATER. * LO..1 LDA ID+24 FIND # OF SEGMENTS AND B176K SZA,RSS JMP LO..2 NONE LDA $FWBG YES, CHANGE UPPER LIMIT STA ID+33 LDA $BGBP ALSO OF BASE PAGE STA ID+34 SKP * LO..2 EQU * * * CHECK PRIORITY, SET TO 99 IF 0 * LDA ID+7 GET PRIORITY SZA,RSS TEST FOR ZERO LDA D99 IF SO SET IT TO 99 STA ID+7 * * GO PRIVILEGED TO WRITE THE ID SEGMENT * JSB $LIBR NOP * JSB IDSGA SEARCH FOR DUPLICATE PROGRAM NAMES DEF *+2 DEF ID+13 SEZ,CME IF NOT FOUND, CLEAR E-REG JMP RTPRG AND CHECK MEMORY BOUNDS LDA D2 SET ERROR CODE STA #RPB+#FCOD CODE JMP PEXIT WITH E-REG = 1 * * TEST FOR REAL-TIME PROGRAM MEMORY CONFLICT * RTPRG JSB IDMEM TEST FOR REAL-TIME MEMORY BOUNDS DEF *+2 CONFLICTS DEFID DEF DABUF PASS IT THE BUILT UP ID SEGMENT CCE,SZA,RSS IF NO CONFLICT FOUND (OR NOT R.T.) JMP SERCH THEN SEARCH FOR FREE ID SEG. LDB A PUT NAME ADDRESS IN B CLA & FLAG SPECIAL 'REMOVE' MESSAGE JMP PEXIT WITH E-REG = 1 SKP * * SEARCH FOR FREE ID SEGMENT * SERCH JSB IDSGA CALL FOR MATCH OF BLANK NAME DEF *+2 DEF ZERO ARRAY OF THREE ZEROS SEZ,RSS IF FOUND, GO MOVE ID DOWN JMP MOVE * * NO BLANK ID SEGMENTS FOUND. LDA D3 SET ERROR CODE = 3 STA #RPB+#FCOD CODE JMP PEXIT E-REG = 1 * * MOVE ID SEGMENT INTO SYSTEM * MOVE STA B SAVE COPY OF ID ADDRESS STB IDSEG SAVE FOR COMPLETION STB #RPB+#FCOD+1 RETURN ID SEGMENT ADDRESS TO MASTER LDA DEFID SET A TO SOURCE (B TO DEST.) JSB .MVW MOVE THE ID SEGMENT DEF D30 NOP CLA,CLE SET UP FOR GOOD RETURN PEXIT JSB $LIBX DONE! DEF *+1 DEF LO..3 * LO..3 SEZ,RSS CHECK FOR AN ERROR JMP LO..4 NO ERROR, SEND REPLY SZA 'REM' ERROR ? JMP SRPLY NO, SOME OTHER ERROR. SEND REPLY. JMP ERR40 MEMORY CONFLICT ('REM') * LO..4 EQU * CLA JMP SRPL0 SEND REPLY, ERROR CODE = 0 (NO ERROR) SKP * MOVE PROGRAM TO FINAL DESTINATION LODIT EQU * * LDA DABFA SOURCE LDB #RPB+#ADR DESTINATION JSB $LIBR GO PRIVILEGED NOP JSB .MVW DEF DALEN # WORDS NOP JSB $LIBX BACK TO NORMAL STATE DEF *+1 DEF *+1 * CLA RETURN "NO ERROR" CODE JMP SRPL0 AND SEND REPLY SKP * SET UP BLOCK NUMBERS OF SEGMENT MAINS & PLACE IN * SHORT IDS * * SHORT ID SEGMENTS EXIST AT THE START OF THE PROGRAM'S * MEMORY AREA, THE SAME AS FOR ALL SEGMENTED PROGRAMS IN * RTE-L. SHORT IDS ARE SET UPy AS FOLLOWS (NOTE DIFFERENCES * FROM RTE FMGR 'RP' COMMAND): * * +------------------------------------------------+ * ! NAME (1ST & 2ND CHARACTERS) ! \ * ! NAME (3RD & 4RTH CHARS) ! FROM RTE-L LOADER * ! NAME (5TH CHAR) ! ! / * ! SEGMENT ENTRY POINT ! * ! HIGH MAIN ADDRESS+1 ! * ! 0 ! HIGH BASE PAGE ADDR+1! * ! BASE PAGE BLOCK # OFFSET!PRGM SEGMENT BLOCK # ! * ! 1'S COMPLEMENT OF CHECKSUM ! * +------------------------------------------------+ * * NOTE THAT THE CHECKSUM IS COMPLEMENTED. THIS IS TO FORCE AN * ERROR TRAP FOR THE CASE WHERE THE USER HAS ACCIDENTALLY * INCLUDED THE NON-DS VERSION OF 'SEGLD' WITH THE PROGRAM, * BUT USED DS TO PUT THE PROGRAM IN MEMORY. IN THIS CASE, * 'SEGLD' WILL RETURN THE ERROR CODE INDICATING THE SHORT * ID SEGMENTS HAVE BEEN CORRUPTED (WHICH IS, IN FACT, TRUE, * BY THAT ROUTINE'S STANDARDS). * SHTID EQU * SET UP SHORT ID SEGMENTS LDA #RPB+#P7 ARE THERE SZA,RSS ANY SHORT ID SEGMENTS TO BE SET UP? JMP STMRB NO, FINISH UP * STA LPCNT SAVE LOOP COUNTER * LDA D2 INITIALIZE BLOCK # OF FILE TO STA BLOK# SKIP OVER SHORT ID SEGMENT(S) * * COMPUTE BLOCK OFFSET IN PROGRAM FILE OF FIRST SEGMENT MAIN LDA #RPB+#P9 LDB #RPB+#P8 LOW MAIN ADDRESS (1ST SHORT ID) STB SEGAD SAVE FOR CHECKSUM JSB BUMP BUMP 'BLOK#' TO MAIN'S BP AREA * LDA #RPB+#P11 HIGH BP+1 LDB #RPB+#P10 LOW BASE PAGE JSB BUMP BUMP 'BLOK#' TO 1ST SEGMENT'S MAIN AREA * * 'BLOK#' NOW CONTAINS THE BLOCK NUMBER OF THE FIRST * SEGMENT MAIN, AND SEGAD POINTS TO THE FIRST * SHORT ID SEGMENT, WHICH WE WILL 'FIX UP' IN A LOOP. * * FIX UP SHORT IDS * LOOP LDB SEGAD CURRENYT SHORT ID STB SIDAD SAVE FOR CHECKSUM CALL ADB D4 STB TEMP SAVE A(SEG HIGH MAIN) ADB D2 STA B,I SAVE SEG MAIN BLK# (FROM BUMP CALL) INB POINT TO CHECKSUM WORD STB SEGAD CLA JSB SUM DO CHECKSUM SIDAD NOP CMA DS REQUIRES ONE'S COMPLEMENT STA SEGAD,I PUT CHECKSUM IN SHORT ID ISZ SEGAD ADVANCE POINTER TO NEXT SHORT ID LDA TEMP,I SEGMENT HIGH MAIN+1 LDB #RPB+#P9 SEGMENT START ADDRESS JSB BUMP ADVANCE FILE BLOCK # ISZ TEMP BUMP PNTR TO HIGH BASE PAGE LDA TEMP,I LOAD SEGMENT HIGH BASE PAGE + 1 LDB #RPB+#P11 LOAD HIGH MAIN BP+1 JSB BUMP ADVANCE 'BLOK#' PAST BP AREA ISZ LPCNT DONE ? JMP LOOP SKP * * SET UP DS RESERVED AREA FOLLOWING SHORT IDS. * THE RTE-L LOADER AUTOMATICALLY RESERVES ONE MORE SHORT * ID SEGMENT THAN REQUIRED. THE LAST ONE IS FOR DS USE, * AND STORES THE FILE NAME, SECURITY CODE, ETC., * FOR 'SEGLD' TO USE. 'SEGLD' MAKES RFA REQUESTS TO GET THE * SEGMENTS, AND NEEDS TO KNOW WHAT THE FILE IS NAMED, WHERE IT * IS, ETC. * * THE "RESERVED SHORT ID" IS SET UP AS FOLLOWS: * * * \ BIT # * \ * WORD # \15 8 7 0 * ----------------------------- * 1 / 0 / C6 / * 2 / FILE SECURITY CODE / * 3 / CR# / * 4 / MASTER NODE # / * 5 / RESERVED FOR FUTURE / * 6 / " / * 7 / " / * 8 / - CHECKSUM / * ----------------------------- * * C6 = 6TH CHARACTER OF THE REMOTE FILE NAME SPC 2 LDA #RLPB+#P3 PICK UP 6TH CHAR OF FILE NAME AND B377 STA SEGAD,I PLACE IN 1ST WORD OF BLOCK LDB SEGAD BLOCK ADDRESS STB TEMP SAVE FOR CHECKSUM ISZ SEGAD POINT TO 2ND WORD * DLD #RPB+#P4 MOVE FILE SECURITY CODE DST SEGAD,I AND CARTRIDGE REFERENCE NUMBER ISZ SEGAD BUMP POINTER TO ISZ SEGAD 4RTH WORD LDA #RPB+#P6 STORE MASTER STA SEGAD,I NODE NUMBER ISZ SEGAD * CLA CLEAR OUT STA SEGAD,I WORD 5, ISZ SEGAD WORD STA SEGAD,I 6, ISZ SEGAD WORD STA SEGAD,I 7,T ONE ISZ SEGAD MOVE POINTER TO CHECKSUM WORD JSB SUM TEMP NOP START ADDR OF RESERVED BLOCK CMA ONE'S COMPLEMENT FOR DS SEGLD STA SEGAD,I SAVE IT SPC 2 STMRB EQU * HERE TO SET 'MR' BIT SO PROGRAM CAN BE EXECUTED * JSB $LIBR NOP LDB #RPB+#P12 GET ADDRESS OF ID SEG STATUS WORD ADB D15 ADVANCE TO WORD W/ 'MR' BIT LDA B,I IOR MRBIT SET 'MR' BIT STA B,I CLA RETURN 'NO-ERROR' CODE TO MASTER JSB $LIBX AND RESTORE MEMORY PROTECT DEF *+1 DEF SRPL0 GO SEND REPLY SKP * HERE IF MASTER WISHES TO ABORT THE LOAD, E.G., FILE ERROR * OCCURRED. ID SEGMENT BEING SET UP IS BLANKED. * ABORT EQU * JSB $LIBR GO PRIVILEGED NOP LDA DABFA SRC ADDRESS LDB #RPB+#ADR ADDRESS TO BE BLANKING JSB .MVW DEF #IDSZ BLANK THE ID SEGMENT NOP * CLA RETURN "NO ERROR" CODE TO MASTER * RESTORE INTERRUPTS JSB $LIBX DEF *+1 DEF SRPL0 AND SEND REPLY SKP * ERROR PROCESSING * * HERE IF CHECKWORD DOES NOT MATCH THAT OF SYSTEM ERR12 LDA D5 SET ERROR CODE=5 JMP SRPL0 (STORE CODE & SEND REPLY) SPC 2 ERR13 LDA 0D6 SET ERROR CODE = 6 JMP SRPL0 SEND REPLY * * * REMOVE CONFLICTING PROGRAM * * ENTERED WITH B POINTING TO NAME OF PROGRAM * TO BE REMOVED * ERR40 EQU * LDA B GET MEMORY ADDRESS OF PROGRAM'S NAME LDB @P1 WHICH CONFLICTS JSB .MVW MOVE THE NAME TO REPLY ERR BUFFER DEF D3 NOP * * RETURN 'MR' BIT OF CONFLICTING PROGRAM LDB #RPB+#ADR ADVANCE TO ADB D15 'MR' BIT LDA B,I PICK UP 'MR' BIT STA #RPB+#P4 RETURN TO MASTER LDA D4 RETURN ERROR CODE=4 JMP SRPL0 SKP * * BUMP - BUMP BLOCK NUMBERS TO POINT AT THE VARIOUS MAINS, BASE * PAGES, AND SEGMENTS CONTAINED WITHIN A TYPE 6 FILE. * * * CALLING SEQUENCE: * A = HIGH ADDRESS + 1 * B = LOW ADDRESS * JSB BUMP * * ON RETURN: = BLOK# = BLOCK NUMBER * B IS DESTROYED * * BUMP NOP CMB,INB SET THE LOW ADDRESS NEGATIVE ADA B AND ADD TO HIGH ADDRES. CLB CLEAR FOR DIVIDE DIV D128 FIND # OF BLOCKS SZB IF REMAINDER IS ZERO OK INA OTHERWISE, ADD 1 MORE BLOCK ADA BLOK# CURRENT + OLD STA BLOK# JMP BUMP,I RETURN SKP * SUM - USED TO SUM THE WORDS IN ID SEGMENTS FOR CHECKSUM TESTS * SUM NOP P+1 = ADDRESS LDB M7 STB #CNTR LDB SUM,I LOAD ADDRESS ISZ SUM POINT TO RETURN * ACCUMULATE THE SUM ADA B,I INB BUMP TO NEXT WORD ISZ #CNTR DONE? JMP *-3 NO, ADD THE NEXT JMP SUM,I #CNTR NOP LOOP COUNTER FOR "SUM" ROUTINE SKP * * CONSTANTS * ZERO DEC 0 DO NOT CHANGE THE NEXT 3 DEC 0 LOCATIONS !!! DEC 0 * M7 DEC -7 M8 DEC -8 D1 DEC 1 D2 DEC 2 D3 4HFB DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D8 DEC 8 D15 DEC 15 D20 DEC 20 D30 DEC 30 D31 DEC 31 D99 DEC 99 D128 DEC 128 B176K OCT 176000 B377 OCT 377 SBIT OCT 100000 MRBIT EQU SBIT * @P1 DEF #RPB+#P1 RQLEN ABS #P6 * * VARIABLES * LPCNT NOP # SEGMENTS IN LOADED PROGRAM * IDSEG NOP ADDRESS OF PROGRAM ID SEGMENT #IDSZ DEC 34 SIZE OF ID SEGMENT AREA BLOK# NOP FILE BLOCK # POINTER SEGAD NOP CURRENT SHORT ID MEMORY ADDR * * * DBMAX ABS 128 MAXIMUM DATA BUFFER SIZE. L#MXR ABS #MXR * * * * DO NOT CHANGE ORDER OF NEXT SIX STATEMENTS * * * * * SAVA & DALEN MUST BE CONTIGUOUS! SAVA NOP DALEN NOP * SAVCL NOP DABUF BSS 128 DATA BUFFER. * ID EQU DABUF-1 DEFINE ZERO-OFFSET SYMBOL TO ID SEGMENT AREA * * * * * * * * * * * * * * * * * * * * * * * * * * * * BSS 0 [ SIZE OF ] * UNS END APLDX H  91750-18224 2013 S C0122 &RPRTL +              H0101 ASMB,Q,C HED : MINI-APLDL MASTER ROUTINE (C) HEWLETT PACKARD CO. *1980* NAM RPRTL,19,90 91750-16224 REV 2013 800709 RTE-L 'RP' MASTER SUP SPC 2 * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAME: RPRTL * SOURCE: 91750-18224 * RELOC: 91750-16224 * PGMR: L. WEIMAN [6/6/80] * EXT OPEN,CLOSE,READF,EXEC,REIO,NAMR EXT PRTN,DSERR,.MVW,CNUMD EXT #RQB,#MAST,#NODE * * THIS PROGRAM IS USED TO DOWN-LOAD AN ABSOLUTE PROGRAM FILE * (CREATED BY RTE-L LOADER) INTO AN OPERATING RTE-L SYSTEM, * WHICH ALREADY HAS HAD DS/1000 INITIALIZED. IT REQUIRES THE * RTE-L PROGRAM DOWN-LOAD MONITOR APLDX ('LITTLE APLDR FOR RTE-L') * TO BE INITIALIZED. * * TO RUN PROGRAM: * * :RU,RPRTL,[],, * * WHERE FOR FILE, INCLUDING NAME, * OPTIONAL SECURITY CODE & CARTRIDGE * REFERENCE NUMBER. (FILE MUST BE * LOCATED IN SAME NODE AS THIS PROGRAM). * * = NODE NUMBER TO TRANSFER PROGRAM TO * * [ERROR PRINTOUT LU]= LU TO USE TO PRINT ERRORS. * IF ZERO OR NEGATIVE, ERRORS NOT PRINTED. * * 'DS' ERRORS ARE RETRIED 15 TIMES. IF THE ERROR PERSISTS, IT * IS REPORTED ON THE ERROR LU, IF ONE WAS GIVEN. * * IF ANY ERROR OCCURS, AND THE ERROR LU PARAMETER HAS BEEN * SUPPLIED, THE APPROPRIATE ERROR MESSAGE IS PRINTED (SEE MINI-APLDR * LISTING FOR DETAILS). THE ERROR CODES DEFINED THERE ARE RETURNED * TO THE 'FATHER' PROGRAM, IF THERE IS ONE. * * ADDITIONAL ERROR CODES, DEFINED ON MASTER SIDE: * * P1 = 0 NO ERROR * * P1 = -1 IMPROPER 'RUN' STRING, PARAMETERS NOT SUPPLIED. * * P1 = -2 FILE 'OPEN' ERROR. P2 CONTAINS FMP 'OPEN' ERROR CODE * * P1 = -3 FILE SPECIFIED NOT REAL RTE-L PROGRAM LOAD FILE * * P1 = -4 DS ERROR OCCURRED, RESULTS IN P2-P5. P2 & P3 CONTAIN * ASCII ERROR (E.G., 'DS01'), P4 CONTAINS REPORTING NODE * NUMBER, P5 CONTAINS ERROR QUALIFIER. * P1 = -5 FMP 'READ' ERROR OCCURRED, ERROR RETURNED IN P2 * * FOR DOCUMENTATION ON REQUEST & REPLY FORMATS, SEE APLDX LISTING SKP * ****************************************************************** * * * G L O B A L B L O C K REV 2013 791213 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, DINIT, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO * * RSM, DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM * ****************************************************************** * ***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS * ***!!!!! FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES * ***!!!!! ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE, * ***!!!!! REGARDLESS OF MESSAGE FORMAT. THIS ALSO MAKES * ***!!!!! STORE-AND-FORWARD CODE MUCH SIMPLER. * #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) * #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * SKP * APBLK-START * ****************************************************************** * * * A P L D X G L O B A L B L O C K REV 2013 800611* * * * GLOBAL OFFSETS FOR APLDX MESSAGE BUFFERS, USED BY * * * * RPRTL APLDX * ****************************************************************** * * * DEFINE APLDX REQUEST BUFFER * #FCOD EQU #MHD FUNCTION CODE #ERCD EQU #FCOD ERROR-RETURN CODE #P1 EQU #ERCD+1 #P2 EQU #ERCD+2 #P3 EQU #ERCD+3 #P4 EQU #ERCD+4 #P5 EQU #ERCD+5 #P6 EQU #ERCD+6 #P7 EQU #ERCD+7 #P8 EQU #ERCD+8 #P9 EQU #ERCD+9 #P10 EQU #ERCD+10 #P11 EQU #ERCD+11 #P12 EQU #ERCD+12 #ADR EQU #P1 * ***************************************************** * * * APBLK-END * SKP SPC 2 RPRTL EQU * CLA SET INDICATOR THAT WE HAVEN'T STA ABRAD ESTABLISHED AN ID SEGMENT YET CCA AND ASSUME THERE WILL BE AN ERROR  STA AB1 * JSB EXEC GET STRING DEF *+5 DEF D14 DEF D1 BUFA DEF BUFFR DEF DM80 80-CHARACTER STRING * SZA WAS THERE ANY STRING? JMP NOSTR NO STB LEN SAVE STRING LENGTH CLA,INA INITIALIZE STRING POINTER STA NPNTR JSB XNAMR CALL NAMR JSB XNAMR THREE JSB XNAMR TIMES * LDA PARSB GET ERROR LU STA ERRLU SAVE * JSB XNAMR GO GET NODE NUMBER LDA PARSB+3 WAS THIS AND B7 PARAMETER SZA,RSS DEFAULTED? JMP NONOD YES, NO NODE WAS GIVEN. LDA PARSB SAVE NODE NUMBER STA NODE * JSB XNAMR * DLD PARSB MOVE FILE NAME DST FNAME LDA PARSB+2 STA FNAME+2 DLD PARSB+4 DST SCODE * * ATTEMPT TO OPEN THE FILE WE WERE GIVEN * JSB OPEN DEF *+7 DEF DCB DEF IERR DEF PARSB FILE NAME DEF D5 NON-EXCLUSIVE 'OPEN' & FORCE TYPE TYPE 1 DEF PARSB+4 SECURITY CODE DEF PARSB+5 CARTRIDGE REFERENCE NUMBER * SSA ERROR? JMP FOERR FILE OPEN ERROR * * READ ID SEGMENT * JSB XREAD READ FILE RECORD * * CHECK CHECKSUM WORD * LDA DM30 STA CNTR LDA BUFFR LDB BUFA INB ADA B,I ADD IN NEXT WORD ISZ CNTR JMP *-3 STAY IN LOOP TILL ALL SUMMED * CPA BUFFR+31 IS THIS REALLY AN RTE-L ID SEGMENT? RSS YES, IT IS JMP NOTID NO, IT'S NOT. PRINT ERROR * * OVERLAY PROGRAM NAME WITH FILE NAME * AND MOVE PROGRAM NAME TO MESSAGE BUFFER * DLD PARSB MOVE CHARACTERS 1 DST BUFFR+12 THROUGH 4 DST .PG LDA PARSB+2 PICK UP CHARACTER 5 AND =B77400 MASK UPPER BYTE STA B SAVE LDA BUFFR+14 MERGE AND =B377  WITH LOW IOR B BYTE OF ID SEGMENT STA BUFFR+14 AND =B77400 IOR RCART INCLUCE ">" STA .PG+2 * * MOVE DATA TO ID SEGMENT AREA LDA BUFA LDB IDSGA JSB .MVW MOVE TO ID SEGMENT AREA DEF IDSIZ NOP * * * SEND ID SEGMENT TO SLAVE, FOR BOUNDS & OTHER CHECKING * LDA =D31 IDENTIFY US AS 'RTE-L' FATHER TO SLAVE ALF,ALF (ID CODE PASSED IN HIGH BYTE) LDB IDSIZ SET DATA LENGTH=ID SEGMENT SIZE JSB SNDMS SEND MESSAGE DEF IDSEG ABS #P1+1 REQUEST LENGTH * LDA #RQB+#ADR SAVE THE ID SEGMENT'S ADDRESS STA ABRAD * * ** SEND PROGRAM AREA * LDA ID+21 COMPUTE SIZE OF PROGRAM AREA STA ADDR (& INITIALIZE MEMORY ADDRESS) LDB ID+22 STB HADDR (& INITIALIZE HIGH MEMORY ADDRESS) JSB CNBLK SZA,RSS ANY PROGRAM DATA TO SEND? JMP BP NO, GO ON * PRLUP EQU * LOOP TO READ PROGRAM DATA JSB XREAD LDA D1 FUNCTION CODE FOR PROGRAM DATA = 1 JSB SNDMS DEF BUFFR ABS #P1+2 REQUEST LENGTH * LDA ADDR ADVANCE ADA D128 MEMORY STA ADDR ADDR PNTR ISZ CNTR END OF LOOP? JMP PRLUP NO, CONTINUE XFR * * *** SEND BASE PAGE AREA * BP EQU * LDA ID+25 COMPUTE NUMBER OF AND B1777 BLOCKS IN STA B BASE PAGE AREA STA HADDR (& INITIALIZE HIGH MEMORY ADDRESS) LDA ID+24 AND B1777 STA ADDR INITIALIZE TRANSFER ADDRESS JSB CNBLK SZA,RSS ANY BASE PAGE TO SEND? JMP FIN NO, SKIP THIS PART * PBLUP EQU * STORE BASE PAGE AREA LOOP JSB XREAD * LDA D2 FUNCTION CODE = 2 JSB SNDMS SEND MESSAGE DEF BUFFR  ABS #P1+1 * * LDA ADDR ADVANCE ADA D128 MEMORY STA ADDR POINTER ISZ CNTR JMP PBLUP CONTINUE IN LOOP UNTIL ALL BP XFRD * * WE'RE FINISHED. TELL SLAVE TO FINISH UP. * FIN EQU * LDA @FNAM MOVE FILE NAME, SECURITY CODE, LDB @RQB1 CRN, ETC., TO REQUEST JSB .MVW BUFFER DEF D5 NOP * LDA #NODE STA #RQB+#P6 PASS MASTER NODE # * LDA IDSEG+23 GET # OF SHORT ALF,ALF ID RAR,RAR SEGMENTS AND =B77 CMA,INA AND PASS TO SLAVE AS STA #RQB+#P7 A NEGATIVE COUNTER * LDA IDSEG+20 PASS LOW MAIN STA #RQB+#P8 TO SLAVE * LDA IDSEG+21 PASS HIGH MAIN+1 STA #RQB+#P9 TO SLAVE * LDA IDSEG+23 PASS LOW BASE PAGE ADDRESS AND B1777 TO SLAVE STA #RQB+#P10 * LDA IDSEG+24 PASS HIGH BASE PAGE+1 AND =B1777 TO SLAVE STA #RQB+#P11 * LDA ABRAD PASS ID SEGMENT ADDRESS STA #RQB+#P12 TO SLAVE * LDA D3 TERMINATE FUNCTION CODE=3 CLB JSB SNDMS DEF ZERO ABS #P12+1 REQUEST LENGTH * * PROGRAM DOWN-LOAD IS COMPLETE. * JSB XREIO DEF OKMES DOWN-LOAD OK DEF OKMSL * CLA RETURN NO-ERROR CODE STA AB1 (CLEAR FLAG WHICH WAS SET AT BEGINNING SAYING ERROR) * EXIT0 EQU * CMA,INA STA BUFFR TO FATHER PROGRAM * EXIT1 EQU * * IF AN ERROR HAS OCCURRED, AND WE'VE ESTABLISHED AN * ID SEGMENT, WE'LL HAVE TO CLEAR IT OUT. ISZ AB1 ERROR? JMP EXIT2 NO, DON'T CLEAR ID LDA ABRAD HAVE WE SET UP AN SZA,RSS ID SEGMENT YET? JMP EXIT2 NO, NOTHING TO CLEAR * * CLEAR ID SEGMENT WE SET UP. SEND 'ABORT' MESSAGE TO SLAVE. Dp* STA #RQB+#ADR TELL IT WHICH ID TO CLEAR * CLA CLEAR ID SEGMENT STA IDSEG+12 STA IDSEG+13 STA IDSEG+14 * LDA D4 ABORT: FUNCTION CODE=4 LDB IDSIZ DATA LENGTH = ID SEGMENT SIZE JSB SNDMS SEND MESSAGE DEF IDSEG ABS #P1+1 REQUEST LENGTH * EXIT2 EQU * JSB CLOSE CLOSE THE FILE DEF *+3 DEF DCB DEF IERR * JSB PRTN PASS RESULTS TO 'FATHER', IF THERE IS ONE DEF *+2 DEF BUFFR * JSB EXEC DEF *+2 DEF D6 SKP * * SUBROUTINE TO READ FILE RECORDS FOR US XREAD NOP JSB READF DEF *+6 DEF DCB DEF IERR DEF BUFFR DEF D128 DEF LEN SSA,RSS ERROR? JMP XREAD,I NO ERROR--RETURN TO POINT OF CALL * * A FILE 'READ' ERROR HAS OCCURRED. * STA BUFFR+1 RETURN TO CALLER CMA,INA MAKE IT POSITIVE STA IERR JSB CNUMD DEF *+3 DEF IERR DEF .ER1. * JSB XREIO DEF FRERR DEF FRERL LDA D5 RETURN ERROR CODE -5 JMP EXIT0 NOTE: COMPLEMENTED AT LABEL EXIT0 SPC 2 SPC 2 NOSTR EQU * NO 'RUN' STRING, OR IMPROPER PARAMETERS LDB ERRLU WAS AN ERROR LU SUPPLIED? SZB,RSS JMP NOST1 * JSB XREIO DEF NOSTM DEF NOSTL * NOST1 EQU * LDA D1 RETURN ERROR CODE -1 JMP EXIT0 NOTE: COMPLEMENTED AT LOCN EXIT0 NOTID EQU * FILE SPEC'D NOT RTE-L PROGRAM LOAD FILE JSB XREIO DEF NOFIL DEF NOFLL * LDA D3 RETURN ERROR CODE -3 JMP EXIT0 NOTE: COMPLEMENTED AT EXIT0 SPC 2 NONOD EQU * NO REMOTE NODE WAS GIVEN JSB XREIO DEF NOX DEF NOXL * CLA,INA RETURN ERROR CODE -1 JMP EXIT0 NOTE:COMPLEMENTED AT LABEL EXIT0 SPC 2 FOxERR EQU * FILE OPEN ERROR LDB IERR STB BUFFR+2 * LDB ERRLU IS THERE AN ERROR LU? SZB,RSS JMP FOER1 NO, JUST RETURN THE ERROR CODE CMA,INA MAKE ERROR CODE POSITIVE STA IERR JSB CNUMD DEF *+3 DEF IERR DEF .ER2. JSB XREIO DEF FOERX DEF FOERL * FOER1 EQU * LDA D2 RETURN ERROR CODE -2 JMP EXIT0 (NOTE: THIS IS COMPLEMENTED AT LOCN EXIT0) SKP * SUBROUTINE TO CODE & SEND A MESSAGE TO REMOTE RTL-L * DOWN-LOAD MONITOR * * CALLING SEQUENCE: * SET ADDR = ADDRESS WHERE YOU WANT THE BLOCK TO GO * SET HADDR = HIGH ADDRESS OF THE AREA YOU WANT LOADED * SET = FUNCTION CODE YOU WANT * = DATA LENGTH (NOT NECESSARY ON FN CODES 1 & 2) * * JSB SNDMS * DEF * DEC * RETURN HERE IF NO ERRORS SPC 2 SNDMS NOP STA FCODE SAVE FUNCTION CODE STB LEN SAVE DATA BUFFER LNTH LDA SNDMS,I GET BUFFER ADDRESS STA .BUFR SAVE IT ISZ SNDMS BUMP PNTR TO LNTH * LDA SNDMS,I GET REQUEST LENGTH STA RQLEN SAVE REQUEST LENGTH ISZ SNDMS BUMP PNTR TO RETURN * LDA MNTRY INITIALIZE RETRY STA RTRYC COUNTER * RETRY EQU * HERE ON RETRIES LDA FCODE PICK UP FUNCTION CODE * STA #RQB+#FCOD SAVE FUNCTION CODE * CPA D1 FUNCTION CODE = 1? JMP C. YES, CALCULATE DATA LENGTH CPA D2 2? RSS JMP SNDM. NO, DON'T CALCULATE LENGTH, USE 0 * C. EQU * * LDA ADDR SET ADDRESS STA #RQB+#ADR * * CALCULATE DATA LENGTH. IF WE HAVE MORE THAN 128 WORDS TO * GO, THEN SUBSTITUTE 128. * LDB D128 LDA ADDR CALCULATE DATA CMA,INA LENGTH ADA HADDR STA LEN SAVE LENGTH CMA,INA IS THIS ADA D128 LENGTH SSA > 128? STB LEN YES, USE 128 SNDM. EQU * * LDA NODE STA #RQB+#DST LDA STREM STA #RQB+#STR * * * JSB #MAST DEF *+7 DEF CONWD DEF RQLEN REQUEST LNTH .BUFR NOP DEF LEN LENGTH OF DATA (IF ANY) DEF ZERO INCOMING DATA BUFFER LENGTH DEF M#MXR MAX REPLY LENGTH JMP DSER 'DS' ERROR * LDA #RQB+#FCOD DID SLAVE PROGRAM SZA,RSS REJECT? JMP SNDMS,I NO, RETURN TO CALLER * * SLAVE PROGRAM DIDN'T LIKE WHAT WE GAVE IT. * STA BUFFR WE WANT TO RETURN RESULTS TO OUR 'FATHER' CPA D4 PROGRAM CONFLICT? RSS JMP .1 NO, CONTINUE * * MOVE NAME OF PROGRAM WHICH NEEDS TO BE REMOVED TO MSG BUFR * LDA @RQB1 LDB @PRGM JSB .MVW DEF D3 NOP LDA @RQB1 AND MOVE PROGRAM TO RETURN BUFFER PARAMETERS LDB BUFA INB JSB .MVW DEF D3 NOP * LDA .PRGM+2 INSERT A BLANK IN AND =B77400 6TH CHARACTER POSITION IOR =B40 STA .PRGM+2 * LDB BLANK PLACE 'MR' IN MESSAGE IF PROGRAM LDA #RQB+#P4 IS MEMORY-RESIDENT SSA 'MR' BIT SET? LDB "MR YES STB .PMR STB BUFFR+4 * LDA #RQB+#FCOD RECOVER FUNCTION CODE AGAIN * .1 EQU * ADA DM1 CONVERT TO ZERO-BASED SUBSCRIPT RAL ADA @ERTB CONVERT ERROR CODE TO ERROR TABLE PNTR DLD A,I LOAD MSG ADDRESS & LNTH DST RJ. * JSB XREIO PRINT ERROR MSG RJ. BSS 2 ERROR MESSAGE ADDRESS & LNTH GO HERE JMP EXIT1 SPC 2 * HERE ON ANY ERRORS FROM #MAST * DSER EQU * DLD #RQB+#EC1 PICK UP ERROR CODE INFO CPA =ADS WAS THIS A 'DS' ERROR? RSS  YES, POSSIBLY RETRYABLE JMP DSER. NO, NO RETRIES CPB =A04 DS04 ERROR? JMP DSER. YES, RETRIES WON'T HELP CPB =A07 DS07 ERROR? JMP DSER. YES, RETRIES WON'T HELP ISZ RTRYC BUMP RETRY COUNTER. TRY AGAIN? RSS YES, BUT TELL OPERATOR WE HAD TROUBLE.... JMP DSER. NO, JUST PRINT ERROR MESSAGE & QUIT * DST RTMSG SAVE 4-CHAR ERROR JSB XREIO PRINT THE TROUBLE WE HAD DEF RTMSG DEF RTMSL * JMP RETRY AND RETRY * DSER. EQU * * RETURN ERROR CODE, QUALIFIER AND REPORTING NODE NUMBER * IN PARAMETERS RETURNED TO 'FATHER' DST BUFFR+1 MOVE TO 'FATHER' LDA #RQB+#ENO LDA #RQB+#ECQ AND =B170 RAR,RAR RAR STA BUFFR+4 * * CALL 'DSERR' TO OBTAIN THE PROPER ERROR MESSAGE & PRINT IT * JSB DSERR DEF *+2 DEF BUFFR+5 * JSB XREIO DEF BUFFR+5 DEF D24 * LDA D4 RETURN ERROR CODE -4 JMP EXIT0 SKP * SUBROUTINE TO CALL 'REIO' FOR US, WITHOUT NEEDING TO SUPPLY * ALL THOSE EXTRA DEFS * * CALLING SEQUENCE: * JSB XREIO * DEF * DEF * * XREIO NOP DLD XREIO,I PICK UP BOTH DEFS DST XR.. * LDA ERRLU IS THERE SZA,RSS AN ERROR LU SPECIFIED? JMP X.R NO, JUST EXIT JSB REIO CALL REIO DEF *+5 DEF D2N NO-ABORT 'WRITE' CODE DEF ERRLU XR.. BSS 2 TWO STORED HERE NOP --ERROR RETURN (IGNORED) * X.R EQU * ISZ XREIO BUMP RETURN POINTER PAST ISZ XREIO THE TWO DEFS JMP XREIO,I ..AND RETURN TO CALLER SPC 2 * SUBROUTINE TO CALL 'NAMR' FOR US, WITHOUT NEEDING * ALL THOSE REPETITIVE DEFS * XNAMR NOP JSB NAMR DEF *+5 DEF PARSB PARSE BUFFER DEF BUrsFFR STRING BUFFER DEF LEN BUFFER LENGTH DEF NPNTR STRING POINTER JMP XNAMR,I SKP * * SUBROUTINE TO COMPUTE # BLOCKS IN AN AREA * * CALLING SEQUENCE: * * LDA (LOW ADDRESS) * LDB (HIGH ADDRESS+1) * JSB CNBLK CALCULATE # OF BLOCKS * = CNTR = NEGATIVE NUMBER OF BLOCKS, OR 0 * (I.E., = ((HIGH ADDR+1)-LOW ADDR+127))/128 * CNBLK NOP CMA,INA ADA B ADA =B177 ALF,ALF RAL AND =B777 CMA,INA STA CNTR JMP CNBLK,I SKP * DATA AREA B7 OCT 7 B1777 OCT 1777 ZERO DEC 0 D1 DEC 1 D2 DEC 2 D2N OCT 100002 NO-ABORT 'WRITE' CODE D3 DEC 3 D4 DEC 4 D5 DEC 5 D6 DEC 6 D14 DEC 14 D24 DEC 24 D34 DEC 34 D128 DEC 128 DM1 DEC -1 DM30 DEC -30 DM80 DEC -80 * @PRGM DEF .PRGM @RQB1 DEF #RQB+#P1 * FCODE NOP STORAGE FOR 'SNDMS' FUNCTION CODE MNTRY DEC -15 NUMBER OF RETRIES ON EACH 'DS' ERROR RTRYC NOP RETRY COUNTER NPNTR NOP STRING POINTER ERRLU NOP CONWD OCT 100000 NO-ABORT STREM DEC 11 STREAM TYPE RQLEN NOP REQUEST LENGTH LEN NOP CNTR NOP ADDR NOP HADDR NOP * IDSIZ EQU D34 ID SEGMENT SIZE @FNAM DEF FNAME SPC 2 * DO NOT RE-ARRANGE ORDER OF NEXT ITEMS! FNAME BSS 3 FILE NAME SCODE NOP FILE SECURITY CODE NOP FILE CARTRIDGE REFERENCE NUMBER * END OF ORDER-SENSITIVE AREA SPC 2 NODE NOP REMOTE NODE NUMBER DCB BSS 144 FILE DATA CONTROL BLOCK IERR NOP BUFFR BSS 128 PARSB BSS 10 PARSE BUFFER * AB1 NOP FLAG INDICATING ABORTING ERROR CAUSED TERMINATION ABRAD NOP STORAGE FOR ID SEGMENT'S ADDRESS IDSGA DEF IDSEG IDSEG BSS 34 ID EQU IDSEG-1 DEFINE ZERO-OFFSET ID-SEG SYMBOL * M#MXR ABS #MXR MAX HEADER LENGTH SPC 2 * ERROR CODE-TO-MESSAGE CONVERSION TABLE * ENTRIES ARE MADE TWO TO AN ERROR CODE. FIRST * ENTRY IS ADDRESS OF MESSAGE. 2ND ENTRY IS DEF TO ITS LENGTH. @ERTB DEF *+1 ERROR CODE TABLE * DEF UFC 1: UNRECOGNIZED FUNCTION CODE DEF UFCL * DEF DPRN 2:DUPLICATE PROGRAM NAMES DEF DPRNL * DEF NOIDS 3:NO BLANK ID SEGMENTS DEF NOIDL * DEF PRCFT 4:PROGRAM CONFLICT DEF PRCFL * DEF CKSM. 5:SYSTEM CHECKSUM MISMATCH DEF CKSML * DEF ILBFA 6:ILLEGAL BG LOAD ATTEMPT DEF ILBFL * * END OF TABLE ************************************* SKP * ASCII MESSAGES NOSTM ASC 13,IMPROPER 'RUN' STRING, OR NONE GIVEN NOSTL ABS *-NOSTR UFC ASC 7,UNREC FN CODE UFCL ABS *-UFC * DPRN ASC 11,DUPLICATE PROGRAM NAME DPRNL ABS *-DPRN * NOIDS ASC 10,NO BLANK ID SEGMENTS NOIDL ABS *-NOIDS * PRCFT ASC 4,REMOVE .PRGM ASC 3, .PMR ASC 1, PRCFL ABS *-PRCFT * CKSM. ASC 17,PRGM NOT RELOCATED W/CORRECT SNAP CKSML ABS *-CKSM. * ILBFA ASC 9,ILLEGAL BG LOAD ATTEMPT * RTMSG ASC 2, STORAGE FOR 4-CHAR DS ERROR MESSAGE ASC 8, ERROR. RETRYING RTMSL ABS *-RTMSG ILBFL ABS *-ILBFA * * "FILE OPEN ERROR-DDDDDD" FOERX ASC 8,FILE OPEN ERROR- .ER2. ASC 3, FOERL ABS *-FOERX * NOX ASC 13,MUST SPECIFY REMOTE NODE! NOXL ABS *-NOX * NOFIL ASC 15,THAT'S NOT AN RTE-L LOAD-FILE! NOFLL ABS *-NOFIL * * "FILE READ ERROR-DDDDDD" FRERR ASC 8,FILE READ ERROR- .ER1. ASC 3, FRERL ABS *-FRERR * * "PROGRAM DOWN-LOAD COMPLETE" OKMES ASC 5,PROGRAM < .PG ASC 3, STORAGE FOR PROGRAM NAME ASC 10, DOWN-LOAD COMPLETE OKMSL ABS *-OKMES * RCART OCT 76 ASCII ">" IN LOW BYTE BLANK ASC 1, TWO ASCII BLANKS "MR ASC 1,MR 'MR' SPC 2 A EQU 0 B EQU 1 UNS END RPRTL TFNLHHN  91750-18225 2013 S C0122 &#IDSG              H0101 PASMB,R,Q,C HED #IDSG 91750-1X225 REV.2013 * (C) HEWLETT-PACKARD CO. 1980 NAM #IDSG,7 91750-1X225 REV.2013 800725 ALL * ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 #IDSG * EXT .ENTR,PGMAD,$OPSY * * NAME: #IDSG * SOURCE: 91750-18225 * RELOC: PART OF 91750-12014, -12015 * PRGMR: JIM HARTSELL * * * PRECURSOR OF A * GENERAL-PURPOSE SUBROUTINE TO RETURN AN ITEM FROM AN ID SEGMENT, * DEPENDING ON OP SYSTEM UNDER WHICH THE ROUTINE IS RUNNING. * * CALLING SEQUENCE: JSB #IDSG * DEF *+4 OR 5 * DEF IDADR ID SEG ADDR OR ZERO (SELF). * DEF ITEM ITEM NUMBER. * DEF VALUE RETURNED VALUE, RIGHT JUSTIFIED. * [DEF OPTYP] RETURNED OP SYSTEM TYPE (OPT.). * B EQU 1 SUP * IDADR NOP ITEM NOP VALUE NOP OPTYP NOP * #IDSG NOP ENTRY POINT. * JSB .ENTR GET CALLER'S PARAMETER ADDRESSES. DEF IDADR * CLA IN CASE PARAM NOT SPECIFIED. LDA IDADR,I GET ADDRESS OF ID SEGMENT. STA XEQT SAVE. SZA JMP IDSG1 IF SPECIFIED, GO GET ITEM. * STA BUFR GET ID SEG ADDR OF CURRENT PROGRAM. * JSB PGMAD (NO "IDGET" IN RTE-M). DEF *+3 DEF BUFR DEF XEQT * IDSG1 CLA IN CASE PARAM NOT SPECIFIED. LDA ITEM,I GET ITEM NUMBER. SZA,RSS JMP IDEX IGNORE CALL IF NOT SUPPLIED OR ZERO. * LDA $OPSY GET OP SYSTEM TYPE. LDB OPTYP RETURN IT TO CALLER IF SZB 1   THE PARAM WAS SPECIFIED. STA OPTYP,I * * TEMPORARY QUICK & DIRTY FETCH OF PROGRAM SEQUENCE NUMBER. * (#IDSG CALLED BY #MSSM: ITEM NUMBER TENTATIVELY = 1) * LDB XEQT PRIME WITH ADDR OF ID SEGMENT. CPA N5 JMP RTEM3 RTE-MIII (NO SEQ #). CPA N31 JMP PSC2 RTE-L10. CPA N29 JMP PSC2 RTE-L20. CPA N9 JMP PSC1 RTE-IVB. CPA N13 JMP PSC1 RTE-IVM. CPA N17 JMP PSC1 RTE-VI. CPA N21 JMP PSC1 RTE-VIM. RTEM3 CLA JMP PSC3 NONE OF THE ABOVE. PSC1 ADB B3 OFFSET WILL BE 31. PSC2 ADB D28 OFFSET = 28. JSB LODWD GET USER'S PROG SEQ COUNTER. ALF PSC3 AND B17 IDEX LDB VALUE PASS ITEM VALUE TO CALLER, SZB IF PARAMETER WAS SPECIFIED. STA VALUE,I * JMP #IDSG,I RETURN TO CALLER. * LODWD NOP LDA $OPSY RAR,SLA SKIP IF NON-DMS. JMP *+3 LDA B,I NON-DMS. JMP LODWD,I XLA B,I DMS. JMP LODWD,I * * B3 OCT 3 B17 OCT 17 D28 DEC 28 N5 DEC -5 N9 DEC -9 N13 DEC -13 N17 DEC -17 N21 DEC -21 N29 DEC -29 N31 DEC -31 XEQT NOP BUFR BSS 3 * END   91750-18999 2013 S C0122 A91750              H0101 uIA91750 SOFTWARE NUMBERING CATALOG REV 2013 91750-90001 OPTION -020 MODULE DESCRIPTION DATE CODE PART NUMBER CARTRIDGE A91750 DS/1000-IV SOFTWARE NUM. CAT. 2013 91750-18999 91750-13301 $DSLB1 DS/1000-IV BASE LIBRARY 2013 91750-12001 91750-13301 $DSLB2 HP 1000 TO HP 1000 LIBRARY 2013 91750-12002 91750-13301 $DSLB3 HP 1000 TO HP 1000 ONLY LIBRARY 2013 91750-12003 91750-13301 $DSML1 RTE-MIII NODES WITH FILE SYSTEM 2013 91750-12004 91750-13306 $DSML2 RTE-MIII NODES WITHOUT FILE SYS 2013 91750-12005 91750-13306 $DSLB4 ALL EXCEPT RTE-MIII LIBRARY 2013 91750-12006 91750-13301 $DSLCL DS SUBROUTINES FOR RTE-L 2013 91750-12007 91750-13305 $DSMA MESSAGE ACCOUNTING LIBRARY 2013 91750-12008 91750-13308 $DSMXL DS/1000-IV LIB. M/E/F SERIES 2013 91750-12009 91750-13301 $DSNMA NO MESSAGE ACCOUNTING LIBRARY 2013 91750-12010 91750-13308 $DSNRR NO DYNAMIC MESSAGE REROUTING LIB 2013 91750-12011 91750-13308 $DSNSM NO SESSION ANYWHERE IN NETWORK 2013 91750-12012 91750-13308 $DSRR DYNAMIC MESSAGE REROUTING LIB. 2013 91750-12013 91750-13308 $DSSM RTE-IVB NODES WITH SESSION 2013 91750-12014 91750-13308 $DSLSM RTE NODES W/O LOCAL SESSION 2013 91750-12015 91750-13308 $D3KL2 HP 1000 TO HP 3000 ONLY LIBRARY 2013 91750-12016 91750-13303 $D3KLB HP 1000 TO HP 3000 BASE LIBRARY 2013 91750-12017 91750-13303 $D3KRB 304 WORD COMMUNICATION BUFFER 2013 91750-12018 91750-13303 $D3KBB 1072 WORD COMMUNICATION BUFFER 2013 91750-12019 91750-13303 $DSDB REMOTE DATABASE ACCESS LIBRARY 2013 91750-12020 91750-13309 $D3KMB 4096 WORD COMMUNICATION BUFFER 2013 91750-12021 91750-13303 %RDBAM REMOTE DATABASE ACCESS MONITOR 2013 91750-16024 91750-13309 %APLDL ABSOLUTE PROGRAM LOADR FOR RTE-L 2013 91750-16040 91750-13305 %3APLD ABSOLUTE PROGRAM LOADER RTE-MIII 2013 91750-16042 91750-13306 %CNSLM HP 3000 $STDLIST MONITOR 2013 91750-16048 91750-13303 %COMND RTE-L SYSTEM COMMAND PROCESSOR 2013 91750-16049 91750-13305 %DINIT DS/1000-IV INITIALIZATION 2013 91750-16068 91750-13301 %DINIS DS/1000-IV INIT. WITH SHUTDOWN 2013 91750-16069 91750-13301 %DLIS1 DIRECTORY LIST DISC-BASED FMP 2013 91750-16072 91750-13302 %DLIS2 DIRECTORY LIST FLOPPY BASED FMP 2013 91750-16073 91750-13305 %DSINF DS/1000-IV INFORMATION UTILITY 2013 91750-16077 91750-13307 %DSIN2 DS INFO UTILITY HP 3000 ONLY 2013 91750-16078 91750-13308 %DSINL DS INFO UTILITY FOR RTE-L 2013 91750-16079 91750-13305 %DSMOD DS/1000-IV NETWORK MODIFICATION 2013 91750-16092 91750-13307 %DSTES 1000 SLAVE VERIFY 1000-3000 PTOP 2013 91750-16100 91750-13303 %DSVCP REMOTE VIRTUAL CONTROL PANEL 2013 91750-16102 91750-13308 %DVA65 DS/1000-IV COMM. DRIVER 12771/73 2013 91750-16105 91750-13301 %DVA66 DS/1000-IV COMM. DRIVER HDLC/BSC 2013 91750-16107 91750-13301 %DVG67 HP 3000 COMM. DRIVER (HARDWIRED) 2013 91750-16108 91750-13303 %MDV00 REMOTE I/O MAPPING DRIVER(IVB/M) 2013 91750-16109 91750-13307 %EXECM REMOTE EXEC REQUEST MONITOR 2013 91750-16111 91750-13302 %EXECW REMOTE EXEC W/WAIT MONITOR 2013 91750-16112 91750-13302 %GRPM REQUEST/REPLY PRE-PROCESSOR 2013 91750-16124 91750-13302 %ID.66 DS/1000-IV COMM. DRIVER RTE-L 2013 91750-16126 91750-13305 %INCNV INPUT MESSAGE CONVERTOR 2013 91750-16129 91750-13302 %IOMAP USER I/F FOR REMOTE I/O MAPPING 2013 91750-16130 91750-13307 %LOG3K HP 1000 TO HP 3000 MESSAGE LOGGR 2013 91750-16132 91750-13303 %LUMAP MODULE FOR REMOTE I/O MAPPING 2013 91750-16133 91750-13307 %LUQUE BUFFERING FOR REMOTE I/O MAPPING 2013 91750-16134 91750-13307 %MATIC MA TIME-OUT PROCESSOR 2013 91750-16136 91750-13307 %OPERL REMOTE OPERATOR COMMANDS (RTE-L) 2013 91750-16142 91750-13305 %OPERM REM. OPER. RQST. MON. (IVB,MIII) 2013 91750-16143 91750-13302 %OTCNV OUTPUT MESSAGE CONVERTOR 2013 91750-16144 91750-13302 %PLOG TRACE CAPABILITY FOR RTE-RTE 2013 91750-16147 91750-13307 %PROGL SLAVE MON. FOR REMOTE DOWNLOAD 2013 91750-16150 91750-13309 %PTOPM PTOP COMM. MANAGEMENT MONITOR 2013 91750-16151 91750-13302 %QCLM DS/1000-IV ERROR MESSAGE LOGGER 2013 91750-16152 91750-13302 %QUEUE INTERRUPT REQUEST HANDLER 2013 91750-16153 91750-13302 %QUEX HP 3000 COMM. MODULE (HSI) 2013 91750-16154 91750-13304 %QUEX1 HP 3000 COMM. MODULE (PSI) 2013 91750-16155 91750-13304 %QUEZ HP 3000 SLAVE RQST. MONITOR(HSI) 2013 91750-16156 91750-13304 %QUEZ1 HP 3000 SLAVE RQST. MONITOR(PSI) 2013 91750-16157 91750-13304 %REMAN NET. OPERATOR I/F RTE-IVB/RTE-L 2013 91750-16159 91750-13302 %REMAZ NETWORK OPERATOR I/F RTE-MIII 2013 91750-16160 91750-13306 %RESL SSGA ENTRY POINT LIBRARY RTE-L 2013 91750-16161 91750-13305 %RESM SSGA ENTRY PT. LIBRARY RTE-MIII 2013 91750-16162 91750-13308 %RESSM SSGA ENTRY PT. LIBRARY RTE-IVB 2013 91750-16163 91750-13308 %RFAM1 RFA MONITOR - SINGLE DCB MODULE 2013 91750-16164 91750-13302 %RFAM2 RFA MONITOR - MULTIPLE DCB MOD. 2013 91750-16165 91750-13302 %RMOTE HP 3000 NETWORK OPERATOR I/F 2013 91750-16167 91750-13304 %RMOT1 HP 3000 NET. OPER. I/F (W/MOVE) 2013 91750-16168 91750-13304 %RMTIO FTN4 REMOTE I/O FORMATTER 2013 91750-16169 91750-13307 %RPCNV HP 3000 REPLY CONVERTOR 2013 91750-16170 91750-13304 %RQCNV HP 3000 REQUEST CONVERTOR 2013 91750-16171 91750-13304 %RSM REMOTE SESSION MONITOR 2013 91750-16172 91750-13302 %RTRY COMM. LINE RETRY PROCESSOR 2013 91750-16173 91750-13302 %SLCIN EVENTS TRACE TABLE LOGGER(DVG67) 2013 91750-16176 91750-13304 %TLOG PLOG TRACE DATA LOGGER RTE-RTE 2013 91750-16177 91750-13307 %TRC3K LOG3K DATA FORMATTER RTE-MPE 2013 91750-16178 917d50-13303 %UPLIN NETWORK WATCHDOG MONITOR 2013 91750-16179 91750-13302 %VCPMN VIRTUAL CONTROL PANEL MONITOR 2013 91750-16180 91750-13308 %XDV00 REMOTE I/O MAPPING DRIVER(RTE-L) 2013 91750-16181 91750-13305 %RDBAP DATA BASE ACCESS RQST. PROCESSOR 2013 91750-16182 91750-13309 %SYSAT SYS. ATTENTION MOD. I/O MAPPING 2013 91750-16202 91750-13309 %RD.TB REMOTE DATA BASE TABLE AREA 2013 91750-16205 91750-13309 %#SEND REROUTING MESSAGE SENDER MODULE 2013 91750-16208 91750-13308 %MVCP3 INSTALLS COPY3K ON THE 3000 2013 91750-16212 91750-13303 !COPY3 COPY3K EXECUTABLE MODULE 2013 91750-16213 91750-13303 %WHZDS DS/1000-IV WHZAT 2013 91750-16217 91750-13309 %#SPLU REMOTE I/O MAP ENTRY PT. (IVB/L) 2013 91750-16221 91750-13305 %MSPLU REMOTE I/O MAP ENTRY PT. (MIII) 2013 91750-16222 91750-13306 %APLDX MINI-APLDR-MEMORY ONLY RTE-L 2013 91750-16223 91750-13305 %RPRTL DOWNLOAD PROGRAM USED WITH APLDX 2013 91750-16224 91750-13305 %RTMLG RTE-MIII LOADER/GENERATOR 2013 91740-12006 91750-13306 %LGLIB RTE-MIII LOADER/GENERATOR LIB. 2013 91740-12007 91750-13306 %EDITD DS/1000-IV EDITOR 2013 91740-16022 91750-13309 %REDIT REMOTE EDITR INTERFACE (MIII) 2013 91740-16023 91750-13309 %SGPRP SEGMENTATION PREPARATION PROGRAM 2013 91740-16070 91750-13306 * OPT. 041 PROVIDES ALL MODULES ON TWO FLOPPY DISCS 91750-13401 * 91750-13402 * OPT. 050 PROVIDES ALL MODULES ON 800 BPI MAGNETIC TAPE 91750-13501 * OPT. 051 PROVIDES ALL MODULES ON 1600 BPI MAGNETIC TAPE 91750-13502 * ------------------------------------------------------------------------ LIST OF 91750 SOFTWARE MANUALS *THE EDITION, UPDATE, AND DATE LISTED BELOW INDICATE THE CURRENT VERSION OF EACH MANUAL FOR THE SOFTWARE REVISION CODE FOUND ON THE FRONT COVER OF THIS MANUAL.) *THIS LISTING SHOULD BE USED TO VERIFY THAT THE INFORMATION ON EACH MANUAL'S PRINTING HISTORY PAGE MATCHES THE EDITION, UPDATE, AND DATE LISTED BELOW. EDITION UPDATE SOFTWARE MANUALS PART NUMBER NUMBER DATE NUMBER DATE SOFTWARE NUM CAT 91750-90001 1 10/80 USER'S MANUAL 91750-90002 1 10/80 NET MNGR MANUAL 91750-90003 1 10/80 GETTING STARTED 91750-90004 1 10/80 QUICK REF GUIDE 91750-90005 1 10/80 w  91780-18011 2013 S C0722 &RJE RJE/1000 MAIN             H0107 ASMB,R,Q,C,Z IFZ HED RJE WITH FMP INTERFACE [Z] * (C) HEWLETT-PACKARD CO.1979 * NAM RJE,19,50 91780-16011 REV.2013 800123 XIF IFN HED RJE WITHOUT FMP INTERFACE [N] * (C) HEWLETT-PACKARD CO. 1979 * NAM RJE,3,50 UNRELEASED 91780-16002 UPDATE XIF * * NAME: RJE "REMOTE JOB ENTRY" * SOURCE: 91780-18011 - - - UNL IFZ LST * RELOC: 91780-16011 [FMP VERSION: 'Z' ASSEMBLY OPTION] UNL XIF IFN LST * RELOC: 91780-16002 [NON-FMP VERSION: 'N' ASSEMBLY OPTION] UNL XIF LST * PGMR: R. PASSMORE ( 11/20/73 ) * * MODIFIED BY: R. SHATZER, R. FUNK, P. KAPOOR ( 01/11/75 ) * C. WHELAN ( 10/31/75 ) * C. HAMILTON ( 04/12/77 ) * D.B. & R.G. ( 08/11/78 ) * R.G. ( 01/31/79 ) * R.G. ( 04/26/79 ) * R.G. ( 10/09/79 ) * R.G. ( 01/23/80 ) * * ***************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 RJE EXT $LIBR,$LIBX,$OPSY,EXEC EXT #BSC,#TIME,#CTRL,#CMBF,#WRBF,#RDBF UNL IFZ LST EXT PARSE,REIO,PRTN,IFBRK,.MVW EXT #TFLG EXT OPEN,CLOSE,CREAT,READF,WRITF,#RDCB,#LDCB,#PDCB UNL XIF IFN LST EXT #INGT REIO EQU EXEC UNL XIF LST EXT LURQ SUP * * THE PROGRAM RJE, WITH THE BISYNC DRIVER (DVR50, AND #BSC) * EMULATES THE IBM 2780 REMOTE BATCH TERMINAL TO PROVIDE A * COMMUNICATIONS cLINK TO IBM 360/370 COMPUTERS FROM THE * RTE-II,III,IV AND RTE-C ENVIRONMENTS. (WITH RTE-C IS UNSUPPORTED) SKP *********************************************************************** * RJE PARAMETERS * * UP TO FIVE OPTIONAL PARAMETERS MAY BE SPECIFIED WHEN SCHEDULING * RJE. THE MEANING OF THESE PARAMETERS ARE: * * P1.......LOGICAL UNIT OF DVR50 (DEFAULT CAUSES SEARCH) * P2.......MODE PARAMETER. POSSIBLE VALUES ARE: * 0=INPUT AVAILABLE,LOCAL DIAL,NON TRANSPARENT * 1=NO INPUT, LOCAL DIAL, NON TRANSPARENT * 2=INPUT AVAILABLE, LOCAL ANSWER, NON TRANS. * 3=NO INPUT, LOCAL ANSWER, NON TRANSPARENT * 4=INPUT AVAILABLE, LOCAL DIAL, TRANSPARENT * 5=NO INPUT, LOCAL DIAL, TRANSPARENT * 6=INPUT AVAILABLE, LOCAL ANSWER, TRANSPARENT * 7=NO INPUT, LOCAL ANSWER, TRANSPARENT * * ADD 16384 FOR DIAGNOSTIC MODE. * UNL IFZ LST * P3-P5.....THREE CASES: 1) LOGICAL UNITS OF INPUT, LIST, UNL XIF IFN LST * P3-P5.......TWO CASES: 1) LOGICAL UNITS OF INPUT, LIST, UNL XIF LST * AND PUNCH DEVICES, RESPECTIVELY. * 2) P3=(LOGICAL UNIT + 100) OF * DEVICE USED TO SPECIFY INPUT, LIST AND PUNCH. UNL IFZ LST * 3) P3-P5 CONTAIN ASCII FILE NAME * USED TO SPECIFY INPUT, LIST, AND PUNCH. UNL XIF LST * * * DEFAULT VALUES ARE P2=0, P3=5, P4=6, P5=4 * * UNL IFZ LST * WHEN CASE TWO OR THREE IS USED, THE DEVICES ARE SPECIFIED * IN THIS FORMAT: * * [INPUT LU OR FN][,LIST LU OR FN][,PUNCH LU OR FN] * ( FN = FNAMER[:SC[:CR]] ) * * NON-EXISTING FILES ARE CREATED FOR LIST AND PUNCH STREAMS. * ( FILE-TYPE = 3, FILE SIZE = 24 BLOCKS ) UNL XIF IFN LST * WHEN CASE TWO IS USED, THE DEVICES ARE SPECIFIED IN THIS FORMAT: * * [ INPUT LU ] [ ,LIST LU ] [ ,PUNCH LU ] UNL XIF LST * * ALL READ REQUESTS TO THE SYSTEM CONSOLE ARE PRECEEDED BY * THE PROMPT #. * * FILE NAMES ARE ACCEPTED FOR I/O ONLY WHEN THE FILE MANAGER * VERSION IS BEING USED. * * **************************************************************************** SKP *************************************************************************** * SYSGEN REQUIREMENTS * * THE 12618A SYNCHRONOUS MODEM INTERFACE KIT AND APPROPRIATE DATA * SET ARE REQUIRED TO COMMUNICATE. INSTALLATION OF THIS PACKAGE * FOLLOWS NORMAL RTE/RTE-C SYSGEN PROCEEDURES. THE DRIVER, DVR50 * MUST BE INSTALLED AS PRIVILEDGED (OPTION P23 IN RTE). * * RJE IS RECOMMENDED BACKGROUND DISC RESIDENT IN RTE, AND IS NOT * SWAPPABLE WHEN #BSC IS ATTACHED. ON LINE LOADING OF RJE IS * RECOMMENDED IN RTE-C DUE TO THE PROGRAM SIZE. * * #BSC MAY BE CONFIGURED AS A RESIDENT LIBRARY ROUTINE, MAKING * RJE SWAPPABLE. LARGE BATCH ORIENTED SYSTEMS MAY PREFER THIS * CONFIGURATION WITH RJE FORGROUND DISC RESIDENT. * * **************************************************************************** * DIALING CAPABILITY * * DURING ITS OPERATION, RJE WILL SCHEDULE A PROGRAM, #DIAL * TO PROVIDE DIALING CAPABILITY. THE HP SUPPLIED VERSION PRINTS * A MESSAGE FOR MANUAL DIALING. THE USER MAY SUPPLY HIS OWN * VERSION FOR AUTO DIALING, ETC. * * *************************************************************************** * DATA FORMAT * * DATA TRANSMISSION IS ON A UNIT RECORD (CARD IMAGE) BASIS, WITH * MULTIRECORD BLOCKING USED TO FILL A 400 CHARACTER BUFFER. THE * EM CHARACTER MAY BE USED TO SUPPRESS TRAIcLING BLANKS. * * HORIZONTAL TAB, VERTICAL FORMAT CONTROL, DEVICE SELECTION, * AND TRANSPARENCY ARE ALSO SUPPORTED. * * IF TRANSPARENT MODE IS SPECIFIED, THE INPUT "FILE" IS NOT * TRANSLATED INTO THE PROPER LINE CODE, BUT BINARY TRANSMISSION * OF 80 CHARACTER RECORDS IS POSSIBLE. ON RECEPTION, THE LIST * STREAM IS ALWAYS TRANSLATED, BUT THE PUNCH STREAM IS TRANSLATED * ONLY IN NON TRANSPARENT OPERATION, OR IF DIRECTED TO LPT OR TTY. * *************************************************************************** SKP *************************************************************************** * COMMANDS USED IN INPUT STREAM * * INPUT-EOF CAUSES A LINE TURNAROUND, AND, FOLLOWING THE RECEPTION OF ONE * FILE, TERMINATION OF RJE. * * TEN SPECIAL CONTROL RECORDS ARE RECOGNIZED IN THE INPUT STREAM: * * #E RECORD TRANSMITS THE CURRENT DATA BUFFER & CAUSES A LINE TURNAROUND. * * #P [,N [,M]] PAUSES FOR N LONG TIMEOUTS TO WAIT FOR UP TO M OUTPUTS. * N OR M EQUAL TO -1 MEANS INFINITE: #P,3,-1 = #R , #P = #E , #P,-1 = #W * * #C [,XX] RECORD CAUSES RECONFIGURATION OF I/O DEVICES. [XX] IS OF THE UNL IFZ LST * SAME FORMAT AS CASE TWO OR THREE FOR P3, ABOVE, BUT DEFAULT =NO CHANGE. UNL XIF IFN LST * SAME FORMAT AS CASE TWO FOR P3, ABOVE, BUT DEFAULT = NO CHANGE. UNL XIF LST * * #I RECORD CAUSES A TTY FILE TO BE INSERTED IN THE INPUT STREAM * UNTIL AN EOF IS READ FROM THE TTY, OR #P, #E, #R, #W IS USED. * WHEN THIS HAPPENS, THE INSERT IS TERMINATED. * * #R RECORD IS EQUIVALENT TO A #P,3,-1. * * #W RECORD SPECIFIES CONTINUAL WAIT FOR ONE OUTPUT FROM THE REMOTE. * THE WAIT INTERVAL MAY BE TERMINATED VIA OPERATOR INTERRUPT. * (*BR,RJE--FMP VERSION, OR *ON,#INRP--NON-FMP VERSION) * * #D RECORD CAUSES IMMEDIATE TERMINATION. * * #T [,XX] RECORD ENABLES TRANSPARENT MODE FROM THE CURRENT INPUT STREAM. UNL IFZ 7 LST * 'XX' = LU OR FILE FROM WHICH INPUT WILL BE DERIVED UPON DETECTION OF UNL XIF IFN LST * 'XX' = LU FROM WHICH INPUT WILL BE DERIVED UPON DETECTION OF UNL XIF LST * END-OF-FILE ON THE CURRENT INPUT-STREAM. 'XX' HAS THE SAME FORMAT AS UNL IFZ LST * CASE TWO OR THREE FOR P3, AND MAY ALSO BE USED TO RE-CONFIGURE THE UNL XIF IFN LST * CASE TWO FOR P3, AND MAY ALSO BE USED TO RE-CONFIGURE THE UNL XIF LST * LIST AND PUNCH STREAM DEVICES AS IN #C. NOTE THAT #COMMANDS, E.G. #P * RECORDS, ARE TREATED AS DATA, NOT COMMANDS, IN TRANSPARENT MODE. * * #X COMMAND FORCES TRANSLATION OF TRANSPARENT DATA IN THE PUNCH STREAM. * #X IS CANCELLED AT RECEIPT OF 'EOT' IN PUNCH STREAM OR ENTRY OF THE * #C COMMAND, OR INVOCATION OF #T STREAM CHANGES AFTER EOF FROM INPUT. * * #S COMMAND IS USED TO SWITCH ON OR OFF THE DIAGNOSTIC MESSAGES * CAPABILITY OR THE TRACE FEATURE. THIS COMMAND MAY ALSO APPEAR IN * A CONFIGURATION DATA STREAM, E.G. #S,T,ON => TURN ON TRACE MODE. * **************************************************************************** * RTE INTERRUPT FEATURE * * THE RTE OPERATOR INTERRUPT FEATURE IS SUPPORTED, AND CAUSES * INTERRUPTION OF THE OUTPUT STREAM AND INSERTION (#I) OF A TTY * FILE IN THE INPUT STREAM * **************************************************************************** SKP *************************************************************************** * DIAGNOSTIC AND ERROR MESSAGES * * RJE PRINTS AN ON MESSAGE, A TERMINATION MESSAGE, AND ERROR * MESSAGES WITH THE FORMAT " RJE: XX" WHERE XX HAS VALUES WHOSE * MEANINGS ARE: * * 50...INITIALIZATION REQUEST ISSUED TO DRIVER * 51...#DIAL SCHEDULED * 52...HANDSHAKE REQUEST ISSUED * 53...ANSWER REQUEST ISSUED * 54...WRITE REQUEST ISSUED * 55...READ REQUEST ISSUED * 56...SEND EOT REQUEST ISSUED * 57...REC[EIVE TO SEND REQUEST ISSUED * 58...DISCONNECT REQUEST ISSUED * 59...EXTENDED STATUS REQUEST ISSUED * 60...IRRECOVERABLE LINE ERROR * 61...TERMINAL ON LINE * 62...TRANSMIT MODE * 63...RECEIVE MODE * 64...RVI RECEIVED * 65...BUFFER OVERFLOWED * 66...CONTROL MODE * 67...WAITING FOR REMOTE MODEM... * * NOTE THAT CODES 50-67 ARE PRINTED ONLY IN DIAGNOSTIC * MODE, AND ARE INFORMATION MESSAGES, NOT ERROR * MESSAGES. * * 20...SECURITY CODE VIOLATION (#BSC NOT FOUND IN CORE) * 21...PASSWORD VIOLATION (ANOTHER PROGRAM HAS INITIALIZED THE DRIVER) * 22...ILLEGAL MODE FOR REQUEST ISSUED TO DRIVER * 23...ILLEGAL BUFFER FORMAT GIVEN TO DRIVER * 24...ILLEGAL BISYNC SEQUENCE RECEIVED REPEATEDLY * 25...LOSS OF CLEAR TO SEND * 26...8 NAK CHARACTERS SENT (GARBAGE RECEIVED) * 27...8 NAK CHARACTERS TRANSMITTED (GARBAGE TRANSMITTED) * * 30...RECEIVE TIMEOUT OCCURRED REPEATEDLY * 31...LONG TIMEOUT FAILURE * 32...LINE TERMINATION SEQUENCE SENT (DLE/EOT) * 33...LINE TERMINATION SEQUENCE RECEIVED (DLE/EOT) * 34...LOSS OF DATA SET READY SIGNAL * 35...LOSS OF CARRIER DETECT DURING RECEIVE (REPEATEDLY) * 36...TTD OR WACK LIMIT EXCEEDED * 37...REQUEST TIMEOUT DURING CONTROL MODE * * * NOTE THAT CODES 20-37 REPORT ERRORS WHICH WERE DETECTED * IN THE DRIVER, AND ARE CONSIDERED IRRECOVERABLE. * SKP * * 40...NAK READ REQUEST ISSUED 3 TIMES * 41...REMOTE DOES NOT RESPOND TO BID FOR LINE (HANDSHAKE REQUEST) * 42...I/0 DEVICE ERROR * 43...I/O CONFIGURATION PARAMETER ERROR * 44...LOGICAL UNIT NUMBER INVALID * 45...DVR50 NOT AVAILABLE (DEVICE DOWN, OR IN USE BY ANOTHER PROG) * 46...I/O REQUEST REJECTED BY DVR50 * 47...USER REQUEST TO ABORT RJE UNL IFZ LST * 48...TIMEOUT AND CONTROL MODIFICATION PARAMETER ERROR * * * NOTE THAT CODES 40-48 ARE ERRORS DETECTED BY RJE. UNL XIF IFN LST * * * NOTE THAT CODES 40-47 ARE ERRORS DETECTED BY RJE.  UNL XIF IFZ LST * * * 01...FMGR ERROR -1 * 02...FMGR ERROR -2 * 03...FMGR ERROR -3 * 04...FMGR ERROR -4 * 05...FMGR ERROR -5 * 06...FMGR ERROR -6 * 07...FMGR ERROR -7 * 08...FMGR ERROR -8 * 09...FMGR ERROR -9 * * 10...FMGR ERROR -10 * 11...FMGR ERROR -11 * 12...FMGR ERROR -12 * 13...FMGR ERROR -13 * 14...FMGR ERROR -14 * 15...FMGR ERROR -15 * 16...FMGR ERROR -16 * 17...FMGR ERROR -17 * * * NOTE THAT CODES 00-17 ARE ERRORS ENCOUNTERED BY THE * FILE MANAGER, AND ARE CONSIDERED IRRECOVERABLE BY * RJE. * UNL XIF LST * * **************************************************************************** SKP *************************************************************************** *********** THIS IS AN ENHANCED VERSION OF RJE CREATED 11/11/76 ********* *********** IT CONTAINS THE FOLLOWING CHANGES: ********* * * -> DOES A CORELOCK TO PREVENT SWAPPING IF #BSC IS DISC-RESIDENT. * -> WHEN ENTERING CONFIGURATION DATA, THE COMMAND "#!" WILL ABORT RJE. UNL IFZ LST * -> IF THE FIRST RECORD OF CONFIGURATION DATA IS OF THE FORMAT: * ----- * #M,CODE [,PAD [,DUPLEX [,RCVTO [,XMITO [,LNGTO [,TTDWK ]]]]]] * * RJE MAY BE CONFIGURED FOR THE FOLLOWING OPERATING OPTIONS: * * CODE* = EBCDIC/ASCII COMMUNICATION LINE CODE TO BE USED. * PAD* = PAD/EOM PAD WITH BLANKS/TERMINATE WITH 'EOM'. * DUPLEX* = HALF/FULL MODEM OPERATIONAL MODE. * RCVTO = NNNNN (+10'S OF MSEC.>=+200) RECEIVE TIMEOUT. * XMITO = NNNNN (+10'S OF MSEC.>=+100) TRANSMIT TIMEOUT. * LNGTO = NNNNN (+10'S OF MSEC.>=+400) LONG TIMEOUT. * TTDWK = NNNNN (POSITIVE COUNT >=400) NO.OF TTD/WACK SEQUENCES. * * PARAMETERS INDICATED WITH '*' SUFFIX ARE ENTERED AS ASCII; * (CODE,PAD,DUPLEX ARE ASCII; OTHERS ARE NUMERIC <= +32767) * AT LEAST Ob,NE PARAMETER MUST BE ENTERED; OTHERS ARE OPTIONAL. * CURRENT VALUES ARE UNCHANGED WHEN ",," PLACE-HOLDERS ARE ENTERED. * INITIAL VALUES ARE DEFINED BY <#COMN>. IF <#COMN> IS CORE-RESIDENT, * CHANGED VALUES REMAIN IN EFFECT, UNTIL FURTHER MODIFIED, OR UNTIL * THE SYSTEM IS RE-BOOTED FROM DISC. * * -> NON-EXISTING LIST AND/OR PUNCH-STREAM FILES ARE CREATED. * -> THE RTE "BR" COMMAND IS USED INSTEAD OF THE OPERATOR * SCHEDULING "#INRP". "#INRP" & "#INXT" ARE NO LONGER NEEDED. * -> "PRTN" IS CALLED TO REPORT ERRORS BACK TO THE SCHEDULING * PROGRAM. THE FIVE PARAMETERS ARE AS FOLLOWS: * P1 = INDICATES ABORT IF BIT 15 SET * P2 = LOWER 8 BITS OF EQT WORD 5 * P3 = EQT WORD 12 * P4 = FMP ERROR CODE * P5 = LAST ERROR CODE (IN ASCII) REPORTED TO SYSTEM CONSOLE * NOTE THAT NORMAL COMPLETION IS INDICATED BY P3 = 2000B. UNL XIF LST * -> TRANSMITTED RECORDS WILL NORMALLY BE PADDED OUT TO 80 * CHARACTERS WITH BLANKS. END-OF-MEDIA CHARACTERS WILL ONLY * BE USED(AS PREVIOUSLY) IF BIT 1 OF WORD #5 IN "#COMN" IS SET. UNL IFZ LST * -> RE-ENTRANT I/O ("REIO") IS USED FOR ALL UNIT-RECORD DEVICE * READ/WRITES. THIS PERMITS SWAPPING OF RJE WHILE IN I/O SUSPEND. UNL XIF LST * -> DVR05 ( 2640/2644/2645 ) TERMINAL OPERATION IS SUPPORTED. * -> ASCII AND EBCDIC ARE BOTH HANDLED BY THIS VERSION OF RJE. * ASCII TRANSLATION IS SELECTED BY SETTING BIT 2 IN THE * #CTRL WORD OF "#COMN". * -> #W COMMAND ADDED: CONTINUAL WAIT FOR OUTPUT FROM REMOTE. * -> #T[,XX] ALLOWS 'XX' TO RECONFIGURE ALL STREAMS AS IN #C[,XX]. * -> THIS SOURCE SUPPORTS BOTH THE FMP AND NON-FMP VERSIONS OF * RJE. TO ASSEMBLE THE FMP VERSION, INCLUDE THE CONDITIONAL * ASSEMBLY "Z" OPERATOR ON THE ASSEMBLER CONTROL CARD. TO * ASSEMBLE THE NON-FMP VERSION, USE THE "N" OPERATOR INSTEAD. * -> PARTS OF RJE HAVE BEEN RECODED TO DECREASE ITS SIZE AND * BASE PAGE LINKAGE REQUIREMENTS. * -> RJE,#BSC, AND DVR50 HAVE BEEN MODIFIED FOR RTE-III OPERATION. *************************************************************************** * * * **************************************************************************** **************************************************************************** **************************************************************************** * PCO 1840 AUGUST 11,1978 **************************************************************************** * * THIS VERSION OF RJE DOES NOT BID FOR THE LINE UNLESS IT HAS * DATA TO SEND. THIS PREVENTS THE "READER ACTIVE" DEADLOCK * WHICH WAS CAUSED BY BIDDING FOR THE LINE AND THEN TURNING * IT AROUND BY SENDING EOT WITHOUT HAVING SENT DATA. * * TO COPE WITH MULTIPLE RETURNING OUTPUTS, #P COMMAND WAS ADDED. * * DIAGNOSTIC MESSAGES AND ERROR MESSAGES AND INFORMATION MESSAGES * ARE NOW PRINTED IN ASCII FOR FMP VERSIONS. * * A TRACE CAPABILITY NOW EXISTS WHICH ALLOWS RECORDING OF ALL * BYTES SENT AND RECEIVED OVER THE LINE. * * TRACE AND DIAGNOSTICS MODE MAY BE SWITCHED ON OR OFF AT ANY TIME * BY USE OF THE #S COMMAND. * *........................................................................ * * BUGS FIXED: * * PARSING BUG IN CONFIGURATION FILE INPUT FILENAME RECOGNITION. * (CAN NOW BE LESS THAN SIX CHARACTERS.) * * COMMUNICATIONS BUFFER OVERLAP. * * #I USED TO CAUSE BID FOR THE LINE. * * 18.2 HR IN AUTO ANSWER USED TO HANG SYSTEM. * * DID NOT RECOGNIZE SECURITY CODE > 72. * * #R WAITED FOR FOUR LONG TIMEOUTS INSTEAD OF THREE. * * BAD SYN CHARACTER SEARCH COULD CAUSE TO BE LOCKED OUT OF SYNC. * * END OF MEDIA EM NOW IS BYPASSED ONLY ON VERY FIRST RECORD. * * TROUBLE WITH 80 CHARACTER FIRST RECORDS. * * IF SENT NAK AND TIMED OUT RECEIPT OF ANSWER SYSTEM WOULD HANG. * ****************** ******************************************************** ************************************************************************** SKP ************************************************************************** * PCO 1913 JANUARY 31,1979 * * CHANGES MADE INCLUDE: * * 1. USE OF EXEC 13 INSTEAD OF REFERENCING THE DRT DIRECTLY * IN DETERMINING DEVICE TYPE. * * 2. CLEAN UP OF THE TERMINATION SEQUENCE (EXIT). * *************************************************************************** *************************************************************************** * PCO 1926 APRIL 26,1979 * * RTE-IVB SESSION MONITOR COMPATIBILITY! * *************************************************************************** *************************************************************************** * PCO 2001 OCTOBER 9, 1979 * * NOTE: #BSC HAS BEEN CHANGED ALSO FOR PCO 2001!!! * * 1. FIXED P2 INPUT RECOGNITION BUG. * * 2. CHANGED BUFFER ADDRESS FOR WRITES AND READS TO * DVR50 FOR COMPATIBILITY WITH PCO 1926 OF RTE. * THIS WILL INSURE THAT THE USER MAP WILL BE ENABLED * WHEN THE DRIVER IS ENTERED. * *************************************************************************** *************************************************************************** * PCO 2013 JANUARY 23, 1980 * * NOTE: ONLY RJE MODULE IS CHANGED FOR PCO 2013. * * REASON: JES3 HAS LINE FILL SEQUENCE WHEN NOTHING TO SEND. * ENQ(3 SEC),EOT(10 SEC),ENQ... * IT EXPECTS A REPLY TO THE ENQ WITHIN 16 ENQS OR * ELSE IT WILL GIVE UP. ACK0 OR NAK WORK. * DO A #P TYPE WAIT COMMAND OR A #W. * * IN OTHER WORDS, JES3 HAS A CONTROL MODE TIMEOUT * OF ITS OWN, APART FROM RJE'S. * * RJE WOULD WAIT FOREVER AFTER/DB@< A #P, HOWEVER. * CODE HAS BEEN CHANGED SO THAT RECEIPT OF AN EOT * AFTER AN ENQ (WITHOUT DATA) WILL DECREMENT THE * WAIT COUNT BY ONE (13 SEC COUNTS AS 20 IN THIS CASE). * * CHANGED: IN RECEIVE PROCESS, LOOK FOR (JES3). * ***************************************************************************** QB SKP *************************************************************************** * THIS SECTION EXECUTES ONLY ON A SCHEDULE OPERATION. IT PERFORMS * THE FOLLOWING: * 1. RETRIEVE SCHEDULE PARAMETERS AND DECODE MODE. * 2. RESET ALL FLAGS TO MAKE PROGRAM RE-SCHEDULABLE * 3. CONFIGURE I/O CALLS FOR THE COMMUNICATIONS LU. * 4. READ THE CONFIGURATION FILE, IF REQUIRED. * 5. MODIFY THE TIMEOUT AND CONTROL VALUES, IF SPECIFIED. * 6. CALL CONFG TO INTERPRET THE FILE, AND START TO SET DEFAULT LU'S. * 7. TRANSFER CONTROL TO THE NEXT SECTION *************************************************************************** * RJE NOP PRIMARY ENTRY POINT LDA C.5 SET COUNTER TO -5 STA CNT1 LDA P1ADD AND INITIALIZE POINTER TO P1 STA TEMP1 RETRV LDA B,I RETRIEVE PARAMETER,AND UNL * SPC 1 * EXT DBUG * CPA C.1 * RSS * JMP *+9 * JSB DBUG * DEF *+1 * JSB EXEC * DEF *+4 * DEF C6 * DEF ZERO * DEF D1 * JMP RJE+1 * SPC 1 LST STA TEMP1,I STORE IT INB BUMP ADDRESSES AND COUNT ISZ TEMP1 ISZ CNT1 IF THERE ARE MORE JMP RETRV RETRIEVE THEM * CLA GET A=0 STA INFLG RESET CONFIGURATION STA TRFLG FLAGS STA ASFLG TO ZERO STA BRKFL STA DIAGF STA IOBFL STA ABORT STA TST1 UNL IFZ LST STA #TFLG STA MODSW UNL XIF LST STA XTRAN PUNCH TRANSLATION FLAG STA RDLK RESET LU LOCK FLAGS STA LSTLK STA PUNLK STA EOTFL INA SET SYSTEM LU TO 1 STA SYSLU * LDA C.4 SET LISTEN TIME TO 1 MINUTE STA LISFL * * DECODE MODE PARAMETER * LDA P2 CHECK MODE PARAMETER VALIDITY AND P2MSK ONLY LOW THREE BITS AND BIT 14 ARE LEGAL SZA,RSS JMP P2OK LDB DEC43 IF ANYTHING ELSE THEN ERROR MESSAGE JSB REPOR JMP EXIT2 AND EXIT. * P2OK LDA P2 GET MODE PARAMETER CCB SET B = -1 STB RECCT SET RECEIVE COUNT TO 1 STREAM STB DISFL CLEAR DISCONNECT FLAG. STB FCRDF SET FIRST-CARD FLAG. STB FCDRD SLA IF INPUT EXPECTED, JMP *+3 STB LISFL STB INFLG SET INPUT FLAG RAR,SLA POSITION AND IF ANSWER, STB ASFLG SET ANSWER FLAG RAR POSITION SLA,RSS IF TRANSLATION, STB TRFLG SET TRANSLATION FLAG ALF,SLA POSITION P2 AND IF OLD DIAGNOSTIC MODE FLAG SET, STB DIAGF SET DIAG FLAG * * MODE PARAMETER HAS NOW BEEN DECODED * SLA IF OLD DIAGNOSTIC MODE, JSB HALT1 HALT COMPUTER * * CONFIGURE COMMUNICATIONS LU INTO CONTROL WORDS * LDA P1 GET LU OF COMMUNICATION INTERFACE. SZA,RSS IF LU WAS DEFAULTED, GO FIND IT JMP FINDL STA CWD00 STA OUTCW RETRIEVE EQUIPMENT TYPE JSB GTWST CPA C50 IF ITS DVR50, JMP *+4 PROCEED LUERR LDB DEC44 ELSE REPORT LU ERROR (44), JSB REPOR JMP EXIT2 AND ABORT LDA CWD00 COMM BOARD, AND CFGLU ADA C2700 STORE IN ALL LDB D.9 SET COUNTER TO -9 STB CNT1 LDB ACW27 GET ADDRESS OF CONTROL WORDS * STA B,I SET CONTROL WORD INB BUMP ADDRESS ADA C100 INCREMENT CONTROL WORD VALUE ISZ CNT1 IF THERE ARE MORE, JMP *-4 DO THEM * * TRACK DOWN BUFFER ADDRESSES, AND MAKE THEM DIRECT. * LDA RDBUA  READ BUFFER. JSB INDA STA RDBUA LDA WRBFA WRITE BUFFER. JSB INDA STA WRBFA ADA C.1 STA WRBFB BINARY WRITE BUFFER. LDA COMBA COMMUNICATIONS READ BUFFER. JSB INDA STA COMBA UNL IFZ LST LDA TIME TIMEOUT/CONTROL MODIFICATION BUFFER. JSB INDA STA TIME UNL XIF LST LDA #TIME TIMEOUT/CONTROL SPECIFICATION BUFFER. JSB INDA STA TIMAD ADDRESS OF TIMEOUT SPECIFICATIONS. LDA BSCAD ADDRESS OF #BSC. JSB INDA STA BSCAD UNL IFZ LST LDA DRDF ADDRESS OF INPUT-STREAM DCB JSB INDA STA DRDF * * DISABLE TRACE CAPABILITY IF NOT RTE III OR IV OR IF #COMN IS * NOT IN SSGA. * CLA PREPARE FOR UNDEFINED: $OPSY (RTE-C) LDA $OPSY GET THE OP-SYSTEM SPECIFICATION AND D2 ISOLATE DMS BIT SZA,RSS IF NOT DMS, STA TFGAD DISABLE TRACE * LDA RTORG FETCH FWA OF RT AREA CMA,INA ADA COMBA CLB SSA,RSS IF #COMN NOT IN SSGA, STB TFGAD DISABLE TRACE UNL XIF LST * * IF A CONFIGURATION FILE IS PRESENT, READ IT * LDA P3 GET LU SPECIFIER ADA D.100 SUBTRACT 1// SSA IF NEGATIVE JMP STAR GO START PROCESS ADA D.100 SUBTRACT 1// SSA,RSS SKIP IF NOT A FILE NAME JMP COFN ELSE GO READ CON FILE * LDA P3 SET LU OF CONFILE DEVICE ADA D.100 STA OUTCW JSB GTWST GET CORRESPONDING EQUIP TYPE LDB OUTCW SZA,RSS IF ITS DVR00, STB SYSLU RESET SYSTEM LU * TTRD LDB DEC71 WRITE MESSAGE ON TTY JSB REPOR * LDA POIN RESET READ STA PPOIN LU ADDRESS * JSB GTWST  GET EQUIP TYPE AGAIN SZA,RSS IF ITS DVR00, JMP TTYRD USE PROMPT READ FOR TTY * * READ CONTINUE * UNL IFZ LST LDA D1 SET SWITCH TO RETURN HERE, STA MODSW FOR CONFILE CONTINUATION. * UNL XIF LST LURD JSB EXEC READ CONFILE INTO DEF *+5 CONFILE BUFFER DEF D1 ICODE=1=READ DEF OUTCW RDBUA DEF #RDBF DEF D.80 RSSI RSS * TTYRD JSB TTYIN * STCNT LDA #RDBF UNL IFZ LST STB MCNT SAVE CHARACTER COUNT FOR 'PARSE'. UNL XIF LST CPA ASC#! LOOK FOR "#!" JMP ABUSR FOUND, ABORT USER UNL IFZ LST CPA ASC#M IF THE FIRST CONFILE ENTRY IS "#M", JMP MODFY GO TO MODIFY TIMEOUT/CONTROL VALUES. CPA ASC#S JMP SWCH2 UNL XIF LST CMB STORE COUNT IN LENGTH WORD STB RDLEN * UNL IFN SKP XIF LST * NOW READY TO INTERPRET CONFILE. * CLA JSB CONFG DECODE DEVICES & OPEN FILES JMP EXIT2 ERROR RETURN * * * CONFIGURE FOR ASCII OR EBCDIC * STAR LDB TIMAD ADB C5 LDB B,I RBR,RBR BIT 2= ASCII/EBCDIC FLAG LDA RSSI SLB CLA USE NOP IF ASCII STA MOD1 MODIFY INSTRUCTIONS STA MOD2 SZA LDA ALF2 ALF,ALF STA MOD3 LDB SYASC SZA LDB SYEBC STB IPRM,I STORE SYNC CHAR LDB CODEX STB PPOIN LDB CODE# STB CNT1 LDB CODTB SETCD LDA PPOIN,I GET CODE (LHW=EBCDIC/RHW=ASCII) MOD3 NOP HAS ALF,ALF IF EBCDIC AND C377 CHAR IS IN RHW STA B,I STORE IN CONTROL WORD TABLE ISZ PPOIN INB ISZ CNT1 JMP SETCD * JSB START SET LU'S JMP EXIT2 C\ERROR RETURN, ABORT LDB DEC70 WRITE "ON" MESSAGE JSB REPOR JMP INITL GO START BOARDS *********************************************************************** * P2MSK OCT 137770 FOR P2, ONLY LOW THREE BITS AND BIT 14 ARE LEGAL SKP **************************************************************** * 'FINDL' SEARCHES FOR THE FIRST LU WHICH IS LINKED TO DVR50. **************************************************************** * FINDL CLB,INB START WITH LU = 1, STB OUTCW AND SEARCH FOR EQUIP TYPE =50B. JSB EXEC DO 'EXEC' STATUS CALL. DEF *+4 DEF D13I TRAP ERRORS. DEF OUTCW DEF ISTAT JMP NXTLU IGNORE UNASSIGNED LU'S. * LDA ISTAT GET EQT WORD #5. ALF,ALF POSITION TYPE-CODE TO LSB'S. AND C77 ISOLATE THE TYPE-CODE. CPA C50 IF IT IS 50B, THEN THIS IS IT! JMP GOTLU GO TO INITIALIZE THE CONTROL WORD. * NXTLU LDB OUTCW GET THE CURRENT LU NUMBER. INB ADVANCE TO THE NEXT SEQUENTIAL LU. CPB C100 IF ALL LU'S HAVE BEEN EXAMINED IN VAIN, JMP LUERR REPORT THE NON-EXISTENCE OF DVR50! JMP FINDL+1 OTHERWISE, CONTINUE THE SEARCH. * GOTLU LDA OUTCW SET THE CORRECT LU STA CWD00 INTO THE PROGRAM, JMP CFGLU AND BRANCH BACK INTO PROCESSING. ************************************************************** * ABUSR LDB DEC47 JSB REPOR JMP EXIT2 ABORT ************************************************************** * INDA NOP INDIRECT ADDRESS TRACKDOWN ROUTINE. RSS LDA A,I RAL,CLE,SLA,ERA JMP *-2 JMP INDA,I ************************************************************* SKP UNL IFZ LST ************************************************************* * TIMEOUT/CONTROL MODIFICATION PROCESSING ROUTINE. ************************************************************* * MODFY LDA CH.BL REPLACE THE STA #RDBF #M, STRING LDA C40 WITH LDB RDBUA ASCII INB BLANKS RBL STB BBUFB JSB STRBY * JSB PARSE PARSE THE USER'S PARAMETERS DEF *+4 WHICH CAN BE FOUND DEF #RDBF IN THE INPUT BUFFER, DEF MCNT WHOSE LENGTH IS IN 'MCNT', DEF #WRBF AND PLACE THE RESULT INTO '#WRBF'. LDA #WRBF+32 GET THE PARAMETER COUNT, AND CMA,INA,SZA,RSS FORM A NEGATIVE COUNTER--IF ONLY #M... JMP MODER THEN INFORM THE USER OF HIS ERROR! STA MDCNT SAVE THE NEGATIVE PARAMETER COUNT. * LDA TIMAD GET THE ADDRESS OF THE CURRENT VALUES, LDB TIME AND THE ADDRESS OF THE LOCAL BUFFER. JSB .MVW MOVE THE DEFAULT VALUES DEF C6 INTO THE LOCAL-PROCESSING BUFFER. NOP * DLD #WRBF GET "CODE"(1ST) PARAMETER SZA,RSS IF NOT SPECIFIED, JMP MPAD USE THE ORIGINAL VALUE. CPA D2 IF THE PARSED PARAMETER-TYPE IS ASCII, RAL,SLA SET THE BIT MASK FOR BIT#2, AND SKIP. JMP MODER * IMPROPER PARAMETER: ERROR #48 * CPB "EB" IF THE USER WANTS EBCDIC TRANSLATION, CLB,RSS THEN PREPARE TO CLEAR BIT #2; LDB A ELSE, IT'S ASCII: BIT #2 =1. JSB MODBT GO TO MODIFY THE CONTROL WORD. DEF CTRL * MPAD JSB PCHEK CHECK FOR ADDITIONAL PARAMETERS. DLD #WRBF+4 GET THE "PAD" PARAMETER. SZA,RSS IF NOT SPECIFIED JMP MDUP THEN USE THE DEFAULT VALUE. CPA D2 IF THE PARSED-PARAMETER TYPE IS ASCII, JMP *+2 PROCEED WITH BIT MASK SET FOR BIT #1. JMP MODER * IMPROPER PARAMETER: ERROR #48 * CPB "PA" IF THE USER PADDING WITH BLANKS, CLB,RSS PREPARE TO CLEAR BIT #1; ELSE, LDB A USE SET BIT #1 FOR USE OF 'EOM'. JSB MODBT GO TO MO:DIFY DEF CTRL THE CONTROL WORD. * MDUP JSB PCHEK CHECK FOR NEXT PARAMETER. DLD #WRBF+8 GET "DUPLEX" PARAMETER. SZA,RSS IF NOT SPECIFIED, JMP MRTM USE THE DEFAULT VALUE. CPA D2 IF THE PARSED-PARAMETER TYPE IS ASCII, SLA,RAR SET BIT #0 MASK, AND PROCEED. JMP MODER * IMPORPER PARAMETER: ERROR #48 * CPB "HA" IF THE USER SAYS LINE IS HALF DUPLEX, CLB,RSS THEN PREPARE TO CLEAR BIT #0; ELSE, LDB A SET BIT #0 FOR FULL DUPLEX OPERATION. JSB MODBT GO TO MODIFY DEF CTRL THE CONTROL WORD. MRTM JSB PCHEK CHECK FOR NEXT PARAMETER. DLD #WRBF+12 GET RECEIVE TIMEOUT PARAMETER. SZA,RSS IF NOT SPECIFIED, JMP MXTM USE THE DEFAULT VALUE. JSB TMIN CHECK THE SUPPLIED VALUE DEF MINRC AGAINST THE MINIMUM. DEF RCTM STORE RESULT IN 'RCTM'. * MXTM JSB PCHEK CHECK FOR ANOTHER PARAMETER. DLD #WRBF+16 GET TRANSMIT TIMEOUT PARAMETER. SZA,RSS IF NOT SPECIFIED, JMP MLTM USE THE DEFAULT VALUE. JSB TMIN CHECK THE SUPPLIED VALUE DEF MINXM AGAINST THE MINIMUM. DEF XMTM STORE RESULT IN 'XMTM'. * MLTM JSB PCHEK CHECK FOR ANOTHER ONE. DLD #WRBF+20 GET THE LONG TIMEOUT PARAMETER. SZA,RSS IF NOT SPECIFIED, JMP MTTD USE THE DEFAULT VALUE. JSB TMIN CHECK THE SUPPLIED VALUE DEF MINLT AGAINST THE MINIMUM. DEF LGTM STORE RESULT IN 'LGTM'. * MTTD JSB PCHEK CHECK FOR NEXT PARAMETER. DLD #WRBF+24 GET THE TTD/WACK PARAMETER. SZA,RSS IF NOT SPECIFIED, JMP MCTL USE THE DEFAULT VALUE. JSB TMIN CHECK THE SUPPLIED VALUE DEF MINTD AGAINST THE MINIMUM. DEF TDWK STORE RESULT IN 'TDWK'. * MCTL JSB PCHEK CHECK FOR THE LAST PARAMETER DLD #WRBF+28 GET THE CONTROL gHMODE TIMELIMIT SZA,RSS IF NOT SPECIFIED, JMP MODEX USE THE DEFAULT VALUE CPA D1 IF PARAMETER NOT NUMERIC SSB OR IF NEGATIVE, JMP MODER THE PARAMETER IS INCORRECT! LDA 1 MPY C3 CONVERT TO LOOP COUNTER CMA,INA AND COMPLEMENT STA CMTM SAVE FINAL VALUE * MODEX LDA XMTM GET THE TRANSMIT TIMEOUT VALUE. CMA,INA MAKE IT POSITIVE. ADA RCTM ADD THE NEGATIVE RECEIVE TIMEOUT. SSA,RSS IF RECEIVE T.O. IS <= TRANSMIT T.O., JMP MODER THEN THE VALUES ARE INCORRECT! * LDA TIME SOURCE ADDRESS = LOCAL ARRAY. LDB TIMAD DESTINATION = EXTERNAL ARRAY. JSB .MVW MOVE THE MODIFIED TIMEOUT AND DEF C6 CONTROL VALUES TO EXTERNAL STORAGE. NOP * MEXIT LDA RTNDF GET THE RETURN-TABLE POINTER. ADA MODSW COMPUTE THE RETURN ADDRESS, AND JMP A,I RETURN TO THE SPECIFIED PROCESS. * RTNDF DEF *+1,I RETURN FOR NEXT INPUT FROM: DEF TTRD CONSOLE (MODSW=0) DEF LURD SPECIFIED LU (MODSW=1) DEF FLRD CONFIG. FILE (MODSW=2) * MODER LDB DEC48 REPORT AN ERROR IN THE JSB REPOR TIMEOUT & CONTROL PARAMETERS. JMP MEXIT EXIT: OLD VALUES INTACT! * * ************************************************************************** * BIT MODIFICATION SUBROUTINE * * CALLING SEQUENCE: LDA MASK 1'S IN BIT-POSITIONS TO BE REFERENCED. * LDB DATA 1'S/0'S IN BIT-POSITIONS TO BE MODIFIED. * JSB MODBT CHANGE ONLY MASKED BITS. * DEF WORD ADDRESS OF WORD TO BE MODIFIED. * ************************************************************************** * MODBT NOP STA MSKSV SAVE THE MASK, TEMPORARILY. LDA MODBT,I GET ADDRESS OF WORD TO BE MODIFIED. STA MPNTR SAVE THE POINTER. CK ISZ MODBT ADVANCE THE EXIT POINTER. LDA MSKSV GET THE BIT MASK AGAIN. CMA PREPARE TO EXCLUDE THE OLD BITS. AND MPNTR,I REMOVE THE OLD BITS. IOR B INCLUDE THE NEW ONES. STA MPNTR,I RESTORE THE MODIFIED WORD. JMP MODBT,I RETURN (P+2). * ********************************************************************** * PARAMETER CHECKING ROUTINE. ********************************************************************** * PCHEK NOP ISZ MDCNT DECREMENT THE PARAMETER COUNTER. JMP PCHEK,I MORE TO PROCESS--RETURN. JMP MODEX ALL DONE--WRAP IT UP. ********************************************************************** SKP ********************************************************************** * MINIMUM TIMEOUT VALUE VERIFICATION ROUTINE. * * CALLING SEQUENCE: LDA TYPE PARSED PARAMETER TYPE (1, ELSE ERROR). * LDB VALUE PARAMETER VALUE ( POSITIVE, <=32767 ). * JSB TMIN * DEF MINVL MINIMUM VALUE (NEGATIVE). * DEF STOR ADDRESS FOR STORAGE OF NEGATED VALUE. ************************************************************************ * TMIN NOP CPA D1 IF PARSED-PARAMETER TYPE IS NUMERIC, JMP *+2 THEN CONTINUE; ELSE, JMP MODER THE PARAMETER TYPE IS INCORRECT! LDA TMIN,I GET THE MINIMUM VALUE ADDRESS. ISZ TMIN ADVANCE TO STORAGE POINTER. LDA A,I GET THE MINIMUM VALUE (NEGATIVE). SSA,RSS IF IT'S NOT NEGATIVE, JMP MODER INDICATE AN ERROR! ADA B IF THE SUPPLIED VALUE SSA IS LESS THAN THE MINIMUM, JMP MODER INDICATE THE ERROR! LDA TMIN,I GET THE STORAGE ADDRESS. ISZ TMIN ADVANCE THE EXIT POINTER. CMB,INB NEGATE THE SUPPLIED VALUE, STB A,I AND RETURN IT TO SPECIFIED LOC'N. JMP TMIN,I RETURN. * ****************************************************************** * ENTRY TO SWITCH ROUTINE FOR CONFIGURATION INPUT ****************************************************************** * SWCH2 JSB SWTCH SZA GOOD COMMAND? JMP MODER NO, REPORT ERROR JMP MEXIT YEP, CONTINUE WITH NEXT RECORD ****************************************************************** SKP ****************************************************************** * #S COMMAND PROCESSOR TO SWITCH DIAGNOSTICS AND TRACE CAPABILITY * ON AND OFF ******************************************************************** * SWTCH NOP REGISTERS MEANINGLESS JSB PARSE INTERPRET USER STRING DEF *+4 DEF #RDBF DEF MCNT CHAR COUNT DEF #WRBF RESULTANT * LDA #WRBF+32 FETCH # OF PARAMS CPA C3 EQUAL TO 3? RSS JMP SWER NO, SWITCH ERROR! * LDA #WRBF+5 FETCH 2ND PARAM (1ST=#S) AND M1774 STRIP TO UPPER BYTE CLB CPA "D" LDB DFGAD POINT TO DIAGNOSTIC FLAG CPA "T" LDB TFGAD POINT TO TRACE FLAG SZB,RSS EITHER D OR T? JMP SWER NO, SWITCH ERROR * STB SWAD SAVE LOC TO CHANGE LDA #WRBF+9 FETCH 3RD PARAM CLB,CLE CPA "ON" CCB,CCE CPA "OF" CCE SEZ,RSS ON OR OFF? JMP SWER NOPE, ERROR AGAIN STB SWAD,I SET APPROPRIATE SWITCH CLA,RSS EXIT WITH A=0 IF GOOD SWER CCA ELSE A=-1 JMP SWTCH,I * "D" OCT 042000 "T" OCT 052000 "ON" ASC 1,ON "OF" ASC 1,OF SWAD NOP DFGAD DEF DIAGF TFGAD DEF #TFLG ********************************************************************** UNL XIF LST SKP **************************************************************************** * THESE SUBROUTINES INTERPRET A CONFIGURATION DATA RECORD, * AND SELECT THE APPROPRIATE I/O PROCESvSES. UNL IFZ LST * THE ROUTINE 'IOPEN' IS CALLED TO OPEN/CREATE ANY FILE, IF SPECIFIED. UNL XIF LST **************************************************************************** * CONFG NOP ENTRY TO CONFIGURE I/O STA P3 INITIALIZE LU POINTERS STA P4 STA P5 LDA C.3 INITIALIZE THE STREAM-COUNTER STA P2 FOR THREE PARAMETERS. LDA POIN RESET PARAMETER STA PPOIN POINTERS LDA RDBUA GET BUFFER ADDRESS RAL SHIFT LEFT FOR CHARACTER ADDRESS STA BBUFA INITIALIZE GET BYTE ROUTINE BUMP EQU * UNL IFZ LST LDB OPNA GET ADDRESS OF NAME BUFFER LDA CH.BL INITIALIZE STA B,I THE INB NAME STA B,I BUFFER INB WITH STA B,I BLANKS. CLA CLEAR THE STA NEGFL NEGATIVE SUBPARAMETER FLAG, STA TYPFL AND THE SUBPARAMETER TYPE-FLAG. STA ISEC SET FOR NO SECURITY CODE. STA ICR ESTABLISH DEFAULT CARTRIDGE NUMBER. UNL XIF LST * * GET THE FIRST CHARACTER, IGNORING BLANKS. * JSB GETCR GET THE CHARACTER. JMP NEXT COMMA: END OF PARAMETER. JMP NEREX COLON: SUBPARAM. INVALID AT THIS POINT. STB PPOIN,I CLEAR OLD DEVICE & NUMERIC ACCUMULATOR. SEZ,RSS ALPHA OR NUMERIC CHARACTER? UNL IFZ LST JMP FILNM ALPHA--PROCESS A FILE NAME. UNL XIF IFN LST JMP NEREX ALPHA--FILES INVALID FOR NON-FMP! UNL XIF LST JSB NUMBR NUMERIC--PROCESS AN LU REFERENCE. JSB GETCR GET THE NEXT NUMBER--IF ANY. JMP NEXT COMMA: END OF LU SPECIFICATION. JMP NEREX COLON: INVALID FOR LU SPEC. SEZ,RSS IF IT IS NOT NUMERIC, JMP NEREX THEN THoDE LU SPEC. IS IN ERROR! JSB NUMBR COMPLETE THE LU SPECIFICATION. JSB GETCR SEARCH FOR THE DELIMITER. JMP NEXT FOUND: PROCESS THE NEXT PARAMETER. JMP NEREX COLON IS UNACCEPTABLE! JMP NEREX SO IS ANYTHING, BUT A COMMA! * UNL IFZ LST FILNM LDB OPNA FORM A RBL BYTE ADDRESS STB BBUFB FOR THE FILE NAME. LDB C.7 ESTABLISH COUNTER FOR STB P1 MAXIMUM FILE-NAME SIZE. * FLOOP JSB STRBY ADD THE CHARACTER TO THE NAME BUFFER. JSB GETCR GET THE NEXT CHARACTER. JMP FLOPN COMMA: COMPLETE THE FILE PROCESSING. JMP SUBP COLON: PROCESS SUBPARAMETERS. ISZ P1 ANY MORE CHARACTERS ACCEPTABLE? JMP FLOOP YES, CONTINUE FILE-NAME PROCESSING. JMP NEREX NO--TOO MANY CHARACTERS IN NAME! * SUBP LDA C.6 INITIALIZE FOR 1RST PARAMETER SIZE, LDB D1 AND ESTABLISH IT'S REFERENCE NUMBER. DST CHCNT SAVE THE CONTROL VALUES. NXTCH JSB GETCR GET THE NEXT CHARACTER. JMP ENDSP COMMA/EOR: END OF SUBPARAMETERS. JMP ENDSP COLON: TERMINATE THE SUBPARAMETER. ISZ CHCNT HAVE ALL CHARACTERS BEEN PROCESSED? JMP *+2 NO--CONTINUE PROCESSING. JMP ENDSP YES--TERMINATE THE SUBPARAMETER. CCB,SEZ,RSS ALPHA OR NUMERIC ? JMP NEGCK ALPHA--GO TO CHECK FOR '-'. * LDB TYPFL GET THE CURRENT SUBPARAMETER TYPE. ERB,BLS POSITION ALPHA(LSB) TO , FOR TEST. SEZ,CLE IF WE WERE PROCESSING AN ALPHA SUBP., JMP ASTOR THEN PROCESS THIS NUMBER AS ASCII. STB TYPFL SET THE SUBP. TYPE = NUMERIC (BIT#15). JSB NUMBR GO TO PROCESS THE NUMBER. JMP NXTCH LOOK FOR CONTINUATION/TERMINATION. * NEGCK CPA MINUS IS THE CHARACTER AN ASCII '-' ? ALF,SLA,ALF YES--POSITION TO UPPER BYTE, & SKIP. JMP ALCHK NO--CONTINUE ALPHA PROCESNLHSING. STA NEGFL SET THE NEGATIVE SUBP. FLAG. ADB CHCNT RESET THE MAXIMUM STB CHCNT ALLOWABLE CHARACTER COUNT. JMP NXTCH LOOK FOR CONTINUATION/TERMINATION. * ALCHK LDB TYPFL GET THE SUBP. TYPE-FLAG. SSB IF PREVIOUS CHARACTERS WERE NUMERIC, JMP NEREX THEN AN ALPHA CHARACTER IS INCORRECT! CLB,INB SET THE SUBPARAMETER TYPE-FLAG STB TYPFL FOR AN ALPHA SUBPARAMETER (LSB=1). * ASTOR LDB PPOIN,I GET THE PREVIOUS CHARACTER--IF ANY. SZB,RSS SKIP, IF ONE HAS ALREADY BEEN SAVED; ADB NEGFL ELSE, CHECK FOR A SAVED 'MINUS'. SZB,RSS IF NOTHING HAS BEEN SAVED, ALF,ALF POSITION NEW ONE TO UPPER BYTE. IOR B INCLUDE SAVED CHAR., IF THIS IS SECOND. STA PPOIN,I SAVE THE RESULT. SZB,RSS IF THIS IS FIRST CHARACTER, JMP NXTCH THEN GO TO GET THE NEXT ONE--IF ANY; ?N JMP SUBSV ELSE, SECURITY IS COMPLETE--SAVE IT. * SKP ENDSP LDA PPOIN,I GET THE SUBPARAMETER VALUE. LDB TYPFL GET THE SUBPARAMETER TYPE. SZB,RSS IF THE PARAMETER HAS BEEN DEFAULTED, JMP SUBSV GO TO MAKE IT A ZERO. SSB,RSS IF THE TYPE IS ALPHA, JMP PADCK GO TO SEE IF PADDING IS NEEDED; LDB NEGFL ELSE, GET THE NEGATIVE SUBP. FLAG. SZB IF THE FLAG IS SET, CMA,INA THEN NEGATE THE SUBPARAMETER VALUE, JMP SUBSV AND GO TO SAVE THE RESULT. * PADCK AND C377 ISOLATE THE LOWER BYTE. SZA,RSS IF IT IS NULL, LDA C40 THEN PAD IT WITH A BLANK. IOR PPOIN,I FORM COMPLETE ASCII PARAMETER. * SUBSV LDB SUBDF GET THE SUBPARAMETER POINTER. ADB SUBCN COMPUTE THE CORRECT SUBP. ADDRESS. STA B,I CONFIGURE THE SUBPARAMETER. CLB PREPARE TO CLEAR THE FLAGS. LDA LASTC GET THE LAST CHARACTER PROCESSED. CPA CH.CO IF IT WAS A COMMA, THEN JMP FLOPN COMPLETE SUBPARAMETER PROCESSING. CPA COLON IF IT WAS A COLON, THEN JMP NXSUB PREPARE FOR THE NEXT SUBPARAMETER. * DELIM JSB GETCR SEARCH FOR THE NEXT DELIMITER. JMP FLOPN FOUND A COMMA OR END-OF-RECORD. JMP NXSUB FOUND A COLON--PROCESS NEXT SUBPARAMETER. JMP DELIM CONTINUE THE SEARCH. * NXSUB STB NEGFL CLEAR FLAGS, ETC. STB TYPFL FOR THE NEXT STB PPOIN,I SUBPARAMETER--IF ANY. * LDA C.6 REMAINING SUBPARAMETERS = 6 CHARS. LDB SUBCN GET THE CURRENT SUBP. INDICATOR. INB ADVANCE TO THE NEXT ONE. CPB MAXSP HAVE WE PROCESSED ALL SUBPARAMETERS? JMP DELIM YES--IGNORE ANYTHING ELSE. JMP SUBP+2 NO--PROCESS THE NEXT ONE. * FLOPN JSB IOPEN OPEN/CREATE THE SPECIFIED FILE. JMP NEXT GO TO PROCESS THE NEXT PARAMETER. ****************************c**************************************** UNL XIF LST SKP ******************************************************************** NUMBR NOP NUMERIC PARAMETER PROCESSING. AND D15 ISOLATE THE PERTINENT BITS. LDB PPOIN,I GET THE PREVIOUS VALUE. RBL MULTIPLY ADA B BY TEN RBL,RBL AND ADD ADA B THE NEW VALUE. SSA IF THE VALUE IS TOO LARGE, JMP NEREX THEN REPORT THE ERROR! STA PPOIN,I SAVE THE RESULT. JMP NUMBR,I GO BACK FOR MORE--IF ANY. * NEREX LDB DEC43 REPORT JSB REPOR CONFIGURATION ERROR (#43)! JMP CONFG,I TAKE THE ERROR EXIT. * UNL IFZ LST SUBDF DEF * SUBPARAMETER STORAGE POINTER. ISEC NOP FILE SECURITY CODE. ICR NOP CARTRIDGE REFERENCE NUMBER. NEGFL NOP NEGATIVE SUBPARAMETER FLAG. TYPFL NOP SUBP. TYPE (BIT#15=NUMERIC, BIT#1=ALPHA). CHCNT NOP SUBPARAMETER CHARACTER COUNTER. SUBCN NOP SUBPARAMETER COUNTER. UNL XIF LST LASTC NOP LAST CHARACTER. ***************************************************************************** SKP ***************************************************************************** * 'GETCR' GETS THE NEXT CHARACTER FROM THE READ BUFFER. BLANKS ARE IGNORED, * BUT COUNTED. NOTE: 'RDLEN' INITIALIZED = -(CHARACTER COUNT +1). * * JSB GETCR * < P+1 > COMMA DETECTED (A=',' B=0); OR END OF RECORD (A&B =0) * < P+2 > COLON DETECTED (A=':' B=0) * < P+3 > A=CHARACTER(LOWER BYTE) B=0: ALPHA:=0; NUMERIC:=1. *************************************************************************** * GETCR NOP CLA PREPARE FOR END-OF-RECORD EXIT. LDB RDLEN GET THE REMAINING CHARACTER COUNT. INB,SZB,RSS IF NONE REMAIN, JMP GETCR,I TAKE THE END-OF-RECORD EXIT. e STB RDLEN SAVE REMAINING CHARACTER COUNT. JSB GETBY GET THE NEXT CHARACTER. STA LASTC SAVE IT FOR LATER INSPECTION. CLB,CLE RETURN TYPE=ALPHA FOR DELIMITERS. CPA C40 IF IT'S A BLANK, JMP GETCR+1 IGNORE AND GET THE NEXT ONE. CPA CH.CO IS IT A COMMA? JMP GETCR,I YES--TAKE COMMA EXIT (P+1). ISZ GETCR PREPARE FOR COLON EXIT(P+2). CPA COLON IS IT A COLON? JMP GETCR,I YES--TAKE THE COLON EXIT. ISZ GETCR PREPARE FOR DATA-CHAR. EXIT(P+3). LDB A TEST DATA-TYPE IN . ADB C.60 SUBTRACT 60B. CLE,SSB IF IT'S <60B, CME,RSS TAKE THE ALPHA RETURN =0. ADB C.12 SUBTRACT 12B FOR NUMERIC TEST. CLB,CME IF IT'S NUMERIC (<72B) =1. JMP GETCR,I RETURN WITH =CHAR & =TYPE. * NEXT ISZ PPOIN BUMP TO NEXT LU ISZ P2 BUMP LU COUNT & TEST JMP BUMP DO NEXT LU * ISZ CONFG BUMP TO GOOD RETURN JMP CONFG,I EXIT CONFIGURATION * UNL IFZ LST * ER3EX JSB FERR REPORT FILE ERROR JMP CONFG,I AND TAKE ERROR EXIT. UNL XIF LST ************************************************************************* SKP ************************************************************************* * SET UP STREAM LU'S AND PROCESS POINTERS. LU VALIDITY IS CHECKED. * ON ENTRY, P3,P4,P5 ARE SET: NEG-IGNORE, ZERO-DEFAULT, POS-SET UP LU. * NOTE: TRANSFER OF COMMAND (#C,#T) FROM FILE TO LU CLOSES THE FILE. ************************************************************************* * START NOP LDA RDLK SZA,RSS JMP NLOCK SKIP IF INPUT LU NOT LOCKED, JSB LURQ ELSE UNLOCK INPUT LU. DEF *+4 DEF ZERO DEF RDLU DEF C1 CLA RESET INPUT LOCK FLAG STA RDLK NLOCK LDA P3 GET INPUT-STREAM SPECIFICATION. J SSA IF IT'S NEGATIVE (FILE/IGNORE), JMP RLUOK GO TO PROCESS THE LIST-STREAM. * SZA,RSS IF IT'S 0, LDA C5 USE THE DEFAULT LU #5. JSB LUCHK VERIFY THE LU'S VALIDITY. STA RDLU SAVE THE NEW INPUT-STREAM LU. LDA IORDA = NEW READ-PROCESS ADDRESS. UNL IFZ LST CPA IORDP IF OLD INPUT-STREAM WAS VIA 'EXEC', JMP NRFIL THEN NO NEED TO CLOSE INPUT FILE. UNL XIF LST STA IORDP SET NEW INPUT-STREAM PROCESS ADDRESS. UNL IFZ LST * JSB CLOSE CLOSE DEF *+2 THE FORMER DEF #RDCB INPUT-STREAM FILE. * UNL XIF LST NRFIL JSB GTWST GET THE DEVICE TYPE-CODE. LDB RDLU SZA,RSS IF ITS AN INTERACTIVE DEVICE JMP SYSET RESET THE SYSTEM LU JSB LURQ ELSE LOCK THE INPUT LU. DEF *+4 DEF C1 DEF RDLU DEF C1 ISZ RDLK SET INPUT LOCK FLAG. RSS SYSET STB SYSLU * RLUOK LDA P4 GET LIST-STREAM SPECIFICATION. SSA IF IT'S NEGATIVE, JMP LLUOK GO TO PROCESS THE PUNCH-STREAM. * SZA,RSS IF IT'S ZERO, LDA C6 SUBSTITUTE LU=6 JSB LUCHK VERIFY THE LU'S VALIDITY. STA LSTLU SAVE THE NEW LIST-STREAM LU. STA USELS INDICATE: DEVICE NOT YET USED. LDA IOLSA = NEW LIST-PROCESS ADDRESS. UNL IFZ LST CPA IOLSP IF OLD LIST-STREAM WAS VIA 'EXEC', JMP LLUOK THEN NO NEED TO CLOSE LIST FILE. UNL XIF LST STA IOLSP SET NEW LIST-STREAM PROCESS ADDRESS. UNL IFZ LST * JSB CLOSE CLOSE DEF *+2 THE FORMER DEF #LDCB LIST-STREAM FILE. UNL XIF LST * SKP LLUOK LDA P5 GET THE PUNCH-STREAM SPECIFICATION.  SSA IF IT'S NEGATIVE, JMP PLUOK COMPLETE THE PROCESS. * SZA,RSS IF IT'S ZERO, LDA C4 SUBSTITUTE LU=4 JSB LUCHK VERIFY THE LU'S VALIDITY. STA PUNLU SAVE NEW PUNCH-STREAM LU. STA USEPU INDICATE: DEVICE NOT YET USED. LDA IOPUA = NEW PUNCH-PROCESS ADDRESS. UNL IFZ LST CPA IOPUP IF OLD PUNCH-STREAM WAS VIA 'EXEC', JMP PLUOK THEN NO NEED TO CLOSE PUNCH FILE. UNL XIF LST STA IOPUP SET NEW PUNCH-STREAM PROCESS ADDRESS. UNL IFZ LST * JSB CLOSE CLOSE DEF *+2 THE FORMER DEF #PDCB PUNCH-STREAM FILE. * UNL XIF LST PLUOK ISZ START INDICATE GOOD RETURN.URN JMP START,I * * LUCHK NOP ENTRY TO VERIFY EQUIP TYPE <30 STA OUTCW GET EQT TYPE JSB GTWST CPA D1 IF ITS PAPER TAPE JMP OPTRP OPEN DEVICE ADA C.30 SSA IF ITS BAD, JMP LUOKX LDB DEC44 REPORT ERROR AND JSB REPOR JMP START,I DO P+1 RETURN * * OPTRP LDA C700 LOAD LEADER SKIP CONTROL WORD JSB GOCON ISSUE CONTROL REQUEST * LUOKX LDA OUTCW ELSE RESTORE LU JMP LUCHK,I AND EXIT * ************************************************************************* * HALT1 NOP ENTRY TO HALT THE COMPUTER JSB $LIBR CALL LIBR NOP FORMAT IS PRIVILEDGED HLT 27B HALT JSB $LIBX CALL LIBX DEF HALT1 EXIT ADDRESS *************************************************************************** SKP **************************************************************************** * THIS SECTION ESTABLISHES THE COMMUNICATIONS LINE, AND TRANSFERS * CONTROL TO THE APPROPRIATE PROCESS.L IF LOCAL DIAL IS * SPECIFIED, THE PROGRAM, #DIAL WILL BE SCHEDULED WITH WAIT. **************************************************************************** * * EXAMINE NEED FOR CORE-LOCK AND/OR MAP SWITCHING (DMS). * INITL CLA PREPARE FOR UNDEFINED: $OPSY (RTE-C). LDA $OPSY GET THE OP-SYSTEM SPECIFICATION. AND D2 ISOLATE DMS(DYNAMIC MAPPING) BIT(#1), STA B AND TRANSFER THE DMS FLAG TO . CMB,INB,SZB,RSS NEGATE AND SUBTRACT ONE: LDB C.6 FORCE LARGE VALUE FOR NON-DMS SYSTEMS. INB =-1: DMS; = -5: NON-DMS SYSTEM. LDA XEQT GET I.D. SEGMENT ADDRESS. ADA D14 POINT TO THE FIFTEENTH ENTRY. LDA A,I GET THE ENTRY. AND D15 ISOLATE THE PROGRAM TYPE-CODE (RTE-C=1). CPA D2 FOREGROUND DISC RESIDENT? JMP BSC? YES--CHECK LOCATION OF #BSC. CPA C3 BACKGROUND DISC RESIDENT? JMP BSC? YES--CHECK LOCATION OF #BSC. JMP BUF? #BSC RESIDENT: NO MAP SWITCHING--YET. * BSC? LDA RTORG GET ORIGIN OF REAL TIME AREA. CMA,INA IF #BSC RESIDES ADA BSCAD BELOW THIS AREA, THEN SSA IT IS IN SSGA OR THE RESIDENT LIBRARY, JMP BUF? SO NO NEED TO LOCK CORE. * INB =0: DMS; = -4: NON-DMS SYSTEM. JSB EXEC #BSC IS IN "SWAP TERRITORY", DEF BUF? SO LOCK UP DEF D22 THE PARTITION DEF D1 TO AVOID A CATASTROPHE! * BUF? CPB C.1 IF = -1, THEN JMP *+2 CONTINUE DMS PROCESSING; JMP SETSW ELSE, SET THE MAP SWITCH, NOW. * LDA RTORG IF THE #COMN BUFFERS CMA,INA ARE LOCATED IN THE ADA COMBA SUBSYSTEM GLOBAL AREA, SSA,RSS THEN SET THE SWITCH = -1; ELSE, INB =0: MAP SWITCHING REQUIRED. SETSW STB MAPSW SET MAP-SWITCHING PARAMETER FOR DVR50. **********************b***************************************************** * * NOTE: WILL BE SET AS FOLLOWS: 1. NON-DMS =-(5,4), SPECIFYING * THAT NO MAP INSTRUCTIONS ARE TO BE EXECUTED. 2. DMS =-1 (#BSC * AND #COMN ARE IN SYSTEM MAP) USE DMS STATUS INSTRUCTIONS, ONLY. 3. * DMS =0 (EITHER/BOTH #BSC & #COMN NOT IN SYSTEM MAP) SWITCH MAPS. * **************************************************************************** SKP * INITIALIZE THE DRIVER AND SAVE THE ID PARAMETER * LDB D.16 SET REPEAT COUNTER TO -16 STB WAITC WAIT1 ISZ WAITC IF LESS THAN 15 RETRIES, JMP *+2 ALLOW ANOTHER INITIALIZATION ATTEMPT JMP DVRUN ELSE REPORT DVR50 UNAVAILABLE. LDB DEC50 REPORT INITIAL CALL JSB DIARP * JSB EXEC CALL EXEC TO INITIALIZE THE DRIVER DEF *+4 DEF C3 CONTROL REQUEST DEF CWD37 INITIALIZATION REQUEST DEF IPRM INITIALIZATION PARAMETER BUFFER * * ON RETURN, A=STATUS, B=SECURITY CODE * STB IDPRM SAVE SECURITY CODE SZB,RSS REQUEST ACCEPTED? JMP WAIT1 NO--WAIT, THEN TRY AGAIN. * LDA ASFLG GET ANSWER FLAG SSA ANSWER? JMP A.ANS YES,GO TO AUTO ANSWER SECTION * * DIAL LINE * LDB DEC51 JSB DIARP REPORT REQUEST ISSUED JSB EXEC NOW PROCEED WITH DIALING DEF *+5 SCHEDULE PROGRAM #DIAL DEF D9 WITH WAIT DEF #DIAL DEF SYSLU PARAMETER #1 IS SYSTEM LU DEF ZERO #2 =0: MAKE CONNECTION. * * SET UP HARDWARE TO LOOK FOR SUCCESSFUL CONNECTION * LDB DEC52 JSB DIARP REPORT REQUEST ISSUED * LDB ACW34 DO HANDSHAKE REQUEST JSB LINCN JMP REDI. ADDRESS OF FAILURE SERVICE-ROUTINE * LDA INFLG INPUT AVAILABLE? SSA,RSS JMP X.EOT NO, LISTEN FOR A WHILE, THEN DISCONNEKCT JMP XMITP YES, GO PROCESS THE FIRST CARD. **************************************************************************** SKP **************************************************************************** * PRINT ERROR MESSAGE (NO CONTACT) & RESTART DIAL OPERATIONS * REDI. LDB DEC41 JSB REPOR JMP EXSTA ABORT * **************************************************************************** * WAIT2 ISZ WAITC BUMP AND TEST REPEAT COUNT JMP A.ANS GO AHEAD AND TRY IT AGAIN. DVRUN LDB DEC45 REPORT "DVR50 UNAVAILABLE". JSB REPOR JMP EXSTA AND ABORT * * THIS SECTION PERFORMS AUTO ANSWER * A.ANS LDB DEC67 REPORT REQUEST ISSUED JSB DIARP * LDB ACW33 DO AUTO ANSWER JSB LINCN * JMP BRKCK REQUEST REJECT, CHECK FOR A BREAK. LDA RCVFL GET STATE FLAG SSA,RSS ARE WE IN RECEIVE MODE? JMP BRKCK NO, TEST FOR OPERATOR REQUESTED BREAK STA RVIFL YES, SET RVI FLAG FOR AUTO ANSWER JMP RECVP GO TO RECEIVE PROCESSOR * BRKCK EQU * CHECK FOR OPERATOR BREAK REQUEST UNL IFZ LST JSB IFBRK CHECK FOR OPERATOR BREAK REQUEST DEF *+1 UNL XIF IFN LST JSB #INGT UNL XIF LST SSA,RSS TEST FOR BREAK REQUEST. JMP WAIT2 NONE: DO AUTO ANSWER AGAIN. LDA INFLG BREAK: GET INPUT-AVAILABLE FLAG. SSA IF INPUT IS AVAILABLE, JMP XMITP GO TO PROCESS INPUT STREAM; JMP EXIT ELSE GO TO TERMINATION. * *************************************************************************** SKP *************************************************************************** * * THIS IS THE BEGINNING OF THE TRANSMIT PROCESS. * IT IS ENTERED AFTER A SUCCESSFUL HANDSHAKE * OR SUCCESSFUL RECEIVE TO SEND CALL. * * THED- PROCESS: 1. READ A RECORD * 2. IF THERE IS ROOM, PUT IT IN BUFFER, AND REPEAT 1 * 3. IF THERE IS NO ROOM, TRANSMIT THE BUFFER, AND * 4. GO TO 1. * 5. IF AN EOF IS READ, SEND AN EOT,AND EXIT TO * THE APPROPRIATE PROCESS. * **************************************************************************** * XMITP CLA STA RVIFL RESET RVI AND EOT FLAGS STA EOTXM RSET LDA COMBA YES, RESET COMM BUFFER RAL MULTIPLY BY TWO STA BBUFB STORE IN PUT ROUTINE LDA RDBUA RESET I/O BUFFER START ADDRESS RAL STA BBUFA LDA D.400 GET LENGTH OF BUFFER STA WRCNT SET CHAR COUNTER LDA IOBFL GET IO BUFFER FLAG SSA IF DATA IS IN THE BUFFER, JMP REBID YES. GO CHECK IF WE HAVE LINE. RVITS LDA RVIFL GET RVI FLAG SSA RVI FLAG SET? JMP EOTST YES GO DO TURN-AROUND JSB IORDP,I GO READ CARD * * ROUTINE RETURNS CARD IN BUFFER WITH ADDRESS GET * INTO GETBYTE ROUTINE, AND CHARACTER COUNT(-)IN CNT2 * IF EOF WAS READ, COUNT = ZERO. EM IS ON END OF BUFFER * AND IOBFL IS SET NEGATIVE * LDA CNT2 GET CHARACTER COUNT SZA,RSS COUNT = 0 (EOF) JMP EOTS1 YES GO PROCESS LDA WRCNT GET COMM BUF COUNT CPA D.400 EQUAL TO -400? (EMPTY?) JMP REBID YES. GO CHECK IF WE HAVE THE LINE ADA D8 NO MAKE AVAILABLE COUNT + LESS 8 CMA,INA ADA CNT2 SUBTRACT NEW CHARACTER COUNT SSA WILL NEW RECORD FIT IN BUFFER? JMP ETBPT NO. GO PUT ETB IN BUFF & XMIT LDA ITB YES. GET ITB CHAR JSB STRBY PUT IT IN THE BUFFER ISZ WRCNT BUMP COUNT JMP STXST GO PROCESS DATA * irSKP * REBID LDA XMTFL SSA IF ALREADY IS XMIT MODE, JMP STXST BYPASS LINE BID. LDA RCVFL SSA JMP BRNCH LDB DEC57 JSB DIARP REPORT: RECEIVE-TO-SEND LDB ACW35 JSB LINCN REQUEST TRANSMIT LINE MODE. JMP REDI. ERROR WAS DETECTED! * LDA XMTFL IF TRANSMIT MODE ACHIEVED, SSA,RSS THEN SKIP TO SEND THE DATA; JMP BRNCH ELSE DETERMINE THE NEXT MOVE. STXST LDA CNT2 GET CHARACTER COUNT (NEW BUFFER) ADA C.2 BUMP FOR STX AND ITB LDB TRFLG GET TRANS FLAG SZB,RSS IF TRANSPARENT MODE, ADA C.1 BUMP COUNT JSB PUTWD PUT LENGTH WORD INTO BUFFER * LDA TRFLG GET TRANSPARENCY FLAG SZA IF NON TRANSPAR, JMP *+4 FORGET DLE LDA DLE OTHERWISE, GET DLE, JSB STRBY AND PUT IT IN BUFFER ISZ WRCNT AND BUMP COUNT * LDA STX LOAD STX JSB STRBY PUT CHAR IN BUFFER ISZ WRCNT BUMP COUNT TRSFR JSB GETBY GET CHARACTER * SKP * * THIS ROUTINE TRANSLATES XMIT DATA-CHARACTERS FROM * INTERNAL HP-ASCII CODE TO THE USER-SPECIFIED LINE CODE: * EITHER EBCDIC, OR ASCII WITH ODD PARITY. * LDB TRFLG GET INPUT TRANSLATE FLAG SZB,RSS TRANSLATE CHARACTER JMP STFCR EXIT ROUTINE * AND C177 MASK OF EXTRA BITS MOD1 NOP RSS HERE IF EBCDIC JMP TRASC DO ASCII TRANSLATION CLE,ERA FIND RESULT FROM TABLE, OR ADA TABLE LDA A,I SEZ,RSS ALF2 ALF,ALF AND C377 JMP STFCR TRASC LDB C.7 SET COUNTER TO -7 STB TRAN2 CMB,INB INITIALIZE PARITY TO ODD RAL RAR,SLA TEST BIT AND IF SET INB BUMP PARITY ISZ TRAN2 4 IF MORE BITS, JMP *-3 DO THEM ERB ELSE ISOLATE PARITY BIT RAR,ERA AND PUT IT INTO DATA ALF,ALF REPOSITION RESULT STFCR JSB STRBY PUT CHAR IN XMIT BUFF ISZ WRCNT BUMP LINE COUNT ISZ CNT2 BUMP &TEST INPUT COUNT JMP TRSFR GO TRANSFER NEXT CHARACTER CLA SET A= 0 STA IOBFL CLEAR I/O BUFFER FLAG JMP RVITS GO CHECK FOR RVI & DO NEXT RCD **************************************************************************** **************************************************************************** SKP *************************************************************************** * * GENERAL STORAGE, AND CONSTANTS * *************************************************************************** * A EQU 0 B EQU 1 XEQT EQU 1717B RTORG EQU 1746B BPA1 EQU 1742B * LISFL NOP RECCT NOP ACWX NOP RECFG NOP BRKFL NOP EOTFL NOP M1774 OCT 177400 FCRDF NOP FCDRD NOP ACW27 DEF CWD27 ACW30 DEF CWD30 ACW31 DEF CWD31 ACW32 DEF CWD32 ACW33 DEF CWD33 ACW34 DEF CWD34 ACW35 DEF CWD35 ACW36 DEF CWD36 * POIN DEF P3 WRBFA DEF #WRBF WAITB NOP WAITC NOP * XMTFL NOP RCVFL NOP OUTCW NOP * PROMP OCT 3443,57400 BELL,#,LEFT ARROW,NULL * PPOIN NOP CNT3 NOP * RDLEN NOP UNL IFZ LST OPNA DEF OPNAM OPNAM BSS 3 UNL XIF LST XPRFL NOP * IORDA DEF IORDL READ I/O IOLSA DEF IOLSL WRITE I/O IOPUA DEF IOPUL PUNCH I/O * IORDP DEF IORDL READ PROCESS POINTER IOLSP DEF IOLSL LIST PROCESSER POINTER IOPUP DEF IOPUL PUNCH PROCESS POINTER IODRT DEF * BASE OF PROCESS TABLE IOUTP DEF IOLSL POINTER FOR OUTPUT STREAM PROCESSING RDLU NOP RDLK NOP * SYSLU NOP HTBUW NOP P1 NOP P2 NOP P3 NOP P4 NOP P5 NOP P1ADD DEF P1 INFLG NOP TRFLG NOP ASFLG NOP DIAGF NOP ABORT NOP EOTXM NOP CH.CO OCT 54 * CWD00 NOP CWD27 NOP CWD30 NOP CWD31 NOP CWD32 NOP CWD33 NOP CWD34 NOP CWD35 NOP CWD36 NOP CWD37 NOP TLOG NOP LPCON NOP * HTBUA DEF HTBUF UNL IFN LST HTBUF BSS 15 UNL XIF IFZ LST HTBUF BSS 28 TIME EQU HTBUA RCTM EQU HTBUF XMTM EQU HTBUF+1 LGTM EQU HTBUF+2 TDWK EQU HTBUF+3 CMTM EQU HTBUF+4 CTRL EQU HTBUF+5 MODSW EQU HTBUF+6 MDCNT EQU HTBUF+7 MSKSV EQU HTBUF+8 MPNTR EQU HTBUF+9 MCNT EQU HTBUF+10 MAXSP OCT 3 UNL XIF LST TEMP4 NOP BBUFA NOP TEMP1 NOP BBUFB NOP TEMP2 NOP CH.BL ASC 1, OVFFL NOP * IPRM DEF *+1 DVR50/#BSC INITIALIZATION PARAMETERS. NOP SYNC: ASCII/LRC=26B; EBCDIC/CRC=100062B MAPSW NOP MAP SWITCH: 0,-1 =DMS; -X =NON-DMS. TIMAD NOP DIRECT ADDRESS OF TIMEOUT/CONTROL DATA. BSCAD DEF #BSC DIRECT ADDRESS OF #BSC ENTRY POINT. * LSTLU NOP LSTLK NOP PUNLU NOP PUNLK NOP IDPRM NOP DISFL NOP TEMP6 NOP RVIFL NOP * TST1 NOP TEMP3 NOP CNT1 NOP IOBFL NOP WRCNT NOP CNT2 NOP UNL IFZ LST FMFLG NOP UNL XIF LST SYASC OCT 26 SYEBC OCT 100062 *************************************************************************** SKP *************************************************************************** * A RANDOM LIST OF NUMBERS * ZERO OCT 0 C1 OCT 1 C2 OCT 2 C3 OCT 3 C4 OCT 4 C5 OCT 5 C6 OCT 6 C7 OCT 7 C11 OCT 11 C40 OCT 40 C50 OCT 50 C77 OCT 77 C100 OCT 100 C177 OCT 177 C200 OCT 200 C300 OCT 300 C377 OCT 377 C400 OCT 400 C700 OCT 700 C1000 OCT 1000 C1100 OCT 1100 C2700 OCT 2700 C60K OCT 60000 * C.1 OCT -1 C.2 OCT -2 C.3 OCT -3 C.4 OCT -4 C.5 OCT -5 C.6 OCT -6 C.7 OCT -7 C.12 OCT -12 C.30 OCRZNLHT -30 C.60 OCT -60 * D1 EQU C1 D2 EQU C2 D8 DEC 8 D9 DEC 9 D10 DEC 10 D13 DEC 13 D14 DEC 14 D15 DEC 15 D22 DEC 22 D24 DEC 24 D41 DEC 41 * D.8 DEC -8 D.9 DEC -9 D.10 DEC -10 D.11 DEC -11 D.12 DEC -12 D.16 DEC -16 D.55 DEC -55 D.80 DEC -80 D.82 DEC -82 D.100 DEC -100 D.145 DEC -145 D.400 DEC -400 D.424 DEC -424 *************************************************************************** 9N SKP *************************************************************************** * TABLE OF CONTROL CODES (LHW = EBCDIC, RHW = ASCII) * CODES OCT 001603 ETX OCT 023227 ETB OCT 023633 ESC OCT 002611 HT OCT 172064 CH.4 OCT 171463 CH.3 OCT 060521 SS OCT 161122 DS OCT 161723 TS OCT 140701 A OCT 141302 B OCT 141503 C OCT 142304 D OCT 142505 E OCT 143106 F OCT 143707 G OCT 144310 H OCT 040040 BLANK OCT 177577 MASK * DEFCH DEF CH.3 POINTS TO CARRAIGE CONTROL TABLE CODEX DEF CODES CODTB DEF *+1 CONTROL CODE TABLE ETX NOP ETB NOP ESC NOP HT NOP CH.4 NOP ESC SEQUENCES: THIS ONE INDICATES PUNCH, CH.3 NOP NEXT ELEVEN ARE CARRAIGE CONTROL CHARACTERS SS NOP DS NOP TS NOP A. NOP B. NOP C NOP D NOP E NOP F NOP G NOP H NOP BLANK NOP MASK NOP CODE# ABS CODTB-*+1 * SKP * PARALLEL TABLE OF CARRAIGE CONTROL SPECS: * CONCW NOP CONFIGURED CONTROL WORD * CONTA DEF * CONWL NOP THIS LOCATION REMEMBERS CURRENT CHOICE OCT 0 SINGLE SPACE OCT 1 DOUBLE SPACE OCT 2 TRIPLE SPACE DEC 63 DEC 61 DEC 60 DEC 59 DEC 61 DEC 60 DEC 59 DEC 62 * *************************************************************************** SKP *************************************************************************** * SOME SPECIAL CHARACTER DEFINITIONS * COLON OCT 72 MINUS OCT 55 ITB OCT 37 DLE OCT 20 STX OCT 2 SOH OCT 1 EM OCT 31 * #DIAL ASC 3,#DIAL ASC#C ASC 1,#C ASC#D EQU #DIAL ASC#E ASC 1,#E ASC#I ASC 1,#I ASC#P ASC 1,#P ASC#R ASC 1,#R ASC#S ASC 1,#S ASC#T ASC 1,#T ASC#W ASC 1,#W ASC#X ASC 1,#X ASC#! ASC 1,#! ASC#M ASC 1,#M "EB" ASC 1,EB "PA" ASC 1,PA "HA" ASC 1,HA * *************************************************************************** * TIMEOUTS * MINRC DEC -200 MINIMUM RECEIVE TIMEOUT: 2.0 SEC. MINXM EQU D.100 MINIMUM TRANSMIT TIMEOUT: 1.0 SEC. MINLT EQU D.400 MINIMUM LONG TIMEOUT: 4.0 SEC. MINTD EQU MINLT MINIMUM TTD/WACK SEQUENCES: 400 * *************************************************************************** SKP *************************************************************************** * MESSAGE TABLES *************************************************************************** * TEMPX NOP TEMP USED BY REPOR ASC00 ASC 1,00 ASC10 EQU C400 THIS CORRESPONDS TO TENS PLACE (ASCII) * * DEFINED MESSAGES: * DEC19 DEC 19 FOR FMGR ERRORS DEC20 DEC 20 DEC30 DEC 30 DEC40 DEC 40 DEC41 DEC 41 *42 UNUSED DEC43 DEC 43 DEC44 DEC 44 DEC45 DEC 45 DEC46 DEC 46 DEC47 DEC 47 DEC48 DEC 48 *49 UNUSED DEC50 DEC 50 DEC51 DEC 51 DEC52 DEC 52 DEC53 DEC 53 DEC54 DEC 54 DEC55 DEC 55 DEC56 DEC 56 DEC57 DEC 57 DEC58 DEC 58 DEC59 DEC 59 DEC60 DEC 60 *61 USED *62 USED *63 USED *64 USED DEC65 DEC 65 DEC66 DEC 66 DEC67 DEC 67 *68 UNUSED *69 UNUSED DEC70 DEC 70 DEC71 DEC 71 DEC72 DEC 72 *************************************************************************** SKP *************************************************************************** * * THIS SECTION PUTS ETB,EXT IN BUFFER, SENDS BUFFER * AND HANDLES EOT * EOTS1 STA IOBFL I/O BUFFER FLAG EOTST LDA WRCNT GET XMIT BUFFER COUNT CPA D.400 BUFFER EMPTY? JMP S.EOT YES. GO SEND EOT CCB NO. SET EOT FLAG STB EOTXM LDA ETX GET ETX RSS SKIP NEXT INSTRUCTION ETBPT LDA ETB GET ETB JSB STRBY STORE CHARACTER IN XMIT BUFFER ISZ WRCNT nBUMP COUNT CLA GET A ZERO RECORD LENGTH JSB PUTWD PUT ZERO LENGTH WORD IN BUFFER * * XMIT BUFFER IS NOW COMPLETE FOLLOWING SECTION PUTS IT ON * THE LINE * LDA WRCNT GET REMAINING BUFFER SIZE CMA,INA MAKE POSITIVE ADA D.400 SUBTRACT 400 TO GET SIZE OF XMIT BUF. STA WRCNT CONFIGURE TRANSMIT BUFFER LENGTH. LDB DEC54 JSB DIARP REPORT REQUEST ISSUED * *****************DO WRITE REQUEST****************************** * JSB EXEC CALL LINE TO XMIT DEF *+6 BUFFER DEF D2 WRITE REQUEST DEF CWD37 CONTROL WORD = 37XX DEF COMBA COMM. WRITE BUFFER ADDRESS DEF WRCNT BUFFER LENGTH DEF IDPRM * JSB STATC GO CHECK STATUS OF LINE JMP EXSTA ERROR PROCESSING: EXTENDED STATUS * LDA XMTFL SSA,RSS JMP X.EOT LDA EOTXM SSA,RSS SEND EOT? JMP RSET NO.GO DO NEXT BUFFER * *************************************************************************** SKP *************************************************************************** * S.EOT LDA BRKFL IF A BREAK SSA HAS BEEN REQUESTED, THEN JMP NOPLK DO NOT CLEAR THE LU LOCKS. LDA RDLK SZA,RSS JMP NORLK SKIP IF INPUT NOT LOCKED, JSB LURQ ELSE UNLOCK INPUT LU. DEF *+4 DEF ZERO DEF RDLU DEF C1 CLA RESET INPUT LOCK FLAG. STA RDLK NORLK LDA LSTLK SZA,RSS JMP NOLLK SKIP IF LIST LU NOT LOCKED, JSB LURQ ELSE UNLOCK LIST LU. DEF *+4 DEF ZERO DEF LSTLU DEF C1 CLA RESET LIST LU FLAG. STA LSTLK NOLLK LDA PUNLK SZA,RSS JMP NOPLK SKIP IF PUNCH LU NOT LOCKED, JSB LURQ ELSE UNLOxCK PUNCH LU. DEF *+4 DEF ZERO DEF PUNLU DEF C1 CLA RESET PUNCH LOCK FLAG. STA PUNLK * NOPLK LDA DISFL IF DISCONNECT FLAG IS SET, SSA,RSS JMP DWN.2 HONOR THE REQUEST! CPA BRKFL IF A BREAK HAS BEEN REQUESTED, THEN JMP SEOT. GO, DIRECTLY, TO SEND AN 'EOT'. * CPA FCDRD IF THIS IS 1RST CARD & #E/#R/#W, JMP R.EOT THEN DO NOT SEND 'EOT' ! * SEOT. LDB DEC56 JSB DIARP LDB ACW32 SEND THE EOT. JSB LINCN JMP EXSTA ERROR: PROCESS EXTENDED STATUS. CCA STA FCDRD SET FIRST RECORD AFTER EOT FLAG STA EOTFL SET SENT AN EOT FLAG * SKP * BRNCH LDA RCVFL IF RECEIVE MODE,GO TO RECIEVE PROC SSA JMP RECVP LDA XMTFL IF TRANSMIT MODE, GO TO TRANSMIT PROC. SSA JMP XMITP * * IT'S CONTROL MODE--CONTINUE. R.EOT LDA BRKFL IF PROCESSING AN OPERATOR INTERRUPT, SSA JMP XMITP GO PROCESS NEXT CARD LDB EOTFL CLA STA EOTFL CLEAR HAVING SENT EOT FLAG LDA LISFL SSB JUST SENT AN EOT? INA,SZA YES, DECREASE WAIT COUNT BY ONE INA,SZA,RSS PROCESSING A #R,#E,#E,#W OR #P? JMP BRNC1 NO, GO CHECK FOR DISCONNECT. RSS X.EOT LDA C.3 SET LISTEN COUNT TO 1 MINUTE STA WAITC SETUP WAIT * LDB ACW31 EACH LOOP= 1 LONG T.O. INA,SZA IF ONLY 1 (#E) LDB ACW27 OR= 20 SECS FOR ELSE STB ACWX JMP WLOOP * JES3 LDA EOTFL IF SENT EOT,RCVD NO DATA,THEN WAITC BAD. SSA (SENT EOT,RCVD DATA,NOW RECV LINE FILL.) JMP R.EOT SET UP WAITC ..EOT LDA WAITC FETCH WAIT COUNT SSA,RSS CLA RESET TO INFINITE WAIT INA,SZA,RSS JMP NWAIT IF DONE WAITING THEN EXIT STA WAITC OR BUMP WAIT COUNT * UNL  IFZ LST WLOOP JSB IFBRK DEF *+1 UNL XIF IFN LST WLOOP JSB #INGT UNL XIF LST SSA,RSS OPERATOR-INTERRUPT DETECTED? JMP S.TOR NO, GO LISTEN SOMEMORE * NWAIT CCA ELSE, TURN OFF STA LISFL THE #R REQUEST, * BRNC1 LDA INFLG GET THE 'INPUT-AVAILABLE' FLAG. SSA,RSS IF INPUT IS NOT AVAILABLE, JMP DWN.2 GO TO DISCONNECT. JMP XMITP ELSE GET NEW INPUT. * * **************************************************************************** SKP **************************************************************************** * * LINE TURN-AROUND PROCESSES: * * 'S.TOR' - REQUEST TURN-AROUND FROM SEND TO RECEIVE. * S.TOR LDB DEC53 JSB DIARP LDB ACWX LISTEN FOR 1 LONG T.O. OR 20 SECS JSB LINCN FROM SEND TO RECEIVE. JMP EXSTA ERROR RETURN LDA RCVFL IF NOT RECEIVE MODE, SSA,RSS JMP ..EOT CHECK FOR LISTEN AGAIN. JMP RECVP OR GO TO RECEIVE PROCESSOR * * * * * *************************************************************************** SKP *************************************************************************** * * PUTWD INSERTS THE BLOCK LENGTH WORD FOR THE XMIT PROCESS * * LINRD PERFORMS READ REQUESTS FROM THE LINE. ENTRY IS WITH * ADDRESS OF CONTROL WORD IN B * * LINCN PERFORMS CONTROL REQUESTS ON THE LINE. ENTRY IS WITH * ADDRESS OF CONTROL WORD IN B * *************************************************************************** * PUTWD NOP ENTRY. A= LENGTH WORD LDB BBUFB GET CURRENT BYTE ADDRESS SLB,RSS IF ON AN EVEN BYTE JMP *+3 PROCEED INB OTHERWISE BUMP ADDRESS TO EVEN ISZ WRCNT ALSO COUNT RBR MAKE WORD ADDRESS STA B,I STORE LENGTH WORD INvB INCREMENT WORD ADDRESS RBL TRANSFORM TO BYTE ADDRESS STB BBUFB RESTE BYTE ADDRESS POINTER ISZ WRCNT BUMP BYTE COUNT ISZ WRCNT BY TWO NOP JMP PUTWD,I EXIT ROUTINE * * LINRD NOP ENTRY STB LINRW PUT CONTROL WORD IN REQUEST LDB DEC55 JSB DIARP * *****************DO READ REQUEST********************************* * JSB EXEC ISSUE READ REQUEST DEF *+6 DEF D1 LINRW NOP DEF COMBA DEF D.424 DEF IDPRM JSB STATC CHECK STATUS JMP EXSTA IF ERROR,DO EXTENDED STATUS ISZ OVFFL JMP LINRD,I ELSE EXIT LDB ACW34 ISZ WAITB IF REPEAT FLAG SAYS DO IT AGAIN, JMP LINRD+1 THEN DO SO. LDB DEC65 JSB REPOR REPORT BUFFER OVERFLOW ERROR JMP DWN.2 AND ABORT * COMBA DEF #CMBF POINT TO BUF IN #COMM * * * * LINCN NOP ENTRY LDA LINCN GET RETURN ADDRESS STA STATC DUMMY UP STATUS RETURN STB LINCW PUT CONTROL WORD IN REQUEST * *****************DO CONTROL REQUEST********************************* * JSB EXEC ISSUE CONTROL REQUEST DEF *+4 DEF C3 LINCW NOP DEF IDPRM JMP STATC+1 GO TO STATUS FOR EXIT * * **************************************************************************** SKP *************************************************************************** * * THIS PROCESS EXECUTES AFTER A SUCCESSFUL ANSWER, OR LINE * TURNAROUND. ITS FUNCTION IS: * 1. READ A BUFFER FROM THE COMM LINE * 2. MOVE EACH BLOCK FROM THE COMM BUFFER * TO AN I/O BUFFER, AND OUTPUT IT. * 3. RECOGNIZE AND EXECUTE HT AND ESC SEQUENCES * 4. REREAD IMPROPER BUFFERS UP TO THREE TIMES * **********************}v****************************************************** * * RECVP LDA IOPUP SELECT PUNCH STA IOUTP UNL * IFZ * LST * JSB IFBRK CLEAR BREAK FLAG * DEF *+1 * UNL * XIF * IFN * LST * JSB #INGT CLEAR BREAK FLAG. * UNL * XIF LST CLA STA RECFG CLEAR THE RECEIVE FLAG RECV3 LDA C.4 SET REPEAT COUNTER TO -4 STA WAITB CLA RESET EOT FLAG STA TST1 RESET REPEAT COUNTER UNL IFZ LST JSB IFBRK DEF *+1 UNL XIF IFN LST JSB #INGT UNL XIF LST STA BRKFL SET #I FLAG LDB ACW33 SSA,RSS IF THE BREAK FLAG IS NOT SET, JMP RECV1 DO AN ACK READ STA LISFL ELSE RESET LISTEN FLAG JMP S.EOT AND SEND AN EOT * RECV1 JSB LINRD LDB RCVFL SSB,RSS JMP REOT. STB RECFG GOT ONE OR MORE RECORDS! LDA COMBA GET COMM BUFF ADDRESS RAL ADJUST FOR BYTES AND STA BBUFA INITIALIZE GET BYTE ROUTINE LDB TST1 GET REPEAT COUNTER CMB,INB,SZB,RSS SKIP IF LINE HAS BEEN PRINTED JMP SET2 STB TEMP4 SAVE NUMBER TO SKIP SKIP JSB GETWD GET BLOCK LENGTH CMA,INA LDB A ADA TLOG BUMP COUNT PAST BLOCK SSA,RSS JMP NAKRD ISSUE NAKRD IF THAT'S ALL STA TLOG ADB BBUFA ADD ADDR TO COUNT STB BBUFA ISZ TEMP4 JMP SKIP SKIP ANOTHER * SKP SET2 LDA WRBFA GET ADDRESS OF WRITE BUFFER RAL MULTIPLY BY TWO STA BBUFB INITIALIZE STORE BYTE ROUTINE CLA CLEAR A AND STA CNT1 COUNT1 =NO.OF CHARACTERS STORED STA LPCON * * NOW READY TO EXAMINE RCVE BUFFER * JSB GETWD GET THE LENGTH WO&:RD (LABEL GTDLE?) STA CNT3 INITIALIZE COUNTER JSB GETBY GET THE FIRST CHARACTER CPA DLE IS IT A DLE JMP XPARP YES GO PROCESS BUFFER AS TRANSPARENT CLB SET TRANSPARENCY POINTER STB XPRFL TO NON TRANSPARENT CPA STX NOT DLE IS IT STX? JMP ESCCK YES. PROCEED WITH PROCESSING CPA SOH NO. CHECK FOR SOH? JMP ESCCK IT WAS SOH. TREAT AS STX LDB TST1 GET REPEAT WRITE FLAG SZB IF THIS IS NOT THE FIRST BLOCK JMP ESCK PROCEED NAKRD ISZ WAITB IF OK TO TRY AGAIN, JMP *+4 DO SO. LDB DEC40 ELSE REPORT ERROR AND ABORT JSB REPOR JMP DWN.2 LDB ACW34 DO NAK READ JMP RECV1 ENTER PROCESSING FOR READ REQUESTS * * REOT. CCA DO A "PAGE EJECT", OR PT TRAILER STA LPCON NOTE: DOESN'T WORK, AND JES3 DOESN'T WANT IT. JSB IOUTP,I CCA SET DEVICE NOT USED FLAGS STA USELS STA USEPU LDA LSTLK SZA,RSS JMP NLLK SKIP IF LIST LU NOT LOCKED, JSB LURQ ELSE UNLOCK LIST LU. DEF *+4 DEF ZERO DEF LSTLU DEF C1 CLA RESET LIST LOCK FLAG. STA LSTLK NLLK LDA PUNLK SZA,RSS JMP NPLK SKIP IF PUNCH UNIT NOT LOCKED, JSB LURQ ELSE UNLOCK PUNCH LU. DEF *+4 DEF ZERO DEF PUNLU DEF C1 CLA RESET PUNCH LOCK FLAG. STA PUNLK NPLK LDB IOUTP IF THE EOT WAS RECEIVED CPB IOPUP ON THE PUNCH STREAM, STA XTRAN THEN CLEAR THE FORCED-TRANSLATE FLAG. ******* ******* JES3 LINE FILL IS ENQ(3 SEC),EOT(10 SEC),ENQ... ******* LDA RECFG FETCH RECEIVE FLAG SZA,RSS NO RECORDS RECEIVED? JMP JES3 SO JUST DECREMENT WAIT 8COUNT ******* ******* PCO 2013 CAUSED THESE CHANGES. ******* CLA STA EOTFL CLEAR JUST SENT EOT FLAG. LDB RECCT FETCH # OF STREAMS WAITING FOR... SSB,RSS IF WAITING FOR INFINITE # STREAMS (RECCT=0)? JMP R.EOT YES, DON'T CHANGE EXPECTED COUNT CCA INB,SZB,RSS IF LAST STREAM EXPECTED, STA LISFL CLEAR LISTEN FLAG STB RECCT JMP R.EOT * * GETWD NOP ENTRY LDB BBUFA GET BYTE ADDRESS SLB,RSS ARE WE ON AN EVEN BYTE JMP *+3 YES, GO AHEAD INB NO. BUMP ADDRESS TO EVEN BYTE ISZ TLOG DITTO COUNT. RBR MAKE ADDRESS ABSOLUTE LDA B,I GET WORD FROM BUFFER INB INCREMENT ADDRESS RBL TRANSFORM TO BYTE ADDRESS STB BBUFA RESET GET BYTE ROUTINE ISZ TLOG BUMP CHARACTER COUNTS ISZ TLOG JMP GETWD,I RETURN, A= WORD * * THIS SECTION LOOKS FOR ESCAPE SEQUENCES * ESCCK JSB BUMGT BUMP TO NEXT CHAR ESCK CPA ESC ESCAPE SEGENCE? JMP ESCPR YES. GO PROCESS * THERE ISZ CNT3 END OF BLOCK? RSS JMP DATAA YES LDB XPRFL MOVE TRANSPARENT MODE FLAG CLE,ELB INTO . 1=TRANSPARENT. LDB CNT1 GET THE OUTPUT COUNT SEZ IF TRANSPARENT MODE, ALLOW TWO MORE ADB C.2 CHARACTERS FOR VERTICAL FMT CONTROL, ADB D.145 IN ADDITION TO USUAL MAXIMUM LENGTH. SSB,RSS IF ITS TOO LONG JMP NAKRD SOMETHINGS WRONG LDB XPRFL GET TRANSPARENCY FLAG SSB IF IN TRANSPARENT MODE, JMP DATA4 BIPASS HT AND EM LDB IOUTP GET THE OUTPUT PROCESS CPA HT IF NOT HT, DO EM CPB IOPUP IF ITS THE PUNCH, JMP EMCK BIPASS HT CHECK LDB HTmBUA GET ADDRESS OF TABS HT1 LDA B,I GET CURRENT BUFFER POSITION CMA,INA,SZA,RSS JMP DATA5 ADD POSITION TO IT INB ADA CNT1 SSA CPA C.1 JMP HT1 STA TEMP3 SAVE BLANK COUNT HT2 ISZ TEMP3 DO WE NEED MORE BLANKS? RSS YES. GO STUFF THEM JMP DATA5 LDA C40 GET A BLANK JSB STRBY PUT IT IN THE BUFFER ISZ CNT1 BUMP OUT PUT COUNT JMP HT2 GO DO NEXT BLANK EMCK CPA EM IS THE CHARACTER EM ? JMP DATA3 YES. PROCESS END DATA4 JSB TRAN2 JSB STRBY PUT CHAR IN I/O BUFF ISZ CNT1 BUMP I/O COUNT DATA5 JSB LBUMP JSB GETBY GET NEXT CHAR JMP THERE * DATA1 JSB IOUTP,I GO OUTPUT RECORD ISZ TST1 BUMP REPEAT COUNT JMP SET2 GO START NEXT BLOCK * DATA2 JSB IOUTP,I GO OUTPUT RECORD JMP RECV3 OK GO PROCESS NEXT BUFFER * DATA3 JSB LBUMP GO TEST COM BUFFER JSB GETBY GET NEXT CHAR ISZ CNT3 IF THATS ALL JMP NAKRD ISSUE NAK * DATAA CPA ITB JMP DATA1 JMP IF CHAR WAS ITB CPA ETB JMP DATA2 JMP IF CHAR WAS ETB CPA ETX JMP DATA2 JMP IF CHAR WAS ETX JMP NAKRD OTHERWISE ERROR, RESTART ************************************************************************** SKP ************************************************************************** * THIS SECTION PROCESS TRANSPARENT BUFFERS ************************************************************************** * XPARP JSB BUMGT BUMP TO NEXT CHAR CCB STB XPRFL TRANSPARENT MODE CPA STX IS IT AN STX? JMP XVFCK YES.CHECK FOR VERTICAL FMT. JMP NAKRD NO. BUFFER ERROR. REREAD XVFCK JSB BUMGT BUMP TO NEXT CHARACTER. LDB IOUTP GET OUTPUT PROCESS ADDRESS. CPA ESC ESCAPE SEQUENCE? CPB IOPUP YES. OUTPUT TO LIST STREAM? JMP DEVCK NO. IGNORE VERTICAL FMT. JSB BUMGT YES. GET NEXT CHARACTER AND JMP ESCVF CHECK FOR VERTICAL FMT. * DEVCK LDB XTRAN GET THE FORCED-TRANSLATION FLAG. SZB IF IT'S ALREADY SET, JMP THERE THEN BYPASS DEVICE TYPE CHECKING; UNL IFZ LST LDB IOFNP CPB IOPUP IF PUNCH TO FILE, JMP THERE DON'T TRANSLATE! UNL XIF LST STA GETWD ELSE, SAVE THE CHARACTER, TEMPORARILY. LDA PUNLU GET THE STA OUTCW EQUIPMENT TYPE-CODE JSB GTWST FOR THE PUNCH-DEVICE. SZA IF THE DEVICE IS INTERACTIVE, CPA D10 OR IF IT'S A LINEPRINTER, ISZ XTRAN THEN FORCE TRANSLATION. LDA GETWD RETRIEVE THE CHARACTER IN . JMP THERE PROCESS THE CHARACTER. * XTRAN NOP ************************************************************************** SKP ************************************************************************** * THIS SECTION PROCESSES ESCAPE SEQUENCES. ************************************************************************** * ESCPR JSB BUMGT BUMP TO NEXT CHAR CPA CH.4 IS IT A FOUR? JMP SELPU YES GO SELECT PUNCH CPA HT IS IT HORIZONTAL TAB JMP HTSET YES GO SET UP HORIZONTAL TAB ESCVF LDB DEFCH SET UP VERTICAL FORMAT SEARCH STB TEMP2 LDB D.12 SEARCH TABLE UNTIL PROPER CHARACTER STB TEMP6 IS FOUND CLB,INB ESCP. CPA TEMP2,I JMP SELLS INB ISZ TEMP2 ISZ TEMP6 JMP ESCP. CLB CLEAR CONTROL VALUE SELLS STB LPCON SET FINAL VALUE OF PRINT CONTROL UNL IFZ LST LDB IOFNL CPB IOLSP JMP %)OWNLS IF LIST TO FILE, NO LU LOCK. UNL XIF LST LDB LSTLK SZB JMP OWNLS IF LIST ALREADY LOCKED, NO LU LOCK. LDA LSTLU STA OUTCW SETUP FOR DEVICE TYPE ROUTINE. JSB GTWST GET DEVICE TYPE. SZA,RSS JMP OWNLS IF LIST TO A TERMINAL, NO LU LOCK. JSB LURQ LOCK LIST LU. DEF *+4 DEF C1 DEF LSTLU DEF C1 ISZ LSTLK SET LIST LOCK FLAG. OWNLS LDA IOLSP GET ADDRESS OF LIST PROCESSOR JMP SETPA GO TO SET PROCESSOR ADDRESS. SELPU EQU * UNL IFZ LST LDB IOFNP CPB IOPUP JMP OWNPU IF PUNCH TO FILE, NO LU LOCK. UNL XIF LST LDB PUNLK SZB JMP OWNPU IF PUNCH ALREADY LOCKED, NO LU LOCK. LDA PUNLU STA OUTCW SETUP FOR DEVICE TYPE ROUTINE. JSB GTWST GET DEVICE TYPE. SZA,RSS JMP OWNPU IF PUNCH TO A TERMINAL, NO LU LOCK. JSB LURQ LOCK PUNCH LU. DEF *+4 DEF C1 DEF PUNLU DEF C1 ISZ PUNLK SET PUNCH LOCK FLAG. OWNPU LDA IOPUP GET ADDRESS OF PUNCH PROCESSOR SETPA STA IOUTP STORE IN OUTPUT PROCESS ADDRESS JSB BUMGT BUMP TO NEXT CHARACTER. JMP THERE ************************************************************************** SKP ************************************************************************** * THIS SECTION ESTABLISHES HORIZONTAL TAB POSITIONS. ************************************************************************** * HTSET LDB HTBUA GET ADDRESS OF HT BUFFER STB HTBUW HTST JSB LBUMP CHECK COMM BUFFER ISZ CNT3 CHECK BLOCK COUNT JMP HTSTA IF OK, GO SET NEXT TAB CLB ELSE TERMINATE HT BUFFER STB HTBUW,I SELECT LINE PRINTER, CLNLHB,INB AND PROCESS NEXT RECORD STB LPCON LDB IOLSP STB IOUTP JMP DATAA * HTSTA JSB GETBY ISZ CNT1 BUMP COUNT CPA HT IS CHAR A HORIZONTAL TAB RSS YES GO STORE TAB POSITION JMP HTST LDA CNT1 SET POSITION COUNT STA HTBUW,I ISZ HTBUW JMP HTST EXIT * * LBUMP NOP ISZ TLOG JMP LBUMP,I JMP NAKRD ISSUE NAK * BUMGT NOP JSB LBUMP ISZ CNT3 RSS JMP NAKRD ISSUE NAK JSB GETBY GET NEXT CHAR JMP BUMGT,I ************************************************************************** /N SKP *************************************************************************** * * THIS ROUTINE READS THE NEXT BYTE FROM A BUFFER * ROUTINE IS RESET BY PLACING BUFFER ADDRESS IN BBUFA * SHIFTED LEFT ONE BIT TO ALLOW BYTE ADDRESSING * **************************************************************************** * * GETBY NOP ENTRY LDB BBUFA CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND C377 ISZ BBUFA JMP GETBY,I * * *************************************************************************** * * THIS ROUTINE STORES A BYTE IN THE BUFFER WHOSE * ADDRESS IS FOUND IN BBUFB. BYTE ADDRESSING * IS USED. BYTE SHOULD BE IN (A). * **************************************************************************** * * STRBY NOP ENTRY STA TEMP1 LDB BBUFB CLE,ERB LDA B,I SEZ,RSS ALF,ALF AND M1774 IOR TEMP1 SEZ,RSS ALF,ALF STA B,I ISZ BBUFB JMP STRBY,I *************************************************************************** SKP *************************************************************************** * TRANSLATION SUBROUTINE: TRANSLATES FROM LINE CODE TO HP-ASCII. *************************************************************************** * TRAN2 NOP ENTRY A CONTAINS CHARACTER IN LINE CODE LDB XPRFL GET TRANSPARENCY FLAG SSB,RSS IF IN NON TRANSPARENT MODE JMP TRAN. GO TRANSLATE LDB XTRAN IF FORCED-TRANSLATION FLAG IS SET SZB THEN JMP TRAN. TRANSLATE LINE CODE TO ASCII. LDB IOUTP CHECK OUTPUT PROCESS CPB IOLSP IF IT IS LIST, JMP TRAN. GO TRANSLATE JMP TRAN2,I EXIT ROUTINE * TRAN. AND MASK MASK OFF PARITY BIT MOD2 NOP RSS IF EBCDIC JMP TRAN2,I EXIT IF ASCII CLE,#ERA ADA TABL. FIND RESULT FROM TABLE LDA A,I SEZ,RSS ALF,ALF AND C377 JMP TRAN2,I EXIT WITH CHAR IN A *************************************************************************** SKP *************************************************************************** * * STATC DECODES THE CONTROL STATUS RETURNED FROM THE COMM LINE * RETURN IS P+1 IF REJECTED, OR AN ERROR OCCURED. OTHERWISE * RETURN IS P+2. * *************************************************************************** * STATC NOP ENTRY POINT STB TLOG SAVE TRANSMISSION LOG LDB DIAGF SSB,RSS SKIP IF IN DIAG. MODE JMP NODIA LDB D.8 STB CNT1 LDB DEC60 JSB EXST3 ALF,ALF NODIA SLA IF BIT ZERO=1, LINE IS LOST JMP STATC,I PROCESS AS REJECT CLB CLEAR B AND ALSO STB XMTFL STATE (RCVE/XMIT) STB RCVFL STB OVFFL STB TRMFL CCB SET B=-1 RAR,SLA IF TERMINAL ON LINE, STB TRMFL MAKE STATE FLAG =-1. RAR,SLA IF XMIT BIT IS SET, STB XMTFL MAKE STATE FLAG =-1 RAR,SLA IF THE RCV BIT IS SET, STB RCVFL MAKE RCV FLAG =-1 RAR,SLA IF THE RVI BIT IS SET, STB RVIFL MAKE RVI FLAG =-1 RAR,SLA IF THE BUFFER OVERFLOW BIT IS STB OVFFL SET, MAKE FLAG=-1 AND C60K LDB DEC66 SZA,RSS JSB DIARP REPORT "CONTROL MODE". LDA TRMFL SSA ISZ STATC BUMP TO NORMAL RETURN JMP STATC,I EXIT ROUTINE * TRMFL NOP TERMINAL-STATE FLAG. (0=OFF-LINE). *************************************************************************** SKP **************************************************************************** * * THIS SECTION PROCESSES EXTENDED STATUS. ALL ERROR MESSAGES * ARE PRINTED. THE PROGRAM IS TERMINATED,OR RESTARTED * **************************************************************************** * EXSTA LDB DEC46 GET ASCII FOR 10 SZA,RSS IF REQUEST REJECTED JSB REPOR ELSE, REPORT A=O, LDB DEC59 JSB DIARP REPORT REQUEST ISSUED LDB ACW30 DO EXTENDED STATUS REQUEST JSB LINCN NOP * LDA TLOG GET STATUS WORD IN A LDB D.8 GET A -8 AND STB CNT1 INITIALIZE COUNTER LDB DEC20 GET ASCII FOR 20 JSB EXST3 GO REPORT 8-BITS LDB D.8 GET A -8 AND STB CNT1 INITIALIZE COUNTER LDB DEC30 GET ASCII FOR 30 JSB EXST3 GO REPORT 8-BITS * * PRINT TERMINATION MESSAGE? * JMP EXIT EXST3 NOP ENTRY. B=BASE CODE A=DATA,CNT1=# SLA IF BIT IS SET, JSB REPOR REPORT IT INB BUMP REPORT CODE RAR SHIFT TO NEXT BIT ISZ CNT1 IF THERE ARE MORE BITS, JMP EXST3+1 DD THEM JMP EXST3,I ELSE, EXIT ROUTINE * *************************************************************************** UNL IFZ LST * HANDLE FMGR ERROR CODES * FERR NOP STA FMFLG SAVE ERROR CODE FOR RETURN TO USER LDB A CHANGE REGISTER JSB REPOR REPORT IT TO USER JMP FERR,I EXIT ROUTINE **************************************************************************** UNL XIF LST SKP *************************************************************************** * REPOR NOP ENTER: A TO BE SAVED, B=ERROR CODE STA TEMP1 SAVE A STB TEMPX FOR LATER USE SSB CONVERT NEGATIVE FMGR ERR CODES  CMB,INB LDA ASC00 SET UP ASCII ZERO XNUM ADB D.10 SUBTRACT TEN FROM ERR CODE SSB STILL POSITIVE? JMP XNUMX NO, SO GO COMPUTE ONES PLACE ADA ASC10 YES, BUMP THE TENS PLACE (IN ASCII) JMP XNUM AND TRY FOR MORE * XNUMX ADB D10 REPLACE THAT LAST TEN ADB A AND COMPUTE THE ASCII ANSWER STB STCOD PUT STATUS CODE IN MESSAGE BUF JSB EXEC CALL TTY TO PRINT STATUS MESSAGE DEF *+5 DEF C2 REQUEST CODE = 2 DEF SYSLU CONTROL WORD = 1 DEF STMES ADDRESS OF STATUS MESSAGE UNL IFN LST DEF D.8 UNL XIF IFZ LST DEF D.10 LENGTH IS 10 CHARACTERS * LDA TEMPX REMEMBER THAT ERROR CODE SSA NEGATIVE => FMGR LDA DEC19 SPECIAL CASE! LDB A NEED ANOTHER COPY ADA MSLEN ADD IN ADDRESS OF MSG LENGTH TABLE STA MSSIZ KEEP IT HANDY ADB MSTXT ADD IN ADDRESS OF TEXT PTRS TABLE LDB B,I GET THE ACTUAL TEXT ADDRESS STB MSPTR AND KEEP IT TOO! JSB EXEC NOW PRINT OUT THE TEXT STRING DEF *+5 DEF C2 DEF SYSLU MSPTR DEF MESXX DEFAULT MESSAGE MSSIZ DEF C1 DEFAULT MESSAGE SIZE * UNL XIF LST LDA TEMP1 RESTORE A LDB TEMPX RESTORE B JMP REPOR,I EXIT * *************************************************************************** * DIARP NOP IF IN DIAGNOSTIC MODE, PRINT MESSAGE LDA DIAGF SSA JSB REPOR JMP DIARP,I * STMES ASC 3, RJE: STCOD NOP ASC 1, _ SPACE,BACKARROW * ISTAT NOP RDERR NOP XPRLU NOP *************************************************************************** SKP UNL IFZ LST *************************************************************************** ER1EX NOP LDA RDERR SSA,RSS JMP ER1EX,I NO ERROR, RETURN JSB FERR * UNL XIF LST **************************************************************************** * * THIS SECTION CLOSES ALL FILES, DISCONNECTS THE LINE, AND * TERMINATES RJE * **************************************************************************** * EXIT2 CCA STA USEPU STA USELS EXIT CLA SET INPUT FLAG TO STA INFLG ZERO STA NOLU INITIALIZE FLAG FOR LU CHK CCA SET CONTROL REQUEST STA LPCON TO END OF FILE WRITE STA ABORT SET ABORT FLAG JSB IOPUP,I CLOSE PUNCH DEVICE CCA SET CONTROL TO EOF STA LPCON JSB IOLSP,I CLOSE LIST DEVICE UNL IFZ LST * JSB CLOSE DEF *+2 DEF #RDCB * ***************** PASS BACK PARAMETERS TO CALLER ************************ * CLA STA P1 SET PARAMETERS TO ZERO STA P2 STA P3 LDA STCOD GET LAST ASCII ERROR CODE STA P5 UNL XIF LST JSB EXEC DO EXEC 13 TO GET EQT WORD 5 DEF *+4 DEF D13I CHECK FOR BAD LU DEF CWD00 DEF ISTAT JMP EXIT5 BAD LU, SO NO P2 AND P3. LDA ISTAT GET EQT WORD 5 ALF,ALF AND C77 ISOLATE EQUIPMENT TYPE CPA C50 DVR50? RSS JMP EXIT5 THIS IS NOT CORRECT LU! UNL IFZ LST LDA ISTAT AND C377 PASS BACK EQT 5 STATUS IN P2. STA P2 LDA CWD00 SET UP REQUEST 30 FOR THE LU. ADA C3000 STA REQ30 JSB EXEC REQUEST EXTENDED STATUS FROM DRIVER. DEF *+3 DEF C3 DEF REQ30 RETURNS EQT WORD 12 IN B REGISTER. STB P3 UNL XIF LST RSS EXIT5 ISZ NOLU JSB EXEC CALL #DIAL FOR SIGN-OFF DEF *+5 DEF D9 DEF #DIAL DEF SYSLU DEF C.1 * LDA NOLU ONE MEANS THERE IS NO LU SLA JMP EXIT6 IF NONE, THEN DON'T TRY TO CLEAR DVR! JSB EXEC ISSUE A CLEAR REQUEST TO DVR50. DEF *+3 DEF C3 DEF CWD00 * EXIT6 LDB DEC72 WRITE "TERMINATE" MESSAGE JSB REPOR UNL IFZ LST * LDA FMFLG FMP ERROR CODE STA P4 * JSB PRTN RETURN THE PARAMETERS DEF *+2 DEF P1 UNL XIF LST * JSB EXEC CALL SYSTEM TO TERMINATE DEF *+2 DEF C6 REQUEST CODE IS 6 * HLT 37B ?? SAFETY ?? * NOLU NOP FLAG FOR LU CHK (ONE MEANS NO LU) C3000 OCT 3000 REQ30 NOP SET UP REQUEST 30 FOR THE LU OF DVR50 *************************************************************************** *************************************************************************** SKP ************************************************************************** * * * THIS SECTION CONTAINS I/O PROCESSORS FOR EXEC DEVICES * * ************************************************************************** * * 'EXEC' READ PROCESSOR. * READ BUFFER: #RDBF/ASCII, #RDBF-1/BINARY * READ LENGTH: SAVED IN 'CNT2' * IORDL NOP LDA BRKFL GET BREAK FLAG LDB SYSLU PREPARE FOR BREAK PROCESSING. SSA,RSS IF THE BREAK-FLAG IS NOT SET, LDB RDLU THEN GET READ LU. STB OUTCW INITIALIZE FOR TYPE-CODE CHECKING. JSB GTWST GET THE EQUIPMENT TYPE-CODE. SZA SKIP, IF IT'S TYPE <00>; JMP TRTST ELSE, GO TO TRANSPARENCY CHECKING. * JSB TTYIN PROMPT & READ FROM AN INTERACTIVE DEVICE. JMP IORD1 GO TO CHECK FOR END-OF-FILE. * * TEST FOR BINARY MODE OF INPUT * TRTST LDB TRFLG GET THE TRANSPARENCY FLAG SZB IF NON TRANSPARENT, JMP RDASC DO ASCII READ * CPA C11 JMP RDASC CPA D13 IF CARD READER,ASCII READ JMP RDASC * * DO BINARY READ * LDB A LDA RDLU MAKE CONWORD CPB C1 IOR C300 DO PAPER TAPE READ STA XPRLU * JSB REIO DO READ DEF *+5 DEF C1 DEF XPRLU DEF #RDBF-1 DEF D.82 ADB C.2 REMOVE LENGTH WORD JMP IORD1 * SKP RDASC JSB REIO CALL EXEC TO READ ASCII RECORD DEF *+5 DEF C1 REQUEST CODE = 1 DEF RDLU CONTROL WORD = L.U. OF DEVICE DEF #RDBF READ BUFFR ADDRESS DEF D.80 -80 CHARACTERS MAX IORD1 STA TEMP3 SAVE STATUS LDA EQTYP GET THE EQUIPMENT TYPE-CODE. ADA D.8 SSA IF TYPE IS LESS THAN TEN, JMP PTEOF USE PAPER TAPE EOF CONVENTIONS LDA TEMP3 RECOVER STATUS ALF,ALF POSITION TO MT EOF SSA IF ITS SET, JMP RDEOF GO PROCESS SZB IF RECORD LENGTH IS NON ZERO JMP RDPK GO PROCESS DATA AND C100 ELSE TEST DOWN BIT (6) SZA IF DEVICE IS DOWN, JMP IORDL+1 ATTEMPT TO REREAD RECORD INB ELSE SEND ONE BLANK JMP RDPK FOR ALL BLANK RECORD. * PTEOF LDA TEMP3 RECOVER PT STATUS AND C40 TEST BIT 5 SZA RDEOF CLB REPORT EOF RDPK JSB PACK GO PACK DATA DEF IORDL,I * PACK NOP LDA PACK,I STA PACK LDA BBUFB GET PRESENT BYTE ADDRESS AND STA TEMP6 SAVE IT LDA TRFLG SZB,RSS IF RECORD LENGTH IS ZERO, JMP DISC. GO DISCONNECT (UNLESS TRANSPARENT) SZA,RSS IF TRANSPARENT MODE, JMP PACK1 BIPASS COMMANDS LDA RDBUA,I GET COMMAND DATA * * TEST FOR INPUT STREAM COMMANDS * CPA ASC#C JMP CHANG IT'S A CHANGE DEVICE COMMAND CPA ASC#T JMP TRSET IT'S TRANSPARENT MODE COMMAND UNL IFZ LST CPA ASC#S SWITCH OPTIONS? JMP SWCH UNL XIF LST UNL IFZ LST CPA ASC#P JMP PAUSE ITS A PAUSE COMMAND UNL XIF LST CPB C2 IF LENGTH IS REQUIRED 2, RSS CHECK FOR OTHER COMMANDS JMP PACK1 ELSE TREAT AS DATA * CPA ASC#D JMP DISC1 ITS A FORCE DISCONNECT COMMAND CPA ASC#X JMP XLATE IT'S A TRANSLATE PUNCH STREAM CPA ASC#I JMP INSER ITS AN INSERT COMMAND CPA ASC#W CCB #W=WAIT FOREVER FOR 1 STREAM CPA ASC#R LDB C.5 #R=WAIT FOR 1 MINUTE FOR 1 STREAM CPA ASC#E LDB C.3 #E=WAIT FOR 1 LONG T.O. FOR 1 STREAM SSB,RSS ONE OF THE WAIT COMMANDS? JMP PACK1 NO, THEN TREAT AS DATA * INB STB LISFL #E:-2 #R:-4 #W:0 CCB CPA ASC#R IF #R, SET STREAM CNT TO INFINITY, CLB ELSE SET IT TO 1 STB RECCT SAVE COUNT OF JOB STREAMS EXPECTED JMP P.END * INSER CCB SET FLAG TO INDICATE #I PROCESSING STB BRKFL JMP FLUSH AND GO FLUSH BUFFER * UNL IFZ LST PAUSE STB MCNT SAVE CHAR CNT FOR PARSE LDB C.2 STB LISFL DEFAULT TIME= 1 LONG T.O. CCB STB RECCT DEFAULT COUNT= 1 STREAM * JSB PARSE PARSE THE COMMAND STRING DEF *+4 DEF #RDBF DEF MCNT DEF #WRBF * LDA #WRBF+32 FETCH PARAM COUNT CMA,INA INA,SZA,RSS ONLY #P? JMP P.END YES, JUST USE DEFAULTS * STA MDCNT NO, SAVE -PARAM COUNT DLD #WRBF+4 FETCH 1ST PARAM CPA C1 NON-NUMERIC SZB,RSS OR ZERO? JMP P.CNT+1 YES, USE DEFAULT * CLA SSB IF NEGATIVE, JMP P.CNT MAKE INFINITE LDA 1 MULTIPLY USER # MINUTES BY THREE MPY C3 INA CMA,INA ADJUST TO PROPER LISFL SPECS P.CNT STA LISFL * ISZ MDCNT ANOTHER PARAM? RSS JMP P.END NO, QUIT DLD #WRBF+8 YES, FETCH 2ND PARAM CPA C1 NON-NUMERIC SZB,RSS OR ZERO? JMP P.END YES, USE DEFAULT CMB,SSB,INB,RSS MAKE NEGATIVE AND IF IT WAS CLB NEGATIVE ALREADY, SET TO INFINITE # STB RECCT UNL XIF LST P.END CLB STB EOTFL INITIALIZE NO EOT BEEN SENT FLAG JMP DISC0 CLEAR BREAK FLAG * DISC. SZA,RSS IF TRANSPARENT MODE, DONT DISCONNECT, JMP TRCLR BUT CHECK FOR DEVICE CHANGES. LDA BRKFL IF PROCESSING #I, DON'T DISCONNECT, SSA,RSS BUT CLEAR #I FLAG. JMP DISC2 DISC0 STB BRKFL JMP EXT4 * DISC1 CLB DISC2 STB DISFL ELSE SET FLAG TO INDICATE DISCONNECT, JMP EXT4 AND CONTINUE PROCESSING OF COMM BUFFER * XLATE CCB SET THE FORCED-TRANSLATION FLAG. STB XTRAN JMP RREAD READ THE NEXT RECORD. * UNL IFZ LST SWCH STB MCNT SAVE CHARACTER COUNT FOR PARSE JSB SWTCH ANALYZE RECORD JMP RREAD GO TO NEXT RECORD ***************************************************************************** UNL XIF LST SKP ***************************************************************************** * #T[,XX] BUFFER MOVE ROUTINE: EXCHANGES CONTENTS OF #RDBF & HTBUF. * * LDB CHCNT GET THE COMMAND CHARACTER LENGTH. * CLE/CCE =0: SAVE COMMAND IN HTBUF; =1: RESTORE CMD. TO #RDBF * JSB MVBUF MOVE BUFFER & RETURN: = DON'T CARE, =0. ***************************************************************************** * MVBUF NOP CMB,INB FORM A NEGATIVE CHARACTER COUNT. BRS CONVERT CHARACTER COUNT TO WORDS. STB BTEMP SAVE THE COUNT TEMPORARILY. LDA RDBUA GET THE READ BUFFER ADDRESS. LDB HTBUA GET THE SAVE-BUFFER ADDRESS. SEZ IF THE COMMAND IS BEING RESTORED, SWP EXCHANGE SOURCE & DESTINATION ADDRESSES. DST SRCPT SAVE THE SOURCE & DESTINATION POINTERS. LDB BTEMP RESTORE THE MOVE COUNTER TO . MLOOP LDA SRCPT,I GET A WORD FROM THE SOURCE, STA DESPT,I AND MOVE IT TO THE DESTINATION. ISZ SRCPT ADVANCE THE SOURCE POINTER. ISZ DESPT ADVANCE THE DESTINATION POINTER. INB,SZB ALL WORDS BEEN MOVED? JMP MLOOP NO--GO BACK FOR MORE. JMP MVBUF,I YES--RETURN. * SRCPT NOP DESPT NOP BTEMP EQU RDERR **************************************************************************** SKP **************************************************************************** * TRCLR LDB HTBUF GET THE SAVED COMMAND CHAR. COUNT. CCE,SZB,RSS IF THE COUNT IS ZERO, THEN NO TRANSFER JMP DISC2 WAS SPECIFIED, SO GO TO DISCONNECT; ISZ TRFLG ELSE, TURN OFF TRANSPARENCY, JSB MVBUF AND RESTORE THE COMMAND BUFFER. LDB HTBUF GET THE COMMAND CHARACTER COUNT, JMP CHANG AND GO TO CHANGE CONFIGURATION. * TRSET LDA B GET THE COMMAND CHARACTER LENGTH. UNL IFZ LST ADA D.55 UNL XIF IFN LST ADA D.12 UNL XIF LST SSA,RSS IF THE COMMAND IS TOO LONG, JMP PACK1 THEN TREAT IT AS DATA! CPB C2 IF THIS IS A '#T' ONLY, CLB THEN SET FOR DISCONNECT @EOF. STB HTBUF SAVE THE COMMAND CHARACTER LENGTH. CLE,SZB,RSS IF THIS IS A '#T' ONLY, JMP SETRS THEN BYPASS SAVING THE BUFFER; STB #RDBF ELSE,SAVE THE COMMAND LENGTH, JSB MVBUF AND SAVE THE COMMAND DATA. SETRS STB TRFLG ENABLE TRANSPARENT MODE (B=0). LDA IORDP IF PROCESSOR IS AN EXEC DEVICE, CPA IORDA RSS JMP FLUSH LDA RDLU GET EQUIP TYPE STA OUTCW JSB GTWST LDB A LDA C700 CPB C1 IF ITS DVR01, SET EOT BIT JSB GOCON FLUSH LDA D.400 GET EMPTY BUFFER SIZE. CPA WRCNT IF THE COMMUNICATIONS BUF IS EMPTY JMP RREAD GO READ NEXT INPUT STA CNT2 ELSE, RESET THE BUFFER-EMPTY COUNT, JMP EXT5 AND BIPASS IOBUF FLAG-SET DURING EXIT. * CHANG CMB SET THE READ-BUFFER LENGTH STB RDLEN TO = NEGATIVE (CHARACTER COUNT +1). LDA CH.BL REPLACE STA #RDBF THE LDA C40 COMMAND LDB RDBUA CHARACTERS INB AND FOLLOWING RBL COMMA STB BBUFB WITH ASCII JSB STRBY BLANKS. CCA INITIALIZE LUS TO NO CHANGE JSB CONFG GO CONFIGURE I/O JMP RREAD ERROR: IGNORE CMD. & READ NEXT RECORD. JSB START SET LU.S NOP CLA CLEAR THE FORCED-TRANSLATION FLAG. STA XTRAN JMP FLUSH NOW FLUSH COMM BUFFER * RREAD LDA PACK ELA,CLE,ERA LDA A,I STA IORDP,I LDA IORDP GET PROPER ENTRY ADDRESS FOR REPEAT INA LDB TEMP6 STB BBUFB JMP A,I JUMP TO READ PROCESSOR * PACK1 LDA RDBUA GET ADDRESS OF BUFFER RAL MAKE INTO CHARACTER ADDRESS STA BBUFA SZB,RSS IF LENGTH IS ZERO JMP EXT4 PROCESS AS EOF CPB K80 WERE 80 CHARACTERS PASSED? JMP EXT6 YES(HFB! GO PROCEED LDA BBUFA GET CURRENT ADDRESS OF READ BUF ADA B ADD COUNT TO ADDRESS TO GET NEXT BYTE STA BBUFB ADDRESS,AND INITIALIZE STORE BYTE ROUT, LDA TRFLG SZA,RSS JMP PADTR LDA #CTRL RAR,SLA RSS SKIP IF END OF MEDIA OK JMP PADIT ELSE MUST PAD BLANKS LDA FCRDF IF THIS IS THE FIRST CARD, SSA JMP PADIT STUFF BLANKS STA FCDRD TURN OFF "FIRST CARD AFTER EOT" FLAG CMB MAKE COUNT ONE LARGER & NEGATIVE STB CNT2 INITIALIZE BUFFER LENGTH LDA EM GET END OF MEDIA CHARACTER JSB STRBY PUT CHAR IN BUFFER JMP EXT3 * PADTR LDA BLANK RSS PADIT LDA C40 USE ASCII ADB D.80 GET NEG.DIFFERENCE IN ACTUAL & FULLBUFFER STB TEMP4 SAVE TEMPORARILY STA FCRDF BEGIN PADDING LDA FCRDF JSB STRBY PUT IT IN THE BUFFER ISZ TEMP4 DO WE HAVE 80 CHAR YET? JMP *-3 NO PUT ANOTHER IN EXT6 CLB FIRST CARD READ, STB FCRDF TURN OFF FORCED PADDING STB FCDRD AND SAY THAT AN EOT MUST BE SENT LDB D.80 OK. GET COUNT OF -80 EXT4 STB CNT2 INITIALIZE BUFFER LENTGH EXT3 CCB STB IOBFL EXT5 LDA TEMP6 RECOVER BYTE ADDRESS AND STA BBUFB RESTORE IT JMP PACK,I GET A -1 & SET K80 DEC 80 (H SKP ************************************************************************ * THIS SECTION PROCESSES WRITES TO EXEC DEVICES ************************************************************************ * SETFG NOP STA OUTCW SETUP CONTROL WORD LDB SETFG,I SZB,RSS JMP WRIT2 LDA LPCON SSA JMP NOWRT EOF AND DEVICE NOT USED, JUMP JSB GTWST CPA C2 IF DEVICE IS PUNCH, DO LEADER JMP OPPTP CCB CPA D10 IF LINE PRINTER, EJECT PAGE JSB CTRLP PAGE EJECT JMP WRIT2 * OPPTP LDA C1000 PUT LEADER ON PAPER TAPE PUNCH JSB GOCON WRIT2 LDA C40 STUFF EXTRA BLANK JSB STRBY LDA LPCON GET CONTROL VALUE CPA C1 IF THIS IS SELECT ONLY, JMP WRPEX EXIT WRITE PROCESSOR SSA IF ITS NEGATIVE, JMP WRSTA BIPASS DATA OUTPUT * JSB GTWST GET EQUIPMENT TYPE LDB XPRFL SSB,RSS IF NON TRANSPARENT MODE, JMP WRASC DO ASCII WRITE LDB IOLSP CPB IOUTP IF THIS IS THE LIST PROCESSOR JMP WRASC DO ASCII WRITE * CPA C2 IF IT'S DVR02, RSS GET SET FOR PAPER TAPE CLA,RSS ELSE DO OTHER DEVICE LDA C300 SET CONTROL WORD IOR OUTCW STA CONCW * LDA CNT1 SET UP LENGTH WORD FOR PT ADA C2 LDB A BRS CONVERT LENGTH TO WORDS BLF,BLF AND POSITION TO UPPER BYTE STB WRBFB,I STORE IN BUFFER LDB WRBFB JMP WRAIT ************************************************************************ SKP ************************************************************************ * WRASC LDB A LDA OUTCW CPB D10 IF DEVICE IS LP, IOR C200 MERGE V-BIT(#7) FOR COLUMN #1 PRINT. STA CONCW LDA CNT1 LDB WRBFA WRAIT CMA,INA STA CNT1 SET UP REQUEST COUNT STB WRPNT SET BUFFER ADDR IN CALL JSB REIO DO ASCII WRITE DEF *+5 DEF C2 REQ CODE =2 DEF CONCW CONTROL WORD = L.U. WRPNT NOP DEF CNT1 LENGTH WRSTA JSB GTWST GET EQUIPMENT TYPE LDB LPCON GET CONTROL VALUE CPA D10 IF DVR12, JMP FMTLP DO LINE PRINTER FORMATTING SSB,SZB IF ITS NEGATIVE OR ZERO SZA,RSS IF ITS DVR00, FORGET CONTROL REQUEST JMP WRPEX * ALF,ALF NEGATIVE,POSITION TYPE TO UPPER DIGIT ALF,SLA IF ITS IS 20, JMP CONMT DO MAG TAPE EOF LDA C1000 GET PT EOF WORD CON.. JSB GOCON WRPEX CLA RESET CONTROL WORD STA LPCON TO ZERO * NOWRT CLB STB SETFG,I LDA SETFG ADA C.3 COMPUTE RETURN ADDR LDA A,I JMP A,I RETURN * CONMT LDA C100 GET MAG TAPE CONTROL WORD JMP CON.. GO DO CONTRO L REQUEST * FMTLP SZB,RSS IF ZERO, THEN DEFAULT TO JMP NOWRT SINGLE SPACE (JMP TO CONDF FOR SPC SUPPRESS) ADB CONTA ADD TABLE ADDRESS TO VALUE LDB B,I GET CONTROL PARAMETER SZB CONDF JSB CTRLP JMP WRPEX ***************************************************************************** SKP ***************************************************************************** * CTRLP NOP STB CONWL PUT IT IN PLACE LDA OUTCW GET LU IOR C1100 MERGE IN CONTROL WORD STA CONCW PLACE CONTROL WORD JSB EXEC DO CONTROL REQUEST DEF *+4 DEF C3 DEF CONCW DEF CONWL JMP CTRLP,I EXIT PROCESSOR * ***************************************************************************** * GOCON NOP SETT UP CONWORD AND ISSUE CONTROL REQUEST IOR OUTCW STA CONCW JSB EXEC DEF *+3 DEF C3 DEF CONCW JMP GOCON,I * ***************************************************************************** * GTWST NOP EQUIPMENT TYPE-CODE EXAMINATION. JSB EXEC DO EXEC STATUS CALL DEF *+6 DEF D13I TRAP ERRORS DEF OUTCW DEF ISTAT DEF X13W2 DEF X13W3 JMP LUERR REPORT BAD LU (ERROR 44) & ABORT! * LDA ISTAT GET EQT WORD NUMBER 5. ALF,ALF POSITION AND ISOLATE AND C77 THE EQUIPMENT TYPE-CODE. CPA C7 IF THE TYPE IS <07> CLA THEN SIMULATE TYPE <07>. CPA C5 IF THE TYPE-CODE IS <05>, JSB TYP05 THEN GO TO EXAMINE THE SUBCHANNEL; STA EQTYP ELSE, SAVE THE EQUIPMENT TYPE, JMP GTWST,I AND RETURN TO THE CALLER. * TYP05 NOP DVR05 SUBCHANNEL EXAMINATION. LDA X13W3 GET DRT SUBCHAN BITS FROM EXEC CALL AND ITB ISOLATE SUBCHANNEL (ITB = 37B). STA B SAVE IT TEMPORARILY. SZA,RSS IF THE SUBCHANNEL IS ZERO, THEN RETURN JMP TYP05,I TO SIMULATE A TYPE <00> DEVICE. LDA B23 PREPARE TO SIMULATE A TYPE <23> DEVICE. CPB C4 IF THE SUBCHANNEL IS FOUR, THEN LDA D10 SIMULATE A TYPE <12> DEVICE. JMP TYP05,I RETURN--DEVICE TYPE: <12>,LP OR <23>,MT. * B23 OCT 23 D13I OCT 100015 STATUS CODE W/SIGN. EQTYP NOP EQUIPMENT TYPE-CODE STORAGE. X13W2 NOP EXEC 13 WORD 2 - EQT WORD 4, NOT USED X13W3 NOP EXEC 13 WORD 3 - DRT SUBCHAN BITS ************************************************************************** SKP ************************************************************************** * THIS SECTION HANDLES LIST OUTPUT TO EXEC DEVICES ************************************************************************** * IOLSoL NOP LDA LSTLU SET UP LIST DEVICE OUTPUT JSB SETFG EXECUTE WRITE TO LIST DEVICE USELS NOP * ************************************************************************** * THIS SECTION HANDLES PUNCH OUTPUT TO EXEC DEVICES ************************************************************************** * IOPUL NOP LDA PUNLU SET UP PUNCH CONTROL WORD JSB SETFG EXECUTE WRITE TO PUNCH DEVICE USEPU NOP * ************************************************************************** * THIS SECTION PRINTS A PROMPT AND READS A CHAR STRING ************************************************************************** * TTYIN NOP ENTRY JSB REIO OUTPUT THE PROMPT CHAR DEF *+5 DEF C2 DEF OUTCW DEF PROMP DEF C.3 * LDA C400 MERGE CONTROL WORD WITH LU IOR OUTCW STA OUTCW * JSB REIO READ REQUEST FROM TTY DEF *+5 DEF C1 DEF OUTCW DEF #RDBF DEF D.80 JMP TTYIN,I EXIT SUBROUTINE ************************************************************************ SKP ************************************************************************ * WRBFB DEF #WRBF-1 SKPOP NOP * * COFN EQU * UNL IFZ LST CLA STA SKPOP LDA C2 PREPARE FOR RETURN STA MODSW TO READ NEXT FILE-RECORD. LDA POIN STA PPOI LDB CH.BL PREPARE FOR NAMER <6 CHARACTERS. LDA P4 GET THE THIRD & FOURTH CHARACTERS. SZA,RSS IF THE PARAMETER IS NULL, STB P4 REPLACE IT WITH BLANKS. LDA P5 GET THE FIFTH & SIXTH CHARACTERS. SZA,RSS IF THESE ARE NON-EXISTENT, STB P5 SUBSTITUTE BLANKS. * JSB OPEN OPEN FILE WHOSE NAME IS IN P3 DEF RTN1 DEF #RDCB DEF RDERR PPOI DEF P3 RTN1 JSB ER1EX CHECK FOR ERROR * FLRD JSB READF p READ CONFILE INTO DEF RTN2 THE READ BUFFER DEF #RDCB DEF RDERR NOTE: -1 ERROR DEF #RDBF DEF C50 DEF RDLEN RTN2 JSB ER1EX CHECK FOR ERROR **************************************************************************** SKP **************************************************************************** * CHECK TO SEE IF INPUT STREAM IS FROM CONFILE * IF SO, THEN SET FLAG TO PREVENT RE-OPENING IT * (CONFILE NAME = INPUT FILE NAME => SAME FILE) * (I.E. BETTER BE ON SAME CARTRIDGE!!!) **************************************************************************** * LDA RDBUA REMEMBER WHERE READ BUFFER STARTS STA PTEMP SET UP PTR TO FIRST CHAR LDB C.6 MAX OF SIX CHARS TO CHECK LDA RDLEN BUT DON'T CHECK MORE THAN EXIST! ALS CMA STA LNCNT INIT LINE COUNT = -#CHARS -1 COMP ISZ LNCNT ANY CHARS LEFT ON LINE? RSS YES, SKIP AND KEEP GOING JMP ALLOK NO, ALL DONE! LDA PPOI,I CHECK NAME OF CONFILE SLB RIGHT OR LEFT CHAR? ALF,ALF RIGHT, SO MOVE IT LEFT AND M1774 MASK DOWN TO JUST LEFT STA CTEMP SAVE FOR LATER COMPARISON LDA PTEMP,I CHECK NAME OF INPUT FILE SLB RIGHT OR LEFT CHAR? ALF,ALF RIGHT, SO MOVE IT LEFT AND M1774 MASK DOWN TO JUST LEFT CPA COMMA LDA SPACE CONVERT COMMA TO SPACE CPA COLOL LDA SPACE CONVERT COLON TO SPACE CPA CTEMP RSS THE TWO CHARS ARE EQUAL, SO SKIP JMP RTN3 NOT EQUAL, SO FORGET IT CPA SPACE JMP ALLOK CHAR WAS SPACE SO ALL IS DONE INB,SZB,RSS BUMP CHAR COUNT JMP ALLOK NO MORE CHARS LEFT SO ALL DONE SLB LEFT OR RIGHT CHAR? JMP COMP RIGHT, SO STILL IN SAME WORDS ISZ PPOI LEFT, SO BUMP PTRS TO NEXT WORDS  ISZ PTEMP JMP COMP AND CHECK REMAINDER OF CONFILE NAME * ALLOK CCA INDICATE THAT THE INPUT-STREAM STA SKPOP WILL COME FROM THE CONFILE, ALSO, JMP RTN4 BY SETTING "SKIP OPENING" FLAG. * RTN3 LDA POIN ACCOMMODATE THE MODIFICATION RECORD , STA PPOI (#M...), BY RESETTING THE POINTER. RTN4 LDB RDLEN GET THE READ LENGTH (WORDS). RBL CONVERT TO A CHARACTER COUNT. JMP STCNT PROCESS RESULTS * PTEMP NOP PTR TO CHAR IN READ BUFFER CTEMP NOP USED FOR THE COMPARISON LNCNT NOP # CHARS ON LINE FROM READ BUF COMMA OCT 26000 COLOL OCT 35000 SPACE OCT 20000 ************************************************************************* SKP UNL XIF IFN LST LDB DEC43 REPORT ERROR IF NON-FMP JSB REPOR CLB JMP STCNT UNL XIF IFZ LST ************************************************************************* * THIS ROUTINE OPENS THE FILE,AND MODIFIES CONTROL FOR * LU SIMULATION DURING I/O ************************************************************************* * IOPEN NOP ENTRY ISZ SKPOP RSS JMP GOOD LDA DCBPA GET BASE ADDRESS OF DCB ADDRESSES ADA P2 OFFSET TO CORRECT ADDRESS LDB A,I PICK UP ADDRESS OF DCB STB OPDCB STORE IT IN THE OPEN CALL JSB OPEN OPEN FILE DEF RTN5 OPDCB DEF #RDCB DEF RDERR DEF OPNAM DEF ZERO DEF ISEC DEF ICR RTN5 SSA,RSS IF NO ERRORS WERE DETECTED, JMP GOOD THEN SET UP THE PROCESS POINTERS; LDB OPDCB ELSE, PREPARE FOR INPUT FILE CHECK. CPA C.6 IF THE FILE DOES NOT EXIST, CPB DRDF AND THE REFERENCE IS TO INPUT-STREAM, JMP ER3EX THEN WE CANNOT CREATE AN INPUT FILE! * JSB CREAT _CREATE THE NON-EXISTING FILE. DEF RTN6 DEF OPDCB,I DCB ADDRESS. DEF RDERR ERROR RETURN. DEF OPNAM FILE NAME. DEF D24 FILE SIZE = 24 BLOCKS. DEF C3 FILE TYPE = 3. DEF ISEC SECURITY CODE (DEFAULT=0). DEF ICR CARTRIDGE NUMBER (DEFAULT=0). RTN6 SSA IF 'CREAT' ERROR WAS DETECTED, JMP ER3EX CALL IT QUITS! * * FILE IS OPEN, AND I/O SIMULATOR HAS DCB. SET PROCESS POINTER TO FILE. * GOOD CCA INDICATE THAT THE STREAM STA PPOIN,I IS ASSOCIATED WITH A FILE. LDA IOFNT GET BASE ADDRESS OF FILE I/O ROUTINES. ADA P2 OFFSET INTO TABLE LDA A,I LOAD ADDRESS OF PROCESS ROUTINE LDB IODRT GET BASE ADDRESS: I/O ROUTINE POINTERS ADB P2 OFFSET INTO TABLE STA B,I STORE POINTER JMP IOPEN,I EXIT ROUTINE * DRDF DEF #RDCB INPUT-FILE DCB ADDRESS. DLSF DEF #LDCB LIST -FILE DCB ADDRESS. DPUF DEF #PDCB PUNCH-FILE DCB ADDRESS. DCBPA DEF * BASE OF DCB ADDRESSES. * IOFNR DEF IORDF READ FILE PROCESSOR IOFNL DEF IOLSF LIST FILE PROCESSOR IOFNP DEF IOPUF PUNCH FILE PROCESSOR IOFNT DEF * BASE OF FILE I/O PROCESSORS * * DISC FILE INPUT ROUTINE * IORDF NOP ENTRY LDA BRKFL GET TTY INTERRUPT FLAG SSA,RSS IF IT IS SET, JMP *+4 CONTINUE LDA IORDF ELSE SET UP FOR EXEC PROCESSING STA IORDL JMP IORDL+1 AND ENTER EXEC DEVICE PROCESSOR * LDA TRFLG IF NON TRANSPARENT,DO ASCII READ SZA JMP RDAS. JSB READF ELSE DO BINARY READ DEF *+6 DEF #RDCB DEF RDERR DEF #RDBF-1 DEF D41 DEF TEMP3 CCB ADB TEMP3 JMP RDA.. * RDAS. JSB READF READ RECORD FROM FILE DEF *+6 DEF #RDCB DATA CONTROL BLOCK 2 DEF RDERR DEF #RDBF BUFFER ADDRESS DEF C50 AVAILABLE LENGTH DEF TEMP3 STORE ACTUAL LENGTH * LDB TEMP3 GET THE READ WORD COUNT. RDA.. SSA ANY FMP ERRORS DETECTED? JMP DWN. YES--REPORT IT & DISCONNECT! RBL,SLB NO--FORM A CHARACTER COUNT. CLB SET COUNT =0, IF EOF DETECTED (LEN=-1). JSB PACK GO PAD OUT BUFFER & INITIALIZE DEF IORDF,I * DWN. JSB FERR REPORT THE FMP ERROR. UNL XIF LST * DWN.2 LDB DEC58 JSB DIARP LDB ACW36 ISSUE DISCONNECT REQUEST JSB LINCN NOP JMP EXIT UNL IFZ LST ************************************************************************* SKP ************************************************************************* * THIS SECTION HANDLES FILE WRITES ************************************************************************* * WRITQ NOP ENTRY STA OTDCB STORE DCB ADDRESS STA CLDCB LDB LPCON GET CONTROL VALUE LDA CNT1 AND OUTPUT COUNT CPB C1 IF THIS IS SELECT JMP WRTQX EXIT PROCEXXOR SSB,RSS IF ITS POSITIVE JMP WRTQG GO AHEAD LDA INFLG ELSE GET INPUT FLAG SSA IF NO INPUT AVAILABLE, TREAT AS EOF JMP WRTQX ELSE WRITE ZERO LENGTH RCD JSB CLOSE CLOSE FILE DEF *+2 CLDCB NOP WRTQX CLA RESET CONTROL VALUE STA LPCON JMP WRITQ,I RETURN * WRTQG INA BUMP CHARACTER COUNT ARS CHANGE TO WORDS LDB IOUTP CPB IOLSP IF LIST DEVICE, IGNORE BINARY FORMAT JMP *+4 LDB XPRFL IF TRANSPARENT, SSB INA BUMP COUNT FOR LENGTH WORD STA CNT1 PLACE IN CNT1 ALF,ALF STA #WRBF-1 STOREx IN CASE A BINARY WRITE LDA C40 PUT A BLANK ON THE END OF BUFFER JSB STRBY LDA WRBFB STA WBFPT SET BUFFER ADDRESS LDB XPRFL IF TRANSPARENT DO BINARY WRITY LDA IOUTP SSB SKIP IF NOT TRANSPARENT CPA IOLSP IF LIST, DO ASCII WRITE ISZ WBFPT SET ADDR FOR ASCII WRITE * JSB WRITF CALL FMP TO WRITE DATA DEF *+5 OTDCB NOP DCB ADDR DEF RDERR WBFPT NOP DEF CNT1 WORD COUNT * SSA,RSS IF POSITIVE JMP WRTQX PROCESS JSB FERR ELSE REPORT FILE ERROR LDB ABORT GET ABORT FLAG SSB IF THIS IS ABORT , JMP WRTQX EXIT PROCESSOR JMP DWN.2 AND ABORT * * IOLSF NOP ENTRY LDA DLSF GET DCB ADDRESS FOR LIST JSB WRITQ GO DO WRITE JMP IOLSF,I EXIT ROUTINE * IOPUF NOP ENTRY LDA DPUF GET DCB ADDRESS FOR PUNCH JSB WRITQ GO DO WRITE JMP IOPUF,I EXIT ROUTINE * UNL XIF LST * * *************************************************************************** SKP ************************************************************************ 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 [ \ ! ] - * SKP ************************************************************************ * 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 * SKP ************************************************************************ TABL. DEF E000 LOCATION OF TRANSLATION TABLE * * THIS IS THE TABLE FOR CONVERSION FROM EBCDIC TO ASCII * XXX INDICATES NO TRANSLATION, THE RESULTING CHARACTER * 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 r104211,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 \ : # @ ' = " * SKP ************************************************************************ * 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 * E220 OCT 110152,065554,066556,067560 * XXX J K L M N O P * E230 OCT 070562eHFB,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 * SKP ************************************************************************ * 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 * ************************************************************************ **************************************************************************** uH SKP UNL IFZ LST **************************************************************************** * ASCII MESSAGE TABLES **************************************************************************** * MESXX ASC 1,XX MES19 ASC 5,FMGR ERROR MES20 ASC 24,SECURITY CODE VIOLATION (#BSC NOT FOUND IN CORE) MES21 ASC 9,PASSWORD VIOLATION MES22 ASC 21,ILLEGAL MODE FOR REQUEST ISSUED TO DRIVER MES23 ASC 19,ILLEGAL BUFFER FORMAT GIVEN TO DRIVER MES24 ASC 22,ILLEGAL BISYNC SEQUENCE RECEIVED REPEATEDLY MES25 ASC 11,LOSS OF CLEAR TO SEND MES26 ASC 20,8 NAK CHARACTERS SENT (GARBAGE RECEIVED) MES27 ASC 25,8 NAK CHARACTERS TRANSMITTED (GARBAGE TRANSMITTED) *28 UNUSED *29 UNUSED MES30 ASC 18,RECEIVE TIMEOUT OCCURRED REPEATEDLY MES31 ASC 10,LONG TIMEOUT FAILURE MES32 ASC 20,LINE TERMINATION SEQUENCE SENT (DLE/EOT) MES33 ASC 22,LINE TERMINATION SEQUENCE RECEIVED (DLE/EOT) MES34 ASC 15,LOSS OF DATA SET READY SIGNAL MES35 ASC 25,LOSS OF CARRIER DETECT DURING RECEIVE (REPEATEDLY) MES36 ASC 13,TTD OR WACK LIMIT EXCEEDED MES37 ASC 18,REQUEST TIMEOUT DURING CONTROL MODE *38 UNUSED *39 UNUSED * NOTE THAT CODES 20-37 REPORT ERRORS WHICH WERE DETECTED * IN THE DRIVER, AND ARE CONSIDERED IRRECOVERABLE. * * MES40 ASC 16,NAK READ REQUEST ISSUED 3 TIMES MES41 ASC 20,REMOTE DOES NOT RESPOND TO BID FOR LINE MES42 ASC 8,I/0 DEVICE ERROR MES43 ASC 17,I/O CONFIGURATION PARAMETER ERROR MES44 ASC 14,LOGICAL UNIT NUMBER INVALID MES45 ASC 10,DVR50 NOT AVAILABLE MES46 ASC 15,I/O REQUEST REJECTED BY DVR50 MES47 ASC 13,USER REQUEST TO ABORT RJE MES48 ASC 25,TIMEOUT AND CONTROL MODIFICATION PARAMETER ERROR * * * NOTE THAT CODES 40-48 ARE ERRORS DETECTED BY RJE. * * MES50 ASC 9,INITIALIZE DRIVER MES51 ASC 8,#DIAL SCHEDULED MES52 ASC 17,ESTABLISH REMOTE MODEM CONNECTION MES53 ASC 6,LISTENING... MES54 ASC 3,WRITE MES55 ASC 2,READ MES56 ASC 4,SEND EOT MES57 ASC 6,BID FOR LINE MES58 ASC 5,DISCONNECT MES59 ASC 12F,REQUEST EXTENDED STATUS MES60 ASC 13, IRRECOVERABLE LINE ERROR MES61 ASC 9, TERMINAL ON LINE MES62 ASC 7, TRANSMIT MODE MES63 ASC 7, RECEIVE MODE MES64 ASC 7, RVI RECEIVED MES65 ASC 9, BUFFER OVERFLOWED MES66 ASC 7, CONTROL MODE MES67 ASC 14, WAITING FOR REMOTE MODEM... * * NOTE THAT CODES 50-67 ARE PRINTED ONLY IN DIAGNOSTIC * MODE, AND ARE INFORMATION MESSAGES, NOT ERROR * MESSAGES. * MES70 ASC 1,ON MES71 ASC 13,ENTER CONFIGURATION DATA MES72 ASC 6,TERMINATED * *************************************************************************** SKP *************************************************************************** * MESSAGE LENGTH TABLE (CHARACTERS.DIV.2) MSLEN DEF *+1-19 DEC 5 19 DEC 24 20 DEC 9 21 DEC 21 22 DEC 19 23 DEC 22 24 DEC 11 25 DEC 20 26 DEC 25 27 DEC 1 28 UNUSED DEC 1 29 UNUSED DEC 18 30 DEC 10 31 DEC 20 32 DEC 22 33 DEC 15 34 DEC 25 35 DEC 13 36 DEC 18 37 DEC 1 38 UNUSED DEC 1 39 UNUSED DEC 16 40 DEC 20 41 DEC 8 42 DEC 17 43 DEC 14 44 DEC 10 45 DEC 15 46 DEC 13 47 DEC 25 48 DEC 1 49 UNUSED DEC 9 50 DEC 8 51 DEC 17 52 DEC 6 53 DEC 3 54 DEC 2 55 DEC 4 56 DEC 6 57 DEC 5 58 DEC 12 59 DEC 13 60 DEC 9 61 DEC 7 62 DEC 7 63 DEC 7 64 DEC 9 65 DEC 7 66 DEC 14 67 DEC 1 68 UNUSED DEC 1 69F UNUSED DEC 1 70 DEC 13 71 DEC 6 72 * **************************************************************************** SKP *************************************************************************** * TABLE OF POINTERS TO TEXT STRINGS * MSTXT DEF *+1-19 DEF MES19 DEF MES20 DEF MES21 DEF MES22 DEF MES23 DEF MES24 DEF MES25 DEF MES26 DEF MES27 DEF MESXX 28 UNUSED DEF MESXX 29 UNUSED DEF MES30 DEF MES31 DEF MES32 DEF MES33 DEF MES34 DEF MES35 DEF MES36 DEF MES37 DEF MESXX 38 UNUSED DEF MESXX 39 UNUSED DEF MES40 DEF MES41 DEF MES42 DEF MES43 DEF MES44 DEF MES45 DEF MES46 DEF MES47 DEF MES48 DEF MESXX 49 UNUSED DEF MES50 DEF MES51 DEF MES52 DEF MES53 DEF MES54 DEF MES55 DEF MES56 DEF MES57 DEF MES58 DEF MES59 DEF MES60 DEF MES61 DEF MES62 DEF MES63 DEF MES64 DEF MES65 DEF MES66 DEF MES67 DEF MESXX 68 UNUSED DEF MESXX 69 UNUSED DEF MES70 DEF MES71 DEF MES72 * ***************************************************************************** **************************************************************************** UNL XIF LST *************************************************************************** BSS 0 RJE LENGTH * END RJE U W 91780-18012 1840 S C0122 &#COMN #COMN CNTRL & BFFR             H0101 qASMB,R,L,C HED #COMN: COMMON STORAGE FOR RJE * (C) HEWLETT-PACKARD CO.1978 * * NAM #COMN,30 91780-16003 REV.1648 761109 * NAM #COMN,30 7-18-78 W/ MAGNOVOX FIXES & CNT MODE T.O. NAM #COMN,30 91780-16012 REV.1840 780725 ENT #TIME,#CTRL,#CMBF,#WRBF,#RDBF,#RDCB,#LDCB,#PDCB ENT #TFLG,#TBUF,#OVRN,#WRPT,#RDPT,#BFEN * * NAME: #COMN * SOURCE: 91780-18012 * RELOC: 91780-16012 * PGMR: C. HAMILTON ( 11/09/76 ) * D. BOLIERE ( 7/18/78 ) * MODIFIED BY: * * ***************************************************************** * * (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. * * ***************************************************************** * * THIS MODULE PROVIDES COMMON STORAGE FOR THOSE CONSTANTS AND BUFFERS * WHICH MUST BE SHARED BETWEEN RJE AND THE LIBRARY PORTION OF THE * BISYNC COMMUNICATIONS DRIVER: #BSC/DVR50. * * PROGRAM TYPE 30 WILL FORCE THE RTE-III GENERATOR TO PLACE THIS * MODULE INTO THE SUBSYSTEM GLOBAL AREA. THUS, WHEN THE USER SPECIFES * THAT PRIVILEGED DRIVERS HAVE ACCESS TO SSGA, AND IF #BSC IS FORCED * TO RESIDE IN THE SUBSYSTEM GLOBAL AREA OF THE RTE-III SYSTEM, THEN * NO TIME-CONSUMING MAP SWITCHING WILL BE REQUIRED OF THE DRIVER. * * ADDITIONALLY, IF #BSC IS SSGA-RESIDENT(RTE-III), RJE MAY BE SWAPPED * SINCE ALL OF ITS BUFFERS ARE LOCATED IN THIS SSGA-RESIDENT MODULE. * [** USER MAY MODIFY TIMEOUT AND CONTROL VALUES--IF NECESSARY **] * #TIME DEF *+1 ADDRESS OF TIMEOUT/CONTROL ARRAY. DEC -301 RECEIVE TIMEOUT = 3.01 SEC. DEC -190 TRANSMIT TIMEOUT = 1.90 SEC. DEC -2000 LONG TIMEOUT = 20.0 SEC. DEC -1500 MAXIMUM NO. OF TTD/WACK SEQUENCES. DEC -15 K   CONTROL MODE TIMEOUT=5.0 MINUTES * #CTRL DEC 0 BIT#2(LINE CODE): 0=EBCDIC, 1=ASCII * BIT#1(BUF. TERM): 0=PAD W/BLANKS, 1=USE 'EOM' * BIT#0(LINE MODE): 0=HALF DUPLEX, 1=FULL DUPLEX * * TRACE BUFFER AND ADDRESS POINTERS. >>>>> DO NOT CHANGE! <<<<< * #TFLG NOP TRACE ON=NON-ZERO #TBUF DEF TBUF FWA OF TRACE BUFFER #OVRN NOP NON-ZERO IF BUFFER OVERRUNS DEVELOP #RDPT DEF TBUF READ POINTER #WRPT DEF TBUF WRITE POINTER #BFEN DEF TBFEN LWA OF TRACE BUFFER TBUF BSS 200 MUST BE 200 WORDS FOR 4800 BAUD! TBFEN EQU * * * * DATA BUFFERS AND DATA CONTROL BLOCKS. >>>>> DO NOT CHANGE! <<<<< * #CMBF BSS 212 COMMUNICATIONS DATA BUFFER. BSS 1 (EXTRA WORD FOR TRANSPARENT WRITE). #WRBF BSS 73 WRITE BUFFER. #RDBF BSS 40 READ BUFFER. * #RDCB BSS 144 INPUT-FILE DATA CONTROL BLOCK #LDCB BSS 144 LIST-FILE DATA CONTROL BLOCK #PDCB BSS 144 PUNCH-FILE DATA CONTROL BLOCK * BSS 0 [ MODULE SIZE ] * END '   91780-18013 2001 S C0422 &#BSC DRIVER EXTENSION             H0104 ASMB,R,Q,C HED #BSC: BISYNC TELECOM DRIVER * (C) HEWLETT-PACKARD CO.1979 * NAM #BSC,14 91780-16013 REV.2001 791009 ENT #BSC EXT $TIME * * NAME: #BSC * SOURCE: 91780-18013 * RELOC: 91780-16013 * PGMR: P. KAPOOR ( 11/20/73 ) * * MODIFIED BY: P. KAPOOR, R.SHATZER ( 01/11/75 ) * C. WHELAN ( 10/31/75 ) * C. HAMILTON ( 04/12/77 ) * C. HAMILTON ( 04/01/78 ) * D. BOLIERE, R. GUDZ ( 08/11/78 ) * R. GUDZ ( 04/26/79 ) * R. GUDZ ( 10/09/79 ) * * ***************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * ***************************************************************** * * CAUTION: * THIS IS THE SSGA (OR LIBRARY) RESIDENT PORTION OF A SYSTEM * RESIDENT TELECOMMUNICATION DRIVER DVR50 . THIS * MODULE MAY BE APPENDED AS A SUBROUTINE TO THE * MAIN DEVICE EMULATOR PROGRAM. IT CAN RESIDE EITHER * IN THE USER AREA OR IN THE SYSTEM AREA. IN FORMER * CASE IT MUST NOT BE SWAPPED OUT ONCE INITIATED. * * REFER TO THE SYSTEM RESIDENT DVR50 BEFORE USING * THIS MODULE. * * * ON ENTRY INTO #I.50 DURING INITIALIZATION , EQT7 * CONTAINS SYNC CHARACTER FOR THE LINE CODE WITH BIT * 15 EQUAL TO 1 FOR CRC AND 0 FOR LRC. UPON EXIT * BACK INTO THE SYSTEM RESIDENT DRIVER, REG-B HAS * THE PASSWORD. REG-A ALWAYS HAS COMPLETION CODE. * RETURN IS (P+1) AFTER INITIALIZATION AND (P+2) * OTHERWISE. * * ON EXIT FROM #C.50 INTO DVR50 , TAKE (P+1) RETURN IF IN BETWEEN REQUESTS, * TAKE A (P+2) RETURN ON COMPLETION AND (P+3) RETURN FOR CONTINUATION. * * FOR (P+2) RETURN , REG-A & B HAVE COMPLETION PARAMETERS. * * RETURN FROM #P.50 IS ALWAYS (P+1) . * =RECV. SYNC-REFERENCE COMMAND, IF SYNC HUNT MODE; OR =0, IF NOT. * ************************************************************************** SKP ************************************************************************** * PCO 1840 AUGUST 11,1978 * * * 1. TRACE HAS BEEN ADDED! * * 2. EACH LINE BID WILL LAST AS LONG AS 127 ENQ'S. * ************************************************************************** ************************************************************************** * PCO 1926 APRIL 26,1979 * * RTE-IVB SESSION MONITOR COMPATIBILITY! * * * RJE NOW RETRANSMITS DATA IF IT WAS LOST AND * THE RECEIVER ANSWERED WITH THE LAST ACK. * * (RJE PREVIOUSLY FAILED TO USE THIS ACK0/ACK1 FEATURE.) * ************************************************************************** ************************************************************************** * PCO 2001 OCTOBER 9, 1979 * * NOTE: RJE HAS BEEN CHANGED ALSO FOR PCO 2001!!! * * DURING READ AND WRITE CALLS, RJE NOW PASSES A BUFFER * POINTER. THIS IS FOR COMPATIBILITY WITH PCO 1926 OF RTE. * IN THIS WAY, USER MAP IS ENABLED UPON DRIVER ENTRY. * ************************************************************************** SKP * * 160010 [XMIT BOARD] * * * 1 * 1 1 0 * 0 0 0 * 0 0 0 * 0 0 1 * 0 0 0 * * ****************************************************************** * * C * C C R * P P S * S T ! NOT USED ! CHAR SIZE * * * M * M D C * A A Y * T E ! * ! * * * * D * D V * R R N * A S ! * ! * * * * * O * C * T T ! * ! * * * * * N (C)* S S * ! * ! * * * * * (A)* T E E * I ! * ! * * * * * i * A N N * N ! * ! * * * * * O * T S A * T ! * ! * * * * * F * E B * ! * ! * * * * * F * O L * O ! * ! * * * * * * F E * F ! * ! * * * * * * F V O * F ! * ! * * * * * * E N * ! * ! * * * * * * N * ! * ! * * * ****************************************************************** * * * 151030 [RCV BOARD] * * * 1 * 1 1 0 * 0 0 0 * 0 0 0 * 0 0 1 * 0 0 0 * * ****************************************************************** * * C * C X C * P P S * S S S * T S ! CHAR SIZE * * * M * M D * A A Y * T P B * E Y ! * * * * D * D * R R N * A E A * S N ! * * * * * O * C * T C * T C ! * * * * * N * S E * O * ! * * * * * * T V H * C F * C F ! * * * * * * A E U * I H F * L L ! * * * * * * T N N * N * K G ! * * * * * * T * T I * ! * * * * * * O * N * O ! * * * * * * F O * O T * N ! * * * * * * F N * F * ! * * * * * * * F O * ! * * * * * * * F * ! * * * * * * * F * ! * * * ****************************************************************** * SKP * * 171010 [XMT BOARD] * * * 1 * 1 1 0 * 0 0 0 * 0 0 0 * 0 0 1 * 0 0 0 * * ****************************************************************** * * C * C C S * P P S * S T ! NOT USED ! CHAR SIZE * * * M * M D N * A A Y * T E ! * ! * * * * D * D D * R R N * A S ! * ! * * * * * O * C * T T ! * ! * * * * * N (C)* S E * ! * ! * * * * * (A)* T V E * I ! * ! * * * * * * A E N * N ! * ! * * * * * O * T N A * T ! * ! * * * * * F * B * ! * ! * * * * * F * O L * O ! * ! * * * * * * F * F ! * ! * * * * * * F O * F ! * ! * * * * * * F * ! * ! * * * * * * F * ! * ! * * ******************************************************************* SKP * #BSC OCT 150003 SECURITY CODE DEF #I.50 DEFINE DEF #C.50 LIBRARY DEF #P.50 ENTRY POINTS. * #I.50 NOP STA TIMAD SAVE ADDRESS OF TIMEOUT VALUES. LDA EQ6,I AND M3777 GET FUNCTION AND REQUEST CODES STA FUNC * LDA BIT12 LDB TFLAG,I FETCH TRACE FLAG SZB SET SWITCHES TO EITHER NOP LDB RSSI OR RSS CPB TSW1 CHANGING MODE? JMP TSW1 NO, SKIP SETTING SWITCHES INA YES, SO INDICATE IN TRACE ENTRY STB TSW1 SET TRACE SWITCHES STB TSW2 STB TSW3 STB TSW4 * TSW1 NOP TRACE SWITCH JMP *+3 LDB FUNC SET BREG TO FUNCTION JSB TRACE LDA FUNC RESUME PROCESSING LDB CWTBL REG-B HAS PROCESS POINTER SCH CPA 1,I FOUND THE PROCESS u? JMP GOTIT YES INB BUMP PROCESS POINTER CPB CWLST JMP REJ2 ILLEGAL FUNCTION, REJECT JMP SCH LOOP BACK. GOTIT ADB TLEN JMP 1,I GET ADDR OF PROCESSOR & GO * CWTBL DEF *+1 CONTROL WORK TABLE OCT 3703 INITIALIZE OCT 3603 DISCONNECT REO7 OCT 3503 RECEIVE-TO-SEND REO6 OCT 3403 HANDSHAKE REO9 OCT 3303 AUTO-ANSWER REO8 OCT 3203 SEND EOT REO10 OCT 3103 SEND-TO-RECEIVE (1 LONG T.O.) OCT 2703 SEND-TO-RECEIVE (20 SECS) OCT 3702 WRITE REO5 OCT 3701 WRITE-CONVERSATIONAL REO4 OCT 3601 READ (SEND RVI) REO3 OCT 3501 READ CONVERSATIONAL. REO2 OCT 3401 READ (SEND NAK) REO1 OCT 3301 READ (SEND ACK0 OR ACK1) * TLEN ABS *-CWTBL-32768 DEF INITL INITIALIZE DEF OFF DISCONNECT DEF RC2SD RECEIVE-TO-SEND DEF HNDSK HANDSHAKE DEF ANSWR AUTO-ANSWER DEF SEOF SEND 'EOT' DEF SD2RC SEND-TO-RECEIVE (1 LONG T.O.) DEF LSN20 SEND-TO-RECEIVE (20 SECONDS) DEF SEND WRITE DEF SENDC WRITE-CONVERSATIONAL DEF READ READ (SEND 'RVI') DEF READ READ (CONVERSATIONAL) DEF READ READ(SEND 'NAK') DEF READ READ (SEND 'ACK0' OF 'ACK1') * CWLST DEF TLEN * * ** INITIALIZATION ** * * THIS SECTION INITIALIZES THE DRIVER. * ON EXIT, REG-B HAS A PASSWORD WHICH IS THE * ADDRESS OF XLINK WORD IN USER'S ID SEGMENT. * THIS ROUTINE SETS UP SYSTEM TIME PARAMETERS * OBTAINED FROM #COMN ROUTINE. * * INITL LDA EQ1 SET ADA P3 LDB EQ4A STA 1,I SET EQT POINTER INB INA CPB EQ12A RSSI RSS DONE JMP *-5 DO NEXT LDA EQ12 STA EQT12 INA STA EQT13 ADA P2 STA EQT15 CLB  STB EQ14,I MAKE SURE THAT TIMER STB 0,I IS ZERO * LDA EQTA EQT CMA,INA ADA EQ1 THIS EQT ADDR - 1ST EQT ADDR DIV P15 COMPUTE RELATIVE EQT # INA STA EQT# * LDA EQT7,I SET UP BCC AND CODE FLAG STA BCCFL JSB CCADR SET UP LINE CODE TABLE LDA EQT4,I SET BIT12 OF EQT4 TO TELL RTE IOR MTOWN TO ENTER C.50 ON TIME-OUT . STA EQT4,I * LDA TIMAD GET ADDRESS OF TIMEOUT VALUES. LDB A,I SET UP STB RCTM RECEIVE TIMEOUT INA LDB A,I STB XMTM TRANSMIT TIMEOUT INA LDB A,I STB LGTM LONG TIMEOUT INA LDB A,I STB #NUMB # OF TTD'S / WACK'S INA LDB A,I FETCH CONTROL MODE TIMEOUT STB CMDTM INA BUMP POINTER TO MODE CONTROL WORD LDB A,I GET CONTROL WORD STB DUPLX SET VALUE FOR HALF/FULL DUPLEX FLAG * INA BUMP ADDRESS STA TFLAG INA STA TBUF START OF TRACE BUFFER INA STA OVRN OVERRUN FLAG INA STA RDPT READ POINTER INA STA WRPT WRITE POINTER INA STA BFEN END OF BUFFER * CCA INITIALIZE UPPER TIME STAMP STA LTIME * JSB EXST CLEAN EXTENDED STATUS STA SETCN CLR STC ,C FLAG FROM LAST TIME * * CONFIGURE I/O INSTRUCTIONS * LDA EQT4,I GET DEVICE'S AND M77 CHANNEL NUMBER (RECEIVE BOARD) STA B IN B-REG IOR OTA FORM CONFIGURED OTA STA OTA1R CONFIGURE RECEIVE BOARD STA OTA4R STA OTA5R STA OTA6R STA OTA7R INA STA OTA1S CONFIGURE SEND BOARD STA OTA2S STA OTA3S STA OTA4S STA OTA6S STA OTA7S * LDA CLC IOR B FORM CONFIGURED CLC XX,C STyJA CLC2 STA PCLCR STA CCLCR INA INCREMENT FOR SEND BOARD STA CLC1 STA PCLCT STA CCLCT * LDA STC FORM COFIGURED STC XX,C IOR B STA STC1R INA STA STC1S * LDA LIA FORM CONFIGURED LIA XX IOR B STA LIA3R INA STA SSTA LDA SYNC OUTPUT THE SYNC CHARACTER OTA6S OTA 0 TO THE TRANSMIT BOARD, OTA6R OTA 0 AND TO THE RECEIVE BOARD. * LDA EQT5,I CLEAN STATUS IN EQT4 AND MFST STA EQT5,I JSB WACTZ CLEAN WACK/TTD & SPEC CASE FLAG LDB EQ1,I GET ADDRESS OF USER'S I.D. SEGMENT. STB PSWD USE IT FOR THE PASSWORD. JSB SCLR CLEAN INTERNAL FLAGS. STA LINE SET TERMINAL OFF-LINE. STA FUNC ERASE FUNCTION FOR LDA P4 IMMEDIATE COMPLETION JMP CLC1 DO CLC'S & EXIT * EQ4A DEF EQT4 EQ12A DEF EQT12 * *** CLEAN INTERNAL FLAGS FOR NEXT OPERATION *** SCLR NOP TIMAD EQU SCLR SHARE STORAGE (INITIALIZATION ONLY). CLA STA EOF CLEAR "EOT" FLAG STA RQ2SD CLEAR "RVI" FLAG STA INERR CLEAR OPERATION IN ERROR FLAG STA TLOG CLEAR TRANSMISSION LOG STA OVRFL CLEAR BUFFER-OVERFLOW FLAG STA SYNFL CLEAR SYNC-REFERENCE FLAG JMP SCLR,I RETURN * *SCFWA OCT 25045 TEMP DEBUG TFLAG DEF OVRN TRACE FLAG ADDRESS OVRN NOP OVERRUN FLAG ADDRESS TBUF NOP FWA OF TRACE BUF WRPT NOP ADDRESS OF WRITE POINTER RDPT NOP ADDRESS OF READ POINTER BFEN NOP END OF BUFFER ADDRESS SKP * ** ACTIVATE TIMER ** * * THIS ROUTINE SETS UP TIME-OUT VALUE IN EQT15. * EQT14 IS NOT USED BY THIS DRIVER (EQT14 IS SET TO * ZERO AFTER THE INITIALIZATION CALL AND THE USER * MUST NOT ATTEMT TO DO ANY KIND OF DEVICE TIME-OUT * MANIPULATION WHILE THE DRIVER IS IN USE). * * ON ENTRY INTO 'JTACTV' : * REG-A = NEG NUMBER OF 10 MSEC INTERVALS * REG-B = ADDRESS OF ROUTINE TO BE EXECUTED * UPON TIMEOUT * TACTV NOP LDB TACTV,I STA EQT15,I SET TIME-OUT VALUE OR ZERO IT SZA IS IT DEACTIVATE TIMER ? STB TADRS NO. THEN SET TRANSFER ADDRESS. ISZ TACTV JMP TACTV,I RETURN. * TADRS NOP TRANSFER ADDRESS AFTER REENTRY ON TIMEOUT STA EQT15,I SET TIMEOUT JMP EXITR * TACTZ NOP CCA STA EQT15,I SET FAST TIMEOUT LDA TACTZ STA TADRS SET ADDR UPON RETURN * RTN0 CLA CLC1 CLC 0,C XMIT BOARD CLC2 CLC 0,C RCV BOARD JMP #I.50,I **************************************************** SKP * ** C.50 ** * #C.50 NOP LDA SETCN FETCH STC FLAG SSA,RSS ARE WE TO STC THE CARDS UPON EXIT? CLA NO, SO RESET FLAG STA SETCN * LDA RSSI STA EXITR MODIFY INSTRUCTION ISZ #C.50 ISZ #C.50 ASSUME (P+2) RETURN JMP TADRS,I GO TO TIME-OUT PROCESSOR. * * ** P.50 ** #P.50 NOP CLA STA SETCN CLEAR 'STC XX,C' FLAG STA EXITR MODIFY INSTRUCTION JSB LCHCK DROP LINE IF DATA-SET IS OFF. JMP EXIT,I TRANSFER ADDRESS ON I/O INTERRUPT * EXIT NOP EXITR NOP #C.50 EXIT ? JMP PEXIT NO, THEN #P.50 EXIT. ISZ SETCN YES. SET CONTROL,CLEAR FLAG ? JMP CCLCT NO, DO CLC,CLF ON BOTH BOARDS CCLC CLC 0,C STC1 STC 0,C CONFIGURED SET CONTROL, CLR FLAG JMP #C.50,I RETURN * #P.50 EXIT PEXIT LDA SYNFL GET SYNC-REFERENCE COMMAND, OR ZERO. ISZ SETCN SET CONTROL, CLEAR FLAG? JMP PCLCT NO, DO CLC, CLF ON BOTH BOARDS PCLC CLC 0,C STC2 STC 0,C CONFIGURED SET CONTROL, CLR FLAG JMP #P.50,I RETURN: =SYNC REF, OR ZERO. * PCLCT CLC 0,C PCLCR CLC 0,C H JMP #P.50,I * CCLCT CLC 0,C CCLCR CLC 0,C JMP #C.50,I * STC STC 0,C CLC CLC 0,C OTA OTA 0 LIA LIA 0 * DEVDN OCT 40000 DEVICE DOWN MASK MTOWN OCT 10000 MFHNT OCT 176777 MFST OCT 177400 M3777 OCT 3777 STC1S NOP CONFIGURED STC XX,C (SEND BOARD) STC1R NOP CONFIGURED STC XX,C (RECEIVE BOARD) SETCN NOP IF -1 THEN SET CONTROL ON BOARD SYNFL NOP SYNC-REF.CMD, IF SYNC HUNT; OR ZERO MSK14 OCT 140000 * * SET CONTROL, CLEAR FLAG ON SEND BOARD SYN2S NOP JSB SYN7 OUTPUT CHAR LDA STC1S CONFIGURE INSTRUCTIONS FOR STA STC1 SEND BOARD STA STC2 JSB SYN3S READ STATUS SSA,RSS DATA SET OFF ? JMP DSOF YES SLA,RSS CLEAR-TO-SEND OFF ? JMP MODFL YES CCA STA SETCN STC,C FLAG LDA CCLCR STA CCLC STA PCLC JSB EXIT EXIT DRIVER FOR NOW JMP SYN2S,I RETURN * * SET CONTROL, CLEAR FLAG ON RECEIVE BOARD SYN2R NOP LDA STC1R CONFIGURE INSTRUCTIONS FOR STA STC1 RECEIVE BOARD STA STC2 CCA STA SETCN SET CONTROL AND CLEAR FLAG UPON LDA CCLCT STA CCLC STA PCLC JMP SYN2R,I RETURN * * GET SEND BOARD STATUS SYN3S NOP SSTA LIA 0 LOAD A-REG WITH STATUS BITS RAL,RAL JMP SYN3S,I RETURN * * GET RECEIVE BOARD STATUS SYN3R NOP LIA3R LIA 0 LOAD A-REG WITH STATUS BITS JMP SYN3R,I RETURN * * CCADR NOP LDB N13 STB SYN3S SET 13 WORD TRANSFER LDB CCADD STB SYN3R SET DESTINATION ADRS LDA BCCFL AND MASK GET LINE CODE SYN CHAR LDB ASCCC CPA ECCC+11 LINE CODE = EBCDIC ? LDB EBCCC YES MUST BE ASCII. LOOP2 LDA B,I TRANSFER STA SYN3R,I A WORD. INB BUMP SOURCE ADDRESS ISZ SYN3R BUMP DESTINATION ADDRESS ISZ SYN3S ALL 7DONE ? JMP LOOP2 NO JMP CCADR,I YES, LEAVE. * * SET UP BOARD TO SEND * SYN5 NOP STA SEC3C SET TIMEOUT LDA SSEND GET SYNC CONFIGURED CONTROL WORD OTA3S OTA 0 OUTPUT TO I/O BOARD CLB JSB SYN7 SEND BLANKS JMP SYN5,I RETURN * * * SET UP BOARD TO RECEIVE * SYN6 NOP LDA STOR GET TURN-AROUND CONTROL WORD LDB DUPLX GET DUPLEX FLAG SLB,RSS SKIP IF FULL DUPLEX OTA4S OTA 0 CHANGE SEND BOARD TO RECEIVE CONDITION LDA SREVC GET SYNC CONFIGURED CONTROL WORD OTA4R OTA 0 OUTPUT TO I/O BOARD JMP SYN6,I RETURN * * * SEND CHARACTER TO THE I/O BOARD (CHARACTER IN B) * * SYN7 NOP LDA B AND MASK MASK EXTRANEOUS BITS OTA2S OTA 0 OUTPUT TO SEND BOARD TSW2 NOP TRACE SWITCH JMP SYN7,I RETURN IOR BIT15 JMP TTRAC CREATE A TRACE ENTRY * * * GET RECEIVED CHARACTER AND PLACE IN A-REG * DOLIA NOP JSB SYN2R ENABLE RCV INTERRUPTS JSB EXIT AWAIT NEXT WORD JSB SYN3R GET CHARACTER FROM RECEIVE BOARD ALF,RAR SLA,RSS DATA SET OFF ? JMP DSOF YES SSA RECEIVED CARRIER FAILED ? JMP DOLIX NO CCA YES STA CARCT SET "CARRIER FAILED" FLAG LDA SREVC AND MFHNT OTA5R OTA 0 DISABLE LINE STATUS INTERRUPT DOLIX JSB SYN3R AND MASK TSW3 NOP TRACE SWITCH JMP DOLIA,I RETURN * * TTRAC: TIME TRACE ROUTINE TO CREATE A 2 WORD ENTRY COMPLETE * WITH LOWER TIME STAMP. ALSO REPORTS NEW UPPER TIME * STAMP IF NEEDED. * TTRAC LDB $TIME+1 FETCH UPPER TIME STAMP CPB LTIME SAVE AS LAST REPORTED? JMP TRAC2 YES, THEN JUST REPORT DATA & LOWER TIME STB LTIME NO, RESET AND REPORT NEW UPPER TIME STA TTEMP+1 LDA BIT14 JSB TRACE LDA TTEMP+1 FE"TCH BACK DATA BYTE TRAC2 LDB $TIME JSB TRACE CREATE DATA ENTRY LDA TTEMP RESTORE AREG SSA WHICH WAY OUT? JMP SYN7,I JMP DOLIA,I * * TRACE: SUBROUTINE TO CREATE A TWO WORD ENTRY INTO THE TRACE * BUFFER. CHECKS FOR AND INDICATES OVERRUN CONDITIONS. * TRACE NOP STA TTEMP SAVE A-REG LDA WRPT,I STB 0,I SAVE B-REG FIRST INA LDB TTEMP STB 0,I THEN A-REG INA CPA BFEN,I END OF TRACE BUFFER? LDA TBUF,I YES, RESET POINTER STA WRPT,I CPA RDPT,I OVERRAN READ POINTER? ISZ OVRN,I YEP, TELL SOMEONE NOP JMP TRACE,I * TTEMP BSS 2 LTIME NOP * CARCT NOP CARRIER FAIL COUNTER * DUPLX NOP 0 FOR HLF-DUPLEX, 1 FOR FULL DUPLEX * * PASSWORD VALIDATION ROUTINE PSW NOP CPA PSWD PASSWORD CORRECT ? JMP PSW,I YES, THEN RETURN. LDB BIT1 SET PASSWORD VIOLATION JMP MVIOL+1 * VALIDATE ON-LINE CONDITION ONLN NOP LDA LINE SZA TERMINAL ON-LINE JMP ONLN,I YES, THEN RETURN. JMP MVIOL RECORD MODE VIOLATION * ERCNT NOP JSB UPCAR BRING UP CARRIER LDA M8 STA ERROR SETUP ERROR RETRY COUNTER JMP ERCNT,I M8 DEC -8 * * VALIDATE OFF-LINE CONDITION OFLN NOP LDA LINE SZA,RSS TERMINAL OFF-LINE ? JMP OFLN,I YES, THEN RETURN. JMP MVIOL RECORD VIOLATION IN STATISTICS * * VALIDATE RECEIVE MODE CONDITION RMD NOP LDA EQT9,I JSB PSW CHECK PASSWORD LDA RCSND SZA,RSS IN RECEIVE MODE ? JMP RMD,I YES, THEN RETURN. JMP MVIOL RECORD MODE VIOLATION * * VALIDATE CONTROL MODE CONDITION CNTMD NOP JSB ONLN VALIDATE THAT ON-LINE LDA EQT5,I GET PREVIOUS STATUS AND P12 GET XMIT AND REC BITS SZA,RSHFBS TRML IN XMIT OR REC MODE ? JMP CNTMD,I NO, THEN IT IS OK. * MVIOL LDB BIT2 GET (B) FOR MODE VIOLATION JSB SET SET VIOLATION IN STATISTICS * REJ2 LDA EQ5,I SET 'OPERATION IN ERROR' IOR P1 IN STANDARD STATUS WORD. STA EQ5,I LDA P2 REG-A = 2 FOR ERROR RETURN CLB STB FUNC ERASE FUNCTION HOLDER. JMP #I.50,I RETURN EQ5 EQU 1664B * * *** HANDSHAKE PROCESSOR *** * * EXECUTION STEPS: * 1. REJECT IF PASSWORD IS INCORRECT. * 2. REJECT IF TERMINAL ON-LINE. * 3. WAIT FOR OPERATOR TO DIAL REMOTE. * 4. SEND "ENQ" CHARACTER TO REMOTE. * 5. WAIT FOR "ACK0" OR "RVI" FROM REMOTE. * 6. ACTIVATE THE "TTD" MODULE TO FUNCTION FOR THE * TIME SPECIFIED BY THE "#COMN" ROUTINE. * * HNDSK LDA EQT7,I JSB PSW CHECK PASSWORD JSB OFLN CHECK MODE JSB EXST CLEAN EXTENDED STATUS JSB TACTZ * * REQUEST ACCEPTED. SET UP I/O BOARD. * LDA SEC10 JSB SYN5 PRIME I/O BOARDS HDSK1 JSB SYN3S GET STATUS OF SEND BOARD SSA DATA SET READY ? JMP BHND1 YES BHND LDA EQTM SET 1 SEC TIMER LOOP JSB TADRS AT "HDSK1" JMP HDSK1 * BHND1 SLA CLEAR-TO-SEND UP ? JMP CTSOK YES. ISZ SEC3C 10 SEC OVER ? JMP BHND NO JMP MODFL YES, REPORT FAILURE. * CTSOK ISZ EOF INDICATE CONTROL MODE CLA,INA SET UP THE A REGISTER JMP CTSXT FOR A BUMMED EXIT! * * l`H SKP * * *** "ENQ" PROCESSOR *** * * THIS ROUTINE SENDS AN "ENQ" TO REMOTE AND EXPECTS * TO RECEIVE ACK0 OR RVI. IF SOME OTHER CHARACTER IS * RECEIVED, "ENQ" WILL BE RESENT UP TO 127 TIMES.IF * ACK0 IS STILL NOT RECEIVED THEN "DLE EOT" WILL BE * SENT AND THE LINE DROPPED. SUCCESSFUL EXECUTION * ENABLES THE "TTD" MODULE. CONTROL IS THEN RETURNED * TO THE USER. * THIS MODULE IS USED BY "HANDSHAKE" AND "RECEIVE TO * SEND" * * * SENQ LDA M127 SET THE BID CNT TO 127 TRIES STA ERROR SET ERROR RETRY COUNTER LDA EQTM SET CURRENT RECEIVE TIMEOUT STA CRTM JSB UPCAR BRING UP CARRIER * DD3 LDA ENQ "ENQ" JSB BLDBF SETUP BUFFER WITH ENQ DEC 3 STB SCASE SET SPECIAL CASE FLAG JSB CNTRL SEND "ENQ" THROUGH CONTROL ROUTN * * TEST IF REMOTE SENT BACK "ACK0" OR "RVI" * CPA ENQ RECEIVED ENQ? JMP GOTEQ YES - DEFER TO REMOTE CPA ACK0 RECEIVED "ACK0" ? JMP SHDSK YES, ACTIVATE "TTD" MODULE. CPA RVI RECEIVED "RVI" ? JMP SHDSK YES, ACTIVATE "TTD" MODULE. LDA N13 ALLOW 130 MSECS BEFORE UPCAR JSB TADRS * JSB UPCAR BRING UP CARRIER ISZ ERROR IS THIS THE LAST TRY ? JMP DD3 NO, TRY AGAIN. * * REMOTE REFUSES TO SEND "ACK0" OR "RVI". DISCONNECT * * * *** SEND "DLE EOT" TO REMOTE AND DROP LINE *** * ENDAL CLA,INA STA INERR SET "OPERATION IN ERROR" EDALL LDA EOT BUFFER STA RSEND+2 LDA DLE JSB BLDBF "PAD DLE EOT" IN SEND BUFFER DEC 4 JSB CNTRL SEND "DLE EOT".RETURN AT "CCSS". * * * "DLE EOT" WAS SENT. TAKE TERMINAL OFF-LINE. CLOSE CLA,INA STA INERR SET "OPERATION IN ERROR" CCSS CLA STA LINE SET TRML "OFF-LINE" LDA MSK14 OTA1S OTA 0 TURN-OFF SEND BOARD & OTA1R OTA 0  RECEIVE BOARD JSB WACTZ CLEAN WACK/TTD & SPEC CASE FLAG JMP COMPT DO COMPLETION * * * UPDATE STATUS. "ACK0" OR "RVI" RECEIVED. * SHDSK CLB ZERO STB EOF LAST RECORD NOT AN END-OF-FILE. CPA RVI REMOTE REQUEST TO SEND ? LDB BIT4 YES. SET "REQ TO SEND". STB RQ2SD UPDATE REQUEST TO SEND. CCA SET NEXT REPLY STA BCONT FOR ACK1 STA RCSND PUT IN SEND MODE. LDA RCTM RESET RECEIVE TIMEOUT TO 3 SEC STA CRTM * * ENABLE "TEMPORARY TEXT DELAY" MODULE. * CLA,INA ACTIVATE STA WACT "TTD" MODULE STA SCASE CTSXT STA LINE SET "ON-LINE" JMP COMPT RETURN TO USER * M127 DEC -127 SEC3 DEC -150 HALF OF 3 SECS SEC3C NOP CLR-TO-SEND TIMEOUT FOR MODEM SEC10 DEC -10 10 SEC COUNTER EQTM DEC -100 REC TIMEOUT FOR CONTENTION CRTM NOP CURRENT REC TIMEOUT BEING USED * * * * *** LINE STATUS CHECK *** * * THIS ROUTINE CHECKS THAT THE DATA SET IS ON. IF * IT IS OFF THEN THE I/O BOARDS ARE TURNED OFF AND * THE OPERATION IS TERMINATED WITH AN "IN ERROR" * CONDITION . * LCHCK NOP JSB SYN3S GET SEND BOARD STATUS SSA DATA SET READY ? JMP LCHCK,I YES. RETURN TO CALLER. DSOF LDB BIT12 NO, RECORD FAILURE AND EXIT. JSB SET (NO RETURN FROM SUBROUTINE) * * SKP * * * *** BRING UP CARRIER *** * THIS ROUTINE DISABLES INTERRUPTS ON RECEIVE * BOARD AND WAITS FOR A CERTAIN AMOUNT OF * TIME BEFORE PROCEEDING FURTHER. THIS ALLOWS THE * REMOTE TO QUIET DOWN. THE BOARDS ARE THEN SET UP * TO SEND AND 3 SECS ARE ALLOWED FOR CLEAR TO SEND * TO COME UP. THREE SYNCS ARE OUTPUT BEFORE * RETURNING TO THE CALLING PROCESSOR. * * UPCAR NOP CCA JSB TADRS SET QUICK TIMEOUT & EXIT * LDA SEC3 JSB SYN5 SET UP SEND BOARD TO SEND * * CHECK"CLEAR TO SEND" * $ UPCA1 JSB SYN3S SLA,RSS CLEAR-TO-SEND ? JMP UC10 NO. WAIT. CLB,INB YES. SYNCHRONIZE. JSB SYNRZ JMP UPCAR,I RETURN TO CALLER. * * UC10 ISZ SEC3C 3 SEC UP ? JMP UC1 NO, POLL AGAIN. MODFL LDB BIT5 RECORD MODEM FAILURE AND EXIT JSB SET (NO RETURN FROM SUBROUTINE) * UC1 JSB LCHCK CLOSE OPERATION IF DATA SET OFF LDA M2 JSB TADRS SET 20 MSEC TO CHK CLR-TO-SEND JMP UPCA1 SKP * * *** CONTROL SUBROUTINE *** * USE: PERFORMS LINE TURNAROUND (FROM SEND TO RECV). * EXECUTION: * * 1.TRANSMITS A STRING OF CHARACTERS. * * 2.DROPS CARRIER. * * 3.WAITS FOR CARRIER FROM REMOTE. * THERE ARE THREE CASES POSSIBLE : * A. IN "HANDSHAKE" OR "REC-TO-SEND", NO RESPONSE * FOR 1 SEC AFTER SENDING ENQ (OR 3 SEC IF * WACK WAS RECEIVED), THEN RESEND ORIGNAL * BUFFER UP TO 8 TIMES BEFORE DROPPING LINE. * B. IN SEND MODE DURING "WRITE" , RECEIVE MODE * DURING "WRITE CONV" OR IN SEND MODE DURING * TTD GENERATION AND NO RESPONSE FOR 3 SEC, THEN * SEND ENQ BUFFER TO SOLICIT RESPONSE. TRY UP * TO 8 TIMES BEFORE DROPPIN THE LINE. * C. IN RECEIVE MODE DURING READ OR IN WACK * GENERATOR AND NO RESPONCE FOR 30 SECS (LONG * TIMEOUT) THEN SEND "DLE EOT" AND DROP LINE. * * 4. GET A CONTROL CHARACTER SEQUENCE FROM REMOTE : * A. IF CHARACTER = "WABT" THEN RETURN TO STEP 1 * WITH CHARACTER STRING = "ENQ". * B. IF CHAR="ENQ" AND IN REC-TO-SEND OR WACK * PROCESSOR THEN RETURN TO THE PROCESSOR. IF IN * ANOTHER PROCESSOR THEN THERE WAS A XMISSION * ERROR; THE ERROR RECOVERY PROCEDURE OF STEP 3 * IS APPLIED. * C. IF "DLE EOT" IS RECEIVED OR SENT, THE LINE * WILL BE DROPPED AND DRIVER IS RELEASED. * D. ANY OTHER CONTROL CHARACTER SEQUENCE WILL * CAUSE A RETURN TO THE CALLING PROCESSOR. * * CALLING SEQUENCE: * REG-A = STARTING ADDRESS OF STRING TO BE SENT. * REG-B = POSITIVE STRING LENGTH (UNPACKED). * JSB CNTRL * NOTE: I/O BOARD MUST HAVE CARRIER ON. PLACE CHAC * SEQUENCE TO BE RESENT (FOR ERROR RECOVERY) * IN "RESEND". PLACE LENGTH OF SEQUENCE IN * "RESLN" (MAXIMUM LENGTH IS 5 CHACS). IF IN * "RECEIVE-TO-SEND", "AUTOANSWER" OR "WAIT- * BEFORE-TRANSMIT" PROCESSOR THEN SET "SCASE" * = 1, OTHERWISE SET IT 0 . * * UPON RETURN: * * REG-A : RECEIVED CONTROL CHARACTER * * REG-B : IF 1 THEN "DLE" PRECEEDED RECEIVED * CONTROL CHARACTER . * * * *** INITIALIZATION SECTION *** * CNTRL NOP STA ADRS2 SAVE STRING STARTING ADDRESS CMB,INB STB CONT3 SAVE NEGATIVE STRING LENGTH CNTR7 STA ADRS1 POINTER STB CONT1 COUNTER JSB TIME? SET UP PROPER RECEIVE TIMEOUT * CNTR8 LDB ADRS1,I GET FIRST CHARACTER OF STRING JSB SYN2S ENABLE FLAG TO STC XX,C * * *** SEGMENT ONE: OUTPUT CHARACTER STRING *** * ISZ ADRS1 ISZ CONT1 FINISHED SENDING STRING ? JMP CNTR8 OUTPUT NEXT CHARACTER * LDB M4 ADB ADRS1 DLD 1,I CPB EOT AN "EOT" CHARACTER BEFORE PAD? RSS YES JMP *+3 NO CPA DLE WAS IT A DLE BEFORE THE EOT? JMP SLOW YES: TAKE TERMINAL OFF LINE! * * CHARACTER STRING HAS BEEN SENT. SET UP TO RECEIVE. * SETUP CLB INITIALIZE STB LOGC1 "DLE" NOT RECEIVED JSB SYNRZ GO OBTAIN SYNC.=0: RECEIVE MODE. SZA,RSS SYNC OBTAINED ? JMP SYXT YES * * SEGMENT THREE * THIS SEGMENT IS ENTERED WHEN A REPLY WAS EXPECTED * WITHIN 3 OR 1 SEC BUT SYNC INPUT ROUTINE FAILED * TO RECEIVE SYNC OR CNTRL ROUTINE DID NOT GET A * VALID BISYNC CHARACTER. THIS ROUTINE CAUSES THE * RESEND BUFFER TO BE TRANSMITTED UP TO 7 TIMES. * LDA REO8 GET FUNC CODE FOR 'SEND EOT' CPA FUNC CURRENTLY PROCESSING 'zSEND EOT'? JMP EOTER YES, RETURN TO PROCESSOR. JSB UPCAR BRING UP CARRIER ISZ ERROR IS THIS THE 8TH. TIME ? JMP RRRR NO. TRY AGAIN. LDB BIT8 JSB SET RECORD REPEATED REC TIMEOUT JMP ENDAL * * RRRR LDA RESH GET ADDRESS OF RE-SEND BUF IN'A' STA SENQF SET FLAG THAT ENQ HAS BEEN SENT LDB RESLN AND LEN OF RESEND BUF IN'B'. CMB,INB MAKE LENGTH NEGATIVE. JMP CNTR7 * SKP * * *** SEGMENT FOUR: THIS SEGMENT ANALYZES * CHARACTERS RECEIVED FROM REMOTE. *** * CNTR4 JSB READ? DOING READ TYPE REQUEST? CLA,INA NO, SET "LAST CHAR WAS DLE" SYXR STA LOGC1 SYXT JSB DOLIA GET CHARACTER CPA SYN DISREGARD SYN JMP SYXTT AND RESET TIMEOUT CPA ENQ CHARACTER="ENQ" ? JMP AENQ YES. GO ANALYZE. CPA DLE CHARACTER="DLE" ? JMP CNTR4 YES, SKIP ANALYSIS * LDB LOGC1 LAST CHARACTER SLB,RSS A "DLE" ? JMP ANALZ NO, CONTINUE CHECKING. * CPA ACK0 YES. IS PRESENT CHAR AN "ACK0" ? JMP FOUND YES, RETURN TO CALLING PROCESSOR CPA ACK1 IS IT ACK 1 ? JMP FOUND YES, RETURN TO CALLER. * CPA EOT PRESENT CHARACTER AN "EOT" ? JMP CLOS YES. DROP THE LINE CPA WABT PRESENT CHARACTER A "WACK" ? RSS YES. FORGET ANLYZING. JMP ANALZ NO. CONTINUE CHECKING. * LDA RCTM RESTORE TIMEOUT TO NORMAL 3 SEC STA CRTM RECEIVE TIMEOUT * JSB ERCNT UP CARRIER & SET ERROR COUNT LDA SYN STORE "PAD" CHARACTER STA PAD1 IN REPLY BUFFER LDA ENQ RECEIVED CHARACTER WAS "WABT". STA REPLY SEND LDA PADD "SYN ENQ PAD PAD" STA REPLY+1 TO REMOTE STA REPLY+2 LDA REPAD AND LDB P4 AWAIT JMP CNTRL+1 REPLY. * ANALZ JSB READ? V PROCESSING READ TYPE REQ ? LDB CCADD SEARCH IF CHAR IS ANY OF EOT, STB TEMP ETB,ETX,NAK,RVI,SOH OR STX LDB M7 CONTROL CHARACTERS. LOOP1 CPA TEMP,I JMP FOUND IF FOUND GO TO "FOUND" ISZ TEMP OTHERWISE INB,SZB DROP OUT OF LOOP. JMP LOOP1 * STB LOGC1 SET 'LAST CHAR A DLE' TO FALSE JSB SYN2R RECEIVED CHAR NOT A CONTROL CHAR JMP EXITR AND EXIT * * AENQ LDB SCASE CHAR="ENQ". IS DRIVER IN "WABT", SZB OR "RC2SD" MODE ? JMP FOUND YES. GIVE CONTROL TO PROCESSOR. JSB UPCAR BRING UP CARRIER. LDB CONT3 LDA ADRS2 ISZ ERROR TRANSMISSION ERROR 8TH TIME ? JMP CNTR7 NO, PREPARE TO RESEND STRING. JMP ILSQ RECORD REPEATED ILLEGAL SEQUENCE * SYXTT LDA TTTT JSB TACTV RESET TIMEOUT DEF .TOUT CLA JMP SYXR * * TEST IF CURRENTLY SERVICING READ OR WRITE * TYPE REQUEST. IF SO THEN DO (P+1) RETURN * OTHERWISE EXIT : =CHAR., =DLE FLAG. * READ? NOP STA TEMP SAVE RECVD CHAR TEMPORARILY LDA FUNC AND M77 GET CURRENT REQUEST CODE STA B (B) = CURRENT REQ CODE LDA TEMP (A) = RECEIVED CHARACTER CPB P1 IF DOING READ TYPE REQUEST FOUND CLB,RSS JMP READ?,I RETURN STB EQT15,I DEACTIVATE TIMER LDB LOGC1 GET "DLE" FLAG IN B REG JMP CNTRL,I RETURN TO PROCESSOR SKP * * "DLE EOT" RECEIVED PROCESSOR * CLOS LDB BIT11 JSB SET RECORD DLE EOT RECEIVED LDB BBMB SET ENTRY AT 'CLOSE' JMP CLOW ALSO CHECK CARRIER FAIL FLAG BBMB DEF CLOSE * * "DLE EOT" SENT PROCESSOR * SLOW LDB BIT10 JSB SET RECORD DLE EOT SENT LDB DCLOS SET ENTRY AT 'CCSS' CLOW LDA N13 SET 130 MSEC DELAYED ENTRY STB *+2 JSB TACTV NOP LDA CARCT LDB BIT13  SZA CARRIER FAIL FLAG SET ? JSB SET YES, RECORD THIS FACT. JMP EXITR DCLOS DEF CCSS * * * * * * * *** DATA *** * ADRS1 BSS 1 STRING ADDRESS OF CONTROL SEQENC ADRS2 BSS 1 ORIGNAL BUFFER START ADDRESS. CONT1 BSS 1 STRING LENGTH OF CONTROL SEQUENC CONT3 BSS 1 ORIGNAL BUFFER LENGTH ERROR BSS 1 ERROR COUNTER FOR RETRY. LOGC1 BSS 1 LOGICAL VARIABLE FOR "DLE" REPAD DEF PAD1 ADDRESS OF RE-TRY MESSAGE. PAD1 BSS 1 RE-TRY REPLY BSS 3 BUFFER RESH DEF RSEND ADDRESS OF RESEND BUFFER RESLN BSS 1 LENGTH OF RESEND BUFFER. RSEND BSS 5 RESEND CHARACTER SEQUENCE. SCASE NOP =1 IF IN WABT, AUTOANSWER,RC2SD. TEMP BSS 1 TEMPORARY STORAGE. S2RTM NOP SKP * * *** I/O BOARD SYNCHRONIZE *** * * ON ENTRY REG-B # 0 FOR TRANSMIT AND = 0 FOR RCV. * 'DATA-SET READY' MUST BE ON BEFORE ENTRY HERE. * TRANSMIT: BEFORE ENTRY INTO THIS ROUTINE, THE * "CLEAR-TO-SEND" MUST BE ON. THIS ROUTINE * TRANSMITS 3 SYNC CHARACTERS AND THE * REMOTE IS EXPECTED TO BE IN SYNCHRONIZA- * -TION THEREAFTER. * * RECEIVE: THIS ROUTINE OUTPUTS SYNC COMMAND WORD * TO THE INPUT SYNC RECOGNIZING CIRCUIT * AND SETS UP THE RECEIVE BOARD TO HUNT FOR * SYNC CHARACTER. ONE "RECEIVE TIMEOUT" * IS ALLOWED TO ACQUIRE SYNC AFTER WHICH * SYNC FAILURE IS REPORTED TO THE CALLING * PROGRAM (REG-A = 0). ONLY ONE * SYNC IS LOOKED FOR IN ORDER TO ALLOW * SUCCESSFUL OPERATION OF SYNC HUNT. * REC TIMEOUT IS EITHER 1, 3 OR 30 SEC. * SYNRZ NOP JSB LCHCK DROP LINE IF DATA-SET OFF. SZB,RSS SEND OR RECEIVE SYNC CHARACTERS? JMP IN RECEIVING. GO TO 'IN'. * * TRANSMIT SYNC CHARACTERS. * LDA SYNC GET THE SYNC CHARACTER. OTA7S OTA 0 SEND IT TO THE XMIT BOARD. LDA M3  SET UP LOOP FOR STA WORK THREE SYNC CHARACTERS. * OTPUT LDB SYN OUTPUT SYNC JSB SYN2S STC,C ON SEND BOARD. * * SEGMENT ONE: SEND INTERRUPTS CHANNELED HERE. * ISZ WORK ALL SYNCS SENT YET ? JMP OTPUT NO, SEND ANOTHER. JMP OBTND YES, RETURN. * * * RECEIVE SYNC CHARACTERS. IN LDA TTTT OBTAIN PROPER "RECEIVE TIMEOUT" JSB TACTV ENTER AT "TOUT" IF TIMEOUT BEFORE SYNC DEF .TOUT NOSYN LDA SYNC GET SYNC REFERENCE COMMAND STA SYNFL SET SYNC-HUNT FLAG FOR DVR50. JSB SYN6 SET XMIT BOARD TO TURN AROUND JSB SYN2R STC ,C ON RECEIVE BOARD JSB EXIT * SKP * * SEGMENT TWO: RECEIVE INTERRUPTS CHANNELED HERE * JSB SYN3R GET STATUS OF RECEIVE BOARD RAL POSITION BIT14 SSA SYNC ACQUIRED YET ? JMP NOSYN NO, SET UP HUNT AGAIN. RAR POSITION AND AND MASK MASK IN RECEIVED CHARACTER. CPA SYN IS INTERRUPT FROM SYNC ? CLA,RSS YES, THEN SYNC OBTAINED. JMP NOSYN FALSE INTERRUPT, TRY HUNT AGAIN. * * RECEIVE SYNC ACQUIRED * STA SYNFL CLEAR SYNC-HUNT FLAG. LDA SREVC OUTPUT RECV CONTROL WORD AFTER AND MFHNT MASKING OFF 'HUNT' BIT. IOR BIT8 ENABLE INT FROM LINE STATUS INDI OTA7R OTA 0 OUTPUT ON RECEIVE BOARD. LDA TTTT JSB TACTV RESET TIMEOUT DEF .TOUT OBTND CLA SET REG-A=0 FOR SYNC OBTAINED JMP SYNRZ,I RETURN. * * * THE CLOCK INTERRUPTS HERE IF RCV BOARD DOES NOT * GET TWO SYNCS WITHIN THE RECV TIMEOUT. * .TOUT LDA FUNC LDB LGTM CPB TTTT WAS IT A LONG TIMEOUT? CPA REO8 YES, THEN WAS IT CALLED BY "SEND EOT"? JMP SYNNO RETURN WITH SYNC FAILURE CPA REO9 CALLED BY 'AUTO-ANSWER' ? JMP BRKCK YES, CHECK FOR OPERATOR ABORT. CPA REO10 CALLED BY 'SD2RC' ? JMP SYNNO YES, THEN RETURN. LDB BIT9 RECORD LONG TIMEOUT JMP EDBD * BRKCK LDA PSWD GET RJE'S ID ADDRESS ADA P20 POINT TO ID WORD #21 LDB A,I GET THE CONTENTS BLF,SLB IF THE BREAK FLAG IS SET, JMP BRKEX TAKE CONTROL MODE EXIT SYNNO CCA JMP SYNRZ,I ELSE RETURN: #0. * TTTT NOP P20 DEC 20 SKP * * *** RECEIVE TIMEOUT ALLOCATION ROUTINE *** * * THIS ROUTINE IS USED BY THE I/O SYNCHRONIZATION * SYN HUNT ROUTINE TO GET THE PROPER RECEIVE TIMEOUT * FOR THE CURRENT RECEIVE OPERATION. ON RETURN REG-A * HAS THE APPROPRIATE TIMEOUT. DEPENDING UPON THE * STATE OF THE LOCAL TERMINAL, THE TIMEOUT ALLOCATED * FOR RECEIVING SYNCHRONIZATION CAN BE EITHER A * 'LONG RECEIVE TIMEOUT'(30 SEC), A 'NORMAL RECEIVE * TIMEOUT'(3 SEC) OR 'SHORT RECEIVE TIMEOUT'(1 SEC). * * 1. 'SHORT RECEIVE TIMEOUT' (1 SEC) IS USED WHEN : * (A). THE LOCAL TERMINAL IS BIDDING FOR THE LINE. * 2. 'NORMAL RECEIVE TIMEOUT' (3 SEC) IS USED WHEN : * (A). LOCAL TERMINAL IS IN TRANSMIT MODE. * 3. 'LONG RECEIVE TIMEOUT' (30 SEC) IS USED WHEN : * (A). LOCAL TERMINAL IS IN RECEIVE MODE. * (B). LINE IS IN CONTROL MODE FOLLOWING * TRANSMISSION OF AN 'EOT' . * (C). WAITING FOR REMOTE TO BID FOR THE LINE. * * TIME? NOP LDA S2RTM LDB FUNC CPB REO10 SEND-TO-RECEIVE JMP TTXX YES, USE LONG T.O OR 20 SECS LDA LGTM SET TO LONG TIMEOUT CPB REO9 AUTO-ANSWER JMP TTXX YES CPB REO6 HANDSHAKE ? JMP STIME YES CPB REO7 REC-TO-SEND ? JMP STIME YES CPB REO8 SEND EOT ? JMP TTXX YES CPB REO5 WRITE CONV ? JMP RTIME YES LDB RCSND SZB TRANSMIT MODE ? RTIME LDA RCTM SET 3 SEC RECEIVE TIMEOUT TTXX STA TTTT SAVE CURRENT RECEIVE TIMEOUT JMP TIME?,I RETURN WITH TIME * STIME LDA CRTM SET SHORT RECEIVE TIMEOUT JMP TTXX * * * SKP * *** 'TTD' / 'WACK' GENERATOR *** * * USE: WHILE IN TRANSMIT MODE THIS SUROUTINE WILL * HOLD OFF THE RECEIVING STATION. IT IS DURING * THE EXECUTION OF TTD OR WACK MODULE THAT * USER REQUESTS ARE ALLOWED TO PENETRATE THE * DRIVER. * EXECUTION: * 1. WAIT FOR 'TRANSMIT TIME-OUT'. * 2. SET DEVICE BUSY, SEND "STX ENQ"/"DLE WACK" . * 3. TEMINAL SENDS BACK "NAK"/"ENQ". * 4. WAIT FOR 10 MSEC BEFORE EXECUTING STEP 5. THIS * ENSURES THAT 'RTE' WAS NOT EXECUTING WHEN $IOUP * IS ENTERED. * 5. ALLOW ANY STACKED REQUESTS TO BE SERVICED BY * ENTERING RTIOC AT $IOUP WITH REG-A = EQT#. * 6. GO TO STEP 2 . * WACTZ NOP CLA STA WACT CLR 'GENERATOR ON' FLAG STA SCASE CLR 'SPECIAL CASE FLAG' ON. JMP WACTZ,I RETURN TO CALLER * WABT1 LDA EQT5,I SET IOR DEVBS DEVICE STA EQT5,I BUSY (SO ANY EXEC REQUEST WILL QUEUE) IMXMT JSB ERCNT UP CARRIER & SET ERROR COUNT LDA WACT SSA DOES FLAG INDICATE "WACK" GEN ? JMP WBUF YES. FORMULATE "WACK" BUFFER. LDA NAK STA CRPY SET REPLY CHAR= NAK LDA SYN BUILD THE "TTD" TRANSMISSION SEQUENCE: STA TSEND CONTAINING "SYN STX ENQ PAD PAD" LDA PADD STA TSEND+3 STA TSEND+4 LDA ENQ STA TSEND+2 JSB BLDBF FORM RESEND BUFFER WITH DEC 3 "SYN ENQ PAD PAD" LDA STX STA TSEND+1 LDA TSBF LDB P5 WBRET JSB CNTRL GO OUTPUT BUFFER CPA CRPY IS REPLY AS EXPECTED ? RSS YES. SKIP NEXT INSTRUCTION. JMP IMXMT NO. TRY AGAIN IMMEDIATLY. LDB BIT14 ISZ #N# ALL TTD'S/WACK'S SENT ? CCA,RSS NO JMP EDBD YES JSB TADRS * LDA XMTM SET UP TO RESEND TTD/WACK IF NO JSB TACTV DEF WABT1 IOUPX LDB ~pM2 ADB #C.50 DVR50 WILL EXIT TO $IOUP LDA EQT5,I SET ELA,CLE,ERA DEVICE STA EQT5,I UNBUSY (QUEUED EXEC REQUEST WILL HAPPEN) LDA EQT# JMP 1,I * * FORMULATE "WACK" BUFFER: * WBUF LDA ENQ STA CRPY SET REPLY CHAR = ENQ LDA WABT STA RSEND+2 IN SEND BUFFER LDA DLE JSB BLDBF SETUP "WACK" BUFFER CONTAINING: DEC 4 "SYN DLE ,(OR ) PAD PAD" JMP WBRET RETURN * #N# BSS 1 WACT BSS 1 "WACK"/"TTD" GENERATOR ON FLAG. CRPY BSS 1 REPLY CHAR EXPECTED TSBF DEF TSEND TSEND BSS 5 TEOF NOP EOT RECEIVED TEMP FLAG DEVBS OCT 100000 BIT 15 IS EQT WORD 5 BUSY BIT SKP * * * * *** COMPLETION SECTION *** * * THIS SECTION IS CALLED BY A PROCESSOR WHEN AN * OPERATION HAS BEEN COMPLETED. THIS SECTION IS * CALLED BOTH WHEN A USER REQUEST COMPLETES AND * ALSO IN BETWEEN REQUESTS IF THERE IS A PREMATURE * TERMINATION RESULTING FROM AN ERROR CONDITION. * * * EXECUTION: * * 1. UPDATE STATUS. * 2. GO TO AN EXIT PROCESSOR TO DETERMINE THE * MODE OF EXIT TO BE PERFORMED AND EXIT FROM * THE DRIVER ACCORDINGLY. * * * * * COMPT LDA EQT5,I INITIALIZE STATUS BYTE TO ZERO. AND MFST IOR INERR OP-IN-ERROR STATUS LDB OVRFL SZB BUFFER OVERFLOW ? IOR BIT5 YES. SET BIT 5 OF STATUS. IOR RQ2SD SET "REQ TO SEND" STATUS LDB LINE SZB,RSS IS TERMINAL ON LINE ? JMP COMPV NO IOR BIT1 YES. SET BIT 1 OF STATUS. LDB EOF SZB SET TERMINAL IN CONTROL MODE ? JMP COMPV YES , THEN FORGET XMIT/REC FLAG IOR BIT2 SET BIT 2 IF IN XMIT MODE CPB RCSND IS TRML IN REC MODE ? ADA BIT2 YES. SET BIT 3 OF STATUS. * COMPV STA EQT5,I STORE UPDATED STATUS IN EQT5. TSW4 NOP TRACE SWITCH JMP *+5 u AND M177 SAVE EQT5 STATUS IOR BIT11 INSERT STATUS INDICATOR LDB EQT12,I REPORT EXTENDED STATUS TOO JSB TRACE LDA EOF PICK UP EOT RECEIVED FLAG STA TEOF AND SAVE IT TEMPORARILY LDA TLOG STA EQT6,I STORE XMISSION LOG TEMPORARILY. JSB SCLR CLEAR.DRIVER STATUS FLAGS CCA JSB TADRS WAIT 10 MSEC FOR PROPER COMPLETION * LDA FUNC GET FUNCTION CODE SZA,RSS IS DRIVER IN-BETWEEN REQUESTS ? JMP IOUPX YES CLB CPA REO1 NO: PROCESSING 'ACK-READ'? JMP COMPX YES - RETAIN EOT INDICATOR CPA REO6 HANDSHAKE NEEDS 5 MIN TIMEOUT TOO! JMP COMPX CPA REO8 SEND EOT NEEDS 5 MIN T.O. TOO. JMP COMPX CPA REO10 PROCESSING 'SEND-TO-RECEIVE'? JMP *+2 YES, RETAIN EOF INDICATION. STB TEOF IF NEITHER, CLR THE EOF INDICATOR COMPX AND P3 MASK FUNC TO GET REQ CODE SZA CPA P3 STB EQT6,I NOT READ OR WRITE REQUEST. STB FUNC CLEAN UP FUNCTION INDICATOR CCA ADA #C.50 DECREMENT RETURN ADDRESS TO STA #C.50 MAKE A (P+2) EXIT. CPB WACT JMP MAXTM DON'T SWITCH ON TTD WACK GEN LDA #NUMB SET NUMBER OF TTD'S/WACK'S (NEG) STA #N# TO BE SENT LDA XMTM ENTER AT SEGMENT TWO JSB TACTV DEF WABT1 * MXRET LDA EQ14 CHANGE BASE PAGE POINTER TO STA EQ15 PREVENT RESETTING OF CLOCK. CLA REG-A =0 LDB EQT6,I REG-B =0 OR TLOG JMP #C.50,I RETURN TO USER * MAXTM CPB LINE TERMINAL ON LINE? JMP MXRET NO LDA CMDTM FETCH CONTROL MODE T.O. LDB TEOF GET THE EOF INDICATOR SZB,RSS IS THIS A (QUALIFIED) EOT CONDITION? CCA NO, WAIT FOR ONLY 20 SECS STA CNTTM PAUSE LDA M2000 PAUSE FOR 20 SECS JSB TACTV DEF `NLHCNTOF JMP MXRET * BIT15 OCT 100000 * CNTOF LDA CNTTM SSA WAITING INDEFINITELY? ISZ CNTTM NO, DONE WAITING? JMP PAUSE NO, WAIT SOMEMORE LDB BIT15 YES, JSB SET RECORD CONTROL TIME-OUT LDA EQT5,I IOR DEVDN STA EQT5,I SET DEVICE DOWN JMP TOFF GO TO DISCONNECT PROCESSOR * * ׷N SKP * * *** AUTO-ANSWER & REC-TO-SEND PROCESSOR *** * * EXECUTION: * 1. REJECT REQUEST IF PASSWORD IS ILLEGAL OR * TERMINAL IS ALREADY ON-LINE. * 2. SET UP I/O BOARDS TO RECEIVE. GIVE 130 MSEC * FOR BOARDS TO CALM DOWN AND EXIT WITH REQUEST * INITIATED. * 3. ENTER AFTER 130 MSEC AND CHECK IF 'RECD LINE * SIGNAL DETECT ' (CARRIER DETECT) IS ON.IF NOT * THEN SET UP 130 MSEC LOOP FOR STEP 3. IF IS * ON THEN REMOTE IS CALLING AND GO TO STEP 4. * 4. GET INTO SYNCHRONIZATION WITH REMOTE. * 5. GET "ENQ" FROM REMOTE. * 6. ACTIVATE "WACK" PROCESSOR AND RETURN TO USER. * * * * * LSN20 LDB REO10 RESET FUNCTION TO SEND-TO-RECV STB FUNC LDA M2000 PICK UP 20 SECOND COUNT RSS SD2RC LDA LGTM PICK UP LONG TIMEOUT COUNT STA S2RTM SETUP FOR TIME? JSB CNTMD CHECK CONTROL-MODE CONDITION RSS * * ANSWR JSB OFLN CHECK OFF-LINE CONDITION LDA EQT7,I JSB PSW CHECK PASSWORD JSB EXST CLEAN EXTENDED STATUS JSB WACTZ DEACTIVATE GENERATORS JSB TACTZ JSB TIME? SET LONG TIMEOUT FOR SYNCHRONIZATION. * ANSR1 LDA FUNC CPA REO10 CONTROL-TO-RECEIVE JMP ANSR.+1 YES, GO TO SYNC HUNT NOW. JSB SYN6 PRIME I/O BOARDS TO BE RCVR JSB SYN3R GET STATUS OF RECEIVE BOARD RAL,RAL SSA DATA SET READY ? JMP ANSR.+1 YES LDA EQTM NO, THEN WAIT ANOTHER SEC JSB TADRS JMP ANSR1 * * SET UP 'SYNC HUNT' LOOP WITHOUT ANY TIMEOUT * EVEN THOUGH CARRIER NOT DETECTED * * ANSR. JSB ANSR5 CHECK FOR REPETION CLB INDICATE 'RECEIVE' AND JSB SYNRZ GO INTO SYNCHRONIZATION. SZA SYNC ACQUIRED ? JMP ANSR. NO. TRY AGAIN. * * RECEIVE BOARD IN SYNC. SET UP TO GET "ENQ". * GETCR JSB DOLIA GET NEXT CHAR. FROM RECV BOARD. CPA ENQ IF IT IS AN 'ENQ', THEN THE  JMP GOTEQ REMOTE IS BIDDING FOR THE LINE. CPA SYN IF IT IS 'SYN', IGNORE: IT MAY BE A JMP GETCR LENGTHY SYNCHRONIZATION SEQUENCE LDA LGTM ELSE, IT'S AN INCORRECT BID, JSB TACTV OR A LOSS OF SYNC, SO ALLOW A DEF ANSR4 LONG TIMEOUT TO AWAIT NEXT BID. JMP ANSR.+1 BEGIN THE WAIT BY RE-ACQUIRING SYNC. * GOTEQ CLA,INA A VALID BID HAS BEEN DETECTED. STA LINE SET TERMINAL ON-LINE CLA STA EOF LAST RECORD NOT AN END-OF-FILE STA RQ2SD REMOTE NOT REQUESTING TO SEND SEOF2 CLA STA RCSND SET "RECEIVE" MODE STA BCONT SET REPLY FOR ACKO. * WACTN CCA STA WACT SET "WACK GEN" FLAG STA SCASE "SPECIAL CASE" FLAG JMP COMPT EXECUTE COMPLETION. * * ANSR4 LDB BIT9 JSB SET RECORD LONG TIMEOUT JSB ANSR5 DECIDE COMPLETION TYPE JMP CLOSE DO ERROR EXIT * * ANSR5 NOP LDA FUNC CPA REO9 AUTO-ANSWER ? JMP ANSR5,I YES, THEN RETURN, BRKEX ISZ EOF INDICATE CONTROL MODE JMP COMPT EXECUTE SD2RC COMPLETION * SKP * * * * * *** DISCONNECT PROCESSOR *** * * * A "DISCONNECT" REQUEST IS VALID ONLY WHEN THE * TERMINAL IS ON-LINE. SINCE THE CLOCK IS ALWAYS * RUNNING WHEN TERMINAL IS ON-LINE , THIS REQUEST * WILL NOT COME THROUGH THE DRIVER FRONT-END IF NOT * ISSUED IN PROPER SEQUENCE. * * EXECUTION: * 1. VALIDATE PASSWORD. * 2. SEND "DLE EOT" TO REMOTE. * 3. TURN OFF I/O BOARDS. * 4. UPDATE STATUS. * 5. RETURN TO USER AFTER DATA-SET IS OFF. * * OFF LDA EQT7,I JSB PSW CHECK PASSWORD JSB ONLN CHECK ON-LINE CONDITION JSB EXST CLEAN EXTENDED STATUS JSB TACTZ AND RETURN WITH * TOFF JSB WACTZ CLEAN WACK/TTD & SPEC CASE FLAG STA PSWD CLEAN UP THE PASSWORD STA INERR CLEAN"IN ERROR" FLAG STA EOF "EOF" FLAG STA TLOG "TLOG" STA OVRFL "OVERFLOW" FLAG STA RQ2SD "RVI" FLAG JSB UPCAR JMP EDALL SEND "DLE EOT" AND DROP LINE. SKP * * * * *** SEND END-OF- TRANSMISSION *** * * THIS MODULE SENDS A LOGICAL END-OF-TRANSMISSION * (SYNC,EOT,PADD) TO THE REMOTE. IT THEN WAITS FOR * A REPLY FROM THE REMOTE. THE NEXT STEP IS DEPENDENT * ON THE REMOTE'S RESPONSE. * * REMOTE RESPONSE ACTION TAKEN * ------ -------- ------ ----- * 1. CHANGE STATE TO RECEIVE. * "ENQ" 2. ENABLE "WACK" MODULE. * 3. XLOG=1, BCONT=0. * * ANY OTHER 1. RETURN TO USER IN CONTROL * CHARACTER OR MODE. * NO RESPONSE. * * * ERROR REJECTS: * 1. ILLEGAL PASSWORD. * 2. TERMINAL OFF-LINE. * 3. LOCAL TERMINAL IN RECEIVE MODE. * * * SEOF LDA EQT7,I GET PASSWORD JSB PSW CHECK PASSWORD JSB ONLN CHECK ON-LINE CONDITION JSB EXST CLEAN EXTENDED STATUS STA WACT DEACTIVATE TTD/WACK GENERATORS * CLA,INA SET TRANSMISSION LOG STA TLOG TO 1 CHARACTER SENT. JSB TACTZ * CCA SET LOGIC IN "CNTRL" SUBROUTINE STA SCASE TO RETURN IF "ENQ" IS RECEIVED. JSB ERCNT SET UP RETRY COUNTER LDA EOT BUILD BUFFER WITH EOT JSB BLDBF DEC 3 JSB CNTRL SEND CONTROL BUF TO REMOTE * * CHECK FOR RECEIVED CHARACTER * CPA ENQ RECEIVED "ENQ" ? JMP SEOF2 YES, SETUP RECEIVE MODE. EOTER JSB WACTZ STA BCONT RESET ACK0 ISZ EOF INDICATE CONTROL MODE JMP COMPT DO COMPLETION * * * * * *** RECEIVE-TO-SEND PROCESSOR *** * * THIS PROCESSOR PROVIDES A "HANDSHAKE" WHEN THE * TERMINAL IS ON-LINE. * * EXECUTION: * 1.SEND "ENQ" CHARACTER TO THE REMOTE. * 2.WAIT FOR "RVI" OR "ACK0" TO BE RECEIVED. * 3.ACTIVATE "TTqD" GENERATOR. * 4.CHANGE TERMINAL STATE TO SEND MODE. * * ERROR REJECTS: * 1. ILLEGAL PASSWORD. * 2. TERMINA OFF-LINE. * 3. TERMINAL NOT IN CONTROL MODE. * * * RC2SD LDA EQT7,I JSB PSW CHECK PASSWORD JSB CNTMD CHECK CONTROL MODE CONDITION JSB EXST CLEAN EXTENDED STATUS JSB WACTZ DEACTIVATE GENERATORS JSB TACTZ SETUP 10 MSEC INTERRUPT AT "SENQ" JMP SENQ * * * * SKP * * * * *** STATISTICS *** EXST NOP CLEAN EXTENDED STATUS CLA STA CARCT CLEAR CARRIER FAIL FLAG STA EQT12,I JMP EXST,I * * THIS ROUTINE IS USED TO RECORD ERROR CONDITIONS * IN THE EXTENDED STATUS WORD EQT12. * * ON ENTRY: REG-B = BIT THAT HAS TO BE SET IN EQT12 * * (IF BIT5 OR BIT12 ARE SET THEN THERE IS NO * RETURN FROM THIS SUBROUTINE. ALSO IF BIT13 * IS SET THEN THEN CARRIER FAIL COUNTER IS * CLEARED BEFORE RETURN). * * SET NOP STATISTICS PROCESSING ROUTINE LDA EQT12,I GET WORD 12 OF EQT IOR B INCLUSIVE OR WITH PROPER BIT STA EQT12,I AND SAVE IT AGAIN CPB BIT5 IS IT MODEM FAILURE? JMP CLOSE YES CPB BIT12 IS IT DATA SET NOT READY? JMP CLOSE YES CLA CPB BIT13 IS IT CARRIER FAIL? STA CARCT CLEAR CARRIER FAIL COUNTER JMP SET,I NOW RETURN * * SKP * * * *** WRITE PROCESSOR *** * * THIS PROCESSOR SENDS A BLOCK OF DATA AND WAITS FOR * ACCEPTANCE OR REJECTION. ERROR RECOVERY INVOLVES * RETRANSMISSION UP TO 8 TIMES BEFORE DROPPING THE * LINE. * * EXECUTION: * 1. SEND DATA TO REMOTE. * 2. SEND PROPER CHECK CHARACTER. * 3. WAIT FOR A "RECEIVE TIMEOUT" FOR REPLY. * 4. IF "WACK" RECEIVED, OR NOTHING RECEIVED, SEND * "ENQ" AND DO STEP 3. * 5. IF "NAK" OR IMPROPER CHAR RECEIVED, DO 1,2 &3. * 6. IF "ACK" RECEIVED, ENABLE "TTD" GENERATOR AND * RETURN TO USER. * * MULTIPRECORD BLOCKING IS SUPPORTED BY USING CHAIN- * ED BUFFERS. MIXED MODE OF TRANSMISSION IS ALSO * SUPPORTED. CONSULT THE ERS FOR BUFFER FORMAT. * * * A REPLY OF "DLE EOT" WILL CAUSE THE DRIVER TO * DROP THE COMMUNICATION LINE BEFORE RETURNING TO * THE USER. * * ERROR REJECTS: * 1. ILLEGAL PASSWORD. * 2. TERMINAL OFF-LINE OR IN ILLEGAL MODE. * * SKP * * * * * SENDC JSB RMD CHECK IF IN REC MODE JMP SE0 SEND LDA EQT9,I JSB PSW CHECK PASSWORD LDA RCSND SZA,RSS CHECK FOR SEND MODE JMP MVIOL * * REQUEST ACCPTED. SET UP BUF ADDR AND LENGTH * SE0 JSB EXST CLEAN EXTENDED STATUS LDA EQT7,I LDA A,I RJE PASSED BUFFER POINTER! STA BUFWA SET UP BUFFER ADDRESS LDB BUFWA,I SSB,RSS REJECT IF FIRST CHAIN WORD JMP BREJ2 NOT NEGATIVE LDB EQT8,I JSB CKLEN CK LENGTH & CONVERT TO CHAR CNT STB BUFWL SET UP NEG CHAR LEN. ADB P2 TEST CMB,INB BUFFER RBR FORMAT ADA B LDB A,I SZB REJECT IF LAST CHAIN WORD NOT 0 JMP BREJ2 * * TEST FOR "CONVERSATIONAL MODE" * STB CONVS CONVERSATION MODE LOGIC LDA FUNC GET REQ CODE. SLA,RSS IS REQ CODE FOR WRITE CONV ? JMP SINIT NO, THEN DONT SET CONV PARMS ISZ CONVS LDB EQT10,I YES. GET READ LENGTH. JSB CKLEN CK LENGTH & CONVERT TO CHAR CNT STB BUFRL SET INPUT LENGTH. LDA BUFWA SET UP STA BUFRA READ BUFFER ADDRESS * * * SINIT LDA M8 STA SCONT SET RE-TRY COUNT JSB WACTZ DEACTIVATE "TTD" MODULE JSB TACTZ * * CONTINUATOR * SEND1 JSB TIME? SETUP PROPER RECEIVE TIMEOUT LDA BCCFL (A)=BCC TYPE AND SYNC CHAR LDB BUFWL (B)=WRITE BUFFER LENGTH JSB BSCT WRITE INITIALIZE EDITOR JMP GIVU:P ABORT ON ILLEGAL RETURN JSB ERCNT SET UP RETRY COUNTER SEND2 JSB LCHCK CHECK LINE CONDITIONS CLB STB EOF CLEAR CONTROL MODE FLAG JSB BSCT JMP SCOMP CHECK COMPLETION EDITOR RETURN JSB SYN2S ENABLE INTERRUPTS JMP SEND2 * BREJ2 LDB BIT3 JMP MVIOL+1 RECORD ILLEGAL BUFR FORMAT * SCOMP STA TLOG SET NEG OUTPUT BUF LENGTH JSB SYN2S ENABLE INTERRUPTS * CLA SET UP TO SEND ENQ IF NO RESPONSE STA SCASE OR ILLEGAL RESPONSE STA SENQF CLEAR "SENT ENQ" FLAG * LDA CONVS GET CONVERSATIONAL-WRITE FLAG SZA IF DOING WRITE-CONVERSATIONAL JSB REINT THEN READ INITIALIZE EDITOR * * SET UP "ENQ" BUFFER TO SOLICIT RESPONCE. * LDA ENQ JSB BLDBF FORM BUFFER: "SYN ENQ PAD PAD" DEC 3 CMB,INB STB CONT3 STB CONT1 STA ADRS2 STA ADRS1 LDA ADSD4 SET UP SUBROUTINE LINK STA CNTRL TO RETURN AT SEND4. JMP SETUP SOLICIT RESPONCE. ************************************************************************* * * ENQ NOT SENT AND WRONG ACK MEANS OUT OF STEP. * ENQ SENT AND WRONG ACK MEANS MISSED DATA, MUST RETRANSMIT. * SENQF NOP 0 -> ENQ NOT SENT, NONZERO -> ENQ SENT * GAIN LDA RESH LDB P4 SEND "ENQ" TO REMOTE JSB CNTRL * SEND4 STA WORK STORE CHAR TEMPORARILY * CPA NAK REPLY CHAR A NAK ? JMP TMINE YES * LDB CONVS EXPECT CONVERSATIONAL REPLY ? SZB JMP CREAD YES. GO TO READ. * CPB BCONT EXPECT AN ACK0? JMP CACK0 YES, SEE IF ACK0 WAS SENT. * CPA ACK1 IS CHARACTER AN ACK1 ? JMP AOK YES. END OPERATION. * LDB SENQF HAS ENQ BEEN SENT YET? SZB,RSS (ZERO MEANS NO) JMP CRVI NO, SO MAYBE OUT OF STEP. * CPA ACK0 DID REMOTE SEND PREVIOUS ACK? JMP TMINE YES, SO RETRANSMIT DATA. JMP CRVI NO. SEE IF REMOTE SENT RVI. * CACK0 CPA ACK0 IS CHARACTER AN ACK0 ? JMP AOK YES, END OPERATION. * LDB SENQF HAS ENQ BEEN SENT YET? SZB,RSS (ZERO MEANS NO) JMP CRVI NO, SO MAYBE OUT OF STEP. * CPA ACK1 DID REMOTE SEND PREVIOUS ACK? JMP TMINE YES, SO RETRANSMIT DATA. * CRVI LDB CONVS RESTORE B REG CPA RVI IS CHARACTER A "REVERSE INTRPT"? JMP SRRIS YES, SET "REMOTE REQ TO SEND". * CPA EOT 'EOT' RECEIVED ? JMP REOT YES, GO SET UP FOR CONTROL MODE. * * * REMOTE SENT IMPROPER CONTROL CHARACTER. SEND "ENQ" * JSB UPCAR BRING UP CARRIER ISZ ERROR SENT 8 TIMES ? JMP GAIN NO, THEN SEND "ENQ". ILSQ LDB BIT4 JSB SET RECORD REPEATED ILLEGAL SEQ JMP ENDAL SEND "DLE EOT" AND DROP LINE. * * REMOTE NAK'ED THE MESSAGE. RESEND ORIGNAL BUFFER. * TMINE ISZ SCONT SENT 8 TIMES ? JMP SEND1 NO. RETRY. LDB BIT7 JMP EDBD RECORD REPEATED NAKS RCVD * * * REMOTE'S REPLY WAS ACCEPTABLE. UPDATE STATUS AND * ACTIVATE "TTD" MODULE, UNLESS 'EOT' IS RECEIVED. * * REOT STA EOF SET CONTROL MODE FLAG STB RQ2SD CLEAR RVI FLAG JMP EOK RESET FOR ACK0 * SRRIS LDB BIT4 SET "REMOTE SENT RVI" AOK STB RQ2SD SET STATE OF "RVI" FLAG. LDB BCONT ALTERNATE CMB ACKNOWLEDGEMENT EOK STB BCONT FLAG. LDB TLOG LDA EQT8,I GET REQUESTED BUF LEN SSA REQUEST IN WORDS ? JMP *+3 NO CMB,INB YES. MAKE TRASMISSION LOG POS BRS AND CONVERT TO # OF WORDS. STB TLOG CLA CPA EOF CONTROL MODE EXIT?LAG INA NO STA WACT ACTIVATE/DEACTIVATE 'TTD' GEN STA SCASE JMP COMPT EXECUTeE COMPLETION. * * CHECK LENGTH & CONVERT TO CHARACTER COUNT * CKLEN NOP SZB,RSS JMP BREJ2 LEN= 0, REJECT SSB JMP CKLEN,I ALREADY A CHAR COUNT RBL CMB,INB CONVERT FROM WORD TO CHAR COUNT JMP CKLEN,I * * DATA * BUFWA NOP WRITE BUFFER ADDRESS BUFWL NOP WRITE BUFFER LENGTH SCONT NOP WRITE RETRY COUNTER ADSD4 DEF SEND4 CONVS NOP WRITE-CONVERSATIONAL FLAG * SKP * * * *** RECEIVE PROCESSOR *** * * CALLING SEQUENCE: * JSB EXEC * DEF *+7 * DEF ICODE * DEF ICNWD * DEF IBUFR * DEF IBULF * DEF IDPRM * DEF IPRM1 * .. RETURN .. * ICODE DEC 1 READ REQ CODE * ICNWD OCT YYLU CONTROL WORD * IBUFR BSS N BUFFER * IBULF DEC N (-2N) BUF LENGTH * IPRM1 OCT REPLY ACKNOWLEDEMENT CHAR FOR CONV RED * IDPRM OCT ID PASSWORD * AND YY = 33 ACK0 OR ACK1 * = 34 NAK * = 35 SEND ACK0 AS CONVERSATIONAL REPLY * = 36 RVI * * THIS PROCESSOR FIRST SENDS THE ACKNOWLEDGEMENT * CHARACTER INDICATED BY YY AND THEN PROCEEDS TO * READ FROM THE LINE INTO THE USER BUFFER. THE BUF * FORMAT INVOLVES CHAINING. A STATUS OF 'OFF LINE' * OR 'IN SEND MODE' WILL CAUSE THE DRIVER TO REJECT * THE REQUEST (AS ALSO WILL AN ILLEGAL PASSWORD). * AN 'ENQ' RECEIVED WILL CAUSE THE DRIVER TO : * 1. RESEND ITS INITIAL ACKNOWLEDGEMENT CHARACTER IF * IT IS THE FIRST CHARACTER RECEIVED. * 2. SEND A NAK IF AT END OF RECEIVED TEXT. * * * AFTER THE MESSAGE IS CORRECTLY RECEIVED * THE DRIVER WILL AUTOMATICALL ACTIVATE THE 'WACK' * GENERATOR. * * ERROR RECOVERY: * * 1. BCC ERROR : REREAD (MESSAGE NAKED) SEVEN TIMES * AND ON THE 8TH TRY SEND 'DLE EOT' AND DROP * THE LINE. * 2. DURING RECEIPT OF CHARACTERS, IF 30 SECONDS(LGTO) * PASS WITHOUT A CHARACTER BEING RECEIVED. THE * DRIVER WILL SET THE STATUS TO INDICATE A TIME- * OUT , SEND 'DLE EOT' AND DROP THE LINE. * SKP * * READ JSB RMD CHECK IF IN REC MODE JSB EXST CLEAN EXTENDED STATUS * * SET UP REQUESTED OPTIONS. * JSB FLAGC GO CLEAR CONTROL OPTION FLAGS LDA FUNC CCB * * CPA REO2 'NAK' REQUESTED ? STB NAKFG YES. SET 'NAK' FLAG. CPA REO3 'COVERSATIONAL READ' REQUESTED ? STB CONVR YES. SET 'CONVR' FLAG. CPA REO4 'REQUEST TO SEND' BY USER ? STB RVIFG YES. TURN ON 'RVI' FLAG. CLB CPA REO2 'NAK' REQUESTED? INB YES - SET USER NAK FLAG STB UNAK * * SET UP BUF ADRS AND LENGTH. * LDA EQT7,I LDA A,I RJE PASSED BUFFER POINTER! STA BUFRA STORE BUFFER ADDRESS LDB EQT8,I JSB CKLEN CK LENGTH & CONVERT TO CHAR COUNT STB BUFRL SET BUFFER LENGTH ADB P6 SSB,RSS JMP BREJ2 REJECT IF LENGTH LESS THAN 3 WDS JSB TACTZ ENTER 'READ1' AFTER 10 MSEC * * READ1 JSB WACTZ DEACTIVATE WACK TTD GEN STA WORK CLEAR STATUS STORAGE STA TLOG CLEAR XMISSION LOG JSB UPCAR BRING UP CARRIER LDB RVI GET RVI CHARACTER LDA RVIFG SZA RVI FLAG ON ? JMP CALLB+1 YES * CPA NAKFG NAK FLAG ON ? JMP NONAK NO LDA NAK SETUP NAK IN BUFFER JSB BLDBF DEC 3 JMP CALLC * NONAK CPA CONVR CONVR FLAG ON ? RSS NO JMP CALLB * LDB ACK1 CPA BCONT CALLB LDB ACK0 USE ACK0 STB RSEND+2 SEND BUFFER LDA DLE FORM BUFFER CONTAINING: JSB BLDBF "SYN DLE ACK PAD PAD" ABORT DEC 4 * CALLC CLA CLEAR STA RVIFG RVI STA NAKFG NAK STA CONVR AND ACK0 FLAG. LDA M8 STA ERROR SET RETRY COUNTER * * INITIALIZE BISYNC READ EDITOR * JSB REINT READ INITIALIZE ED!ITOR * * OUTPUT RESPONSE TO PREVIOUS READ * LDA RESH LDB RESLN GET BUF ADDR & LEN OF RESPONSE JSB CNTRL OUTPUT RESPONSE & GET FIRST CPA EOT EOT RECEIVED? JMP REOT1 YES - AVOID BSC EDITOR FOR SPEED * CNTN1 CLB MAKE CONTINUATION ENTRY JSB BSCR AND STORE RECVD CHARACTER JMP CMANZ ANALYZE COMPLETION STATUS. SZB STB NAKFG EITHER BCC ERROR OR BAD 'DLE' SEQUENCE. LDA XMTM SET 2 SEC REC TIMEOUT JSB TACTV DEF TIMEO JSB DOLIA GET CHARACTER JMP CNTN1 * * CMANZ STB WORK SAVE STATUS IN WORK WORD STA TLOG SZB,RSS ANY ABNORMAL CONDITION ? JMP COMPR NO. THEN DO COMPLETION. SLB,RBR IS BCC IN ERROR ? STB NAKFG YES. TURN ON NAK FLAG. SLB,RBR ILLEGAL DLE SEQUENCE ? STB NAKFG YES. TURN ON NAK FLAG. SLB,RBR ENQ AS ENDING CHARACTER ? STB NAKFG YES. TURN ON NAK FLAG SLB,RBR DLE EOT RECEIVED ? JMP GIVU DROP LINE. SLB,RBR EOT RECEIVED STB EOF SET EOT RCVD FLAG. SLB,RBR NAK AS ENDING CHARACTER ? STB NAKFG YES, SET NAK FLAG. SLB BUFFER OVERFLOW ? STB OVRFL SET BUFFER OVERFLOW FLAG. * * COMPR LDA NAKFG GET NAK FLAG SET BY READ. SZA,RSS IS NAK FLAG SET ? JMP NAKNO NO. THEN GO TO READ COMPLETION. LDA WORK GET STATUS FROM WORK RAR,RAR SLA,RSS NAK FLAG SET BY ENQ (TTD) ? TNAK ISZ RETRI NO, THEN BUMP COUNTER (8 TIMES?) JMP READ1 GO RETRY LDB BIT6 RECORD 8 NAKS SENT JMP EDBD GO TO RECORD & DROP LINE * * NAKNO LDA EQT8,I GET USER GIVEN TLOG SSA DOES USER WANT POSITIVE LEN ? JMP *+5 NO, THEN IT IS ALREADY SET UP. LDB TLOG MAKE LENGTH POSITIVE. CMB,INB BRS STB TLOG LDB EOF SZB EOT RECEIVED ? JMP RCEOT YES LDA BCONT NO, THEN SET UP AS READ EXIT CMA CPB UNAK USER WANTED A NAK? STA BCONT NO, TOGGLE ACK FLIP-FLOP JMP WACTN SET UP "WACK" GENERATOR. * REOT1 STA EOF SET EOT RECVD FLAG RCEOT JSB WACTZ DEACTIVATE GENERATORS STA BCONT RESET ACK0 JMP COMPT DO COMPLETION * TIMEO ISZ NAKFG SET NAK FLAG JMP TNAK AND RETRY. GIVU LDB BIT11 RECORD 'DLE EOT' RECEIVED EDBD JSB SET RECORD VIOLATION IN STATISTICS GIVUP JSB UPCAR BRING UP CARRIER JMP ENDAL SEND "DLE EOT" & DROP LINE. SKP * * "CREAD" IS ENTRY POINT FOR THE CONVERSATIONAL * WRITE ROUTINE TO CALL THE READ PROCESSOR. * CREAD JSB FLAGC GO CLEAR ALL FLAGS STB CONVS CLEAR TO ALLOW PROPER EXIT LDA WORK GET RECEIVED CHARACTER JMP CNTN1 GO STORE IT * * * CLEAR READ PROCESSOR FLAGS * FLAGC NOP LDA M8 STA RETRI SET RE-TRY COUNTER CLB CLEAR STB NAKFG NAK FLAG STB RVIFG RVI FLAG STB CONVR CONVERSATIONAL FLAG JMP FLAGC,I RETURN * * INITIALIZE BISYNC EDITOR FOR READ * REINT NOP LDB BUFRL (B) = READ BUFFER LENGTH LDA BCCFL (A) = BCC TYPE AND SYNC CHAR JSB BSCR READ INITIALIZE EDITOR JMP GIVUP ABORT ON ILLEGAL RETURN JMP REINT,I RETURN FROM INITIALIZATION * * FORM BUFFER WITH WRD 0 = SYN * WRD 1 = (PASSED IN A) * WRD N-2 = PAD * BLDBF NOP STA RSEND+1 LDA SYN STA RSEND WRD 0 = SYN LDB BLDBF,I ADB DEFB COMPUTE ADDR FOR PADS LDA PADD STA 1,I WRD N-2= PAD INB STA 1,I WRD N-1= PAD LDB BLDBF,I INB STB RESLN STORE LENGTH & RETURN IN B ISZ BLDBF LDA RESH JMP BLDBF,I RETURN DEFB DEF RSEND-HFB1 * * * DATA * WORK NOP NAKFG NOP CONVR NOP RVIFG NOP BUFRA NOP READ BUFFER ADDRESS BUFRL NOP READ BUFFER LENGTH RETRI NOP READ RETRY COUNTER UNAK NOP 1 IF USER REQUESTED NAK, ELSE 0 * SKP * * * * *** BINARY SYNCHRONOUS EDITOR *** * (NOTE: PARITY BIT INSERTED AND DELETED BY USER). * CALLING SEQUENCES * * INITIALIZATION CALL * * LDA LRC/CRC SYN CHAR.BIT15=0 FOR LRC,1 CRC. * LDB NEG NEG BUF LENGTH * JSB BSCT/BSCR TRANSMIT OR RECEIVE ENTRY POINT. *(P+1)RETURN ABORT *(P+2)RETURN NORMAL * * CONTINUATION CALL * * LDA CHAR RECEIVED CHAR. (IGNORED ON XMIT) * LDB POS ANY POSITIVE NUMBER * JSB BSCT/BSCR TRANSMIT OR RECEIVE ENTRY POINT. *(P+1) COMPLETION RETURN *(P+2) CONTINUATION REG-B = RECEIVE STATUS OR * RETURN TRANSMITE CHAR. * REG-A = TRANSMISSION LOG. * STATUS (OCT): * 0 : NORMAL BLOCK WITHOUT ERROR * 1 : BCC IN ERROR * 2 : ILLEGAL DLE SEQUENCE * 4 : ENQ IS ENDING CHARACTER * 10 : DLE EOT RECEIVED * 20 : EOT IS ENDING CHARACTER * 40 : NAK IS ENDING CHARACTER * 100 : BUFFER OVERFLOW * (STATUS 1 & 2 CAN BE IN CONTINUATION RETURN ALSO, * BUT OTHERS OCCUR ON COMPLETION ONLY). H SKP * TRANSMISSION ROUTINE BSCT NOP SSB,RSS INITIAL CALL ? JMP TNXT,I NO LDB WBFAD,I SET UP POINTER TO FIRST STB BFRPT BUFFER IN CHAIN INB RBL STB SNDA LDB BFRPT,I STB SNDL SET LENGTH OF 1ST BUFR IN CHAIN LDB LRCSA SET LRC PROCESSOR ADDRESS SSA IF A IS POSITIVE LDB CRCSA OTHERWISE SET CRC PROCESSOR ADR. STB TBCPA * LDB P2 SET XMISSION LOG TO ACCOUNT FOR STB TLOGG THE FIRST CHAIN WORD. JSB EDINT GO INITIALIZE THINGS JMP ENDTX ERROR RETURN LDB ESYN STB BYTE SET SYN FOR OUTPUT LDB SYNCT SET COUNT FOR STB SYNOW NEXT SYNC. CLA JMP XITX1 RETURN. * * * COMPUTE LONGITUDINAL/CYCLICAL REDUNDANCY * DOBCC NOP LDA BCC LDB BCCFG SSB SKIP IF LONGITUDINAL REDUNDANCY CHECK JMP DOCRC ELSE IT'S CYCLICAL REDUNDANCY LDB BYTE BLF,BLF XOR B COMPUTE LRC JMP DOBEX * DOCRC XOR BYTE XOR IN NEW BYTE LDB M8 SLA,RAR NOW THE POLYNOMIAL XOR CRCD INB,SZB JMP *-3 DOBEX STA BCC JMP DOBCC,I RETURN BCCFG NOP CRCD OCT 020001 * * WBFAD DEF BUFWA TBCPA NOP BCC NOP * * * PTR NOP * * * LRCSA DEF LRCS CRCSA DEF CRCS SNDA NOP SNDL NOP * * ASCII.CONTROL CHARACTERS OCT 160 ASCII STICK MACK OCT 60 ASCII STICK ACCTA DEF *+1 DEC -10 NUMBER OF CONTROL CHARACTERS EDLE OCT 20 DLE OCT 26 SYN ESTX OCT 2 STX EITB OCT 37 ITB OCT 1 SOH OCT 27 ETB OCT 3 ETX OCT 4 EOT OCT 25 NAK P5 OCT 5 ENQ CMASK OCT 377 BFRPT NOP ESYN NOP SYN BEING USED EEOT NOP EOT BEING USED * TNXT NOP TINC2 LDA P2 $ INCREMENT STATE BY 2 XITXS ADA XMTI XITX1 STA XMTI ADA OTPRT ADD BASE ADDRESS LDA A,I STA TNXT SET TRANSFER ADDRESS XITX ISZ BSCT BUMP TO CONTINUATION RETURN ENDTX LDB BYTE ON RETURN REG-A = BYTE AND LDA TLOGG REG-B = XMISSION LOG CMA,INA MAKE XMISSION LOG NEGATIVE JMP BSCT,I RETURN TLOGG NOP XMTI NOP BYTE NOP BYTLD NOP LDB SNDA GET BYTE ADDRESS CLE,ERB BYTE ADDR IS NOW WORD ADDRESS LDA 1,I GET WORD FROM BUFFER SEZ,RSS ALF,ALF ENSURE BYTE IS IN RHW AND CMASK STA BYTE SAVE BYTE ISZ SNDA SAVE NEW BYTE ADDRESS ISZ TLOGG BUMP TRANSMISSION LOG JSB DOBCC COMPUTE BCC ISZ SNDL SKIP IF LAST JMP BYTLD,I RETURN * END? LDB SNDA SLB,RSS JMP *+3 INB BUMB TO NEXT BYTE ADDRESS ISZ TLOGG BUMP TLOGG BECAUSE EMPTY BYTE. ISZ TLOGG BUMP XMISSION LOG TO ACCOUNT FOR ISZ TLOGG THE CHAIN WORD RBR MAKE IT WORD ADDRESS LDA B,I GET LINK SZA,RSS ANY MORE BUFFER ? JMP ENCK NO. CHECK LAST BYTE OF LAST BUF. STA SNDL SET UP LENGTH OF NEXT BUFFER INB RBL STB SNDA SET ADDRESS OF NEXT BUFFER LDA P10 LDB EITB CPB BYTE IS LAST BYTE = ITB ? JMP XITX1 YES. PROCESS IT. JMP CONTU NO. TERMINATE RIGHT HERE. ENCK LDB ESQCC JMP RDCOD DECODE LAST BYTE * DLECC LDB RTCC GET TRANSPARENT PRCR TBL ADRS RDCOD STB PRTA SAVE PROCESSOR TABLE ADDRESS LDA BYTE AND DMASK MASK OFF PARITY IF EXPECTED CMA,INA ADA MAXCC SSA IF NOT A CONTROL CHAR JMP 1,I THEN DONT SCAN TBL LDA BYTE AND DMASK FORGET PARITY WHILE DECODING LDB PCCTA PUT CNTRL CHAR TBL STB PTR ADRS IN WORK WORD LDzDB B,I GET TABLE LENGTH ISZ PTR BUMP TO NEXT CNTRL CHAR CPA PTR,I EQUAL TO TBL ENTRY JMP *+3 YES ISZ B END OF TBL ? JMP *-4 NO CMB,INB COMPUTE PROCESSING ROUTINE ADB PRTA ADDRESS AND JMP TO IT. JMP 1,I * OTPRT DEF *+1 DEF SRBGN SRCH FOR BGN BCC ACCUM CHAR DEF XMTSY XMIT A SYNC CHAR DEF STX? CHECK STX AFTER DLE DEF TXTXT SEND NON-TRANS TEXT DEF XMTSY XMIT A SYNC CHAR DEF STX? CHECK STX AFTER DLE DEF TTXTX SEND TRANSPARENT TEXT DEF XMTSY XMIT A SYNC CHAR DEF TXDLE XMIT DLE FOLLOWING DLE DEF TXBCC SEND BCC AFTER ETB/ETX DEF ITXBC SEND BCC AFTER ITB DEF SPAD SEND PAD DEF SPAD SECOND PAD DEF ENDTX LAST BYTE IS GONE DEF ITXSY SEND SYN AFTER ITB/BCC DEF LSLD LOAD LAST BYTE OF TRANS TEXT * * * SPAD LDA CMASK SEND PAD STA BYTE AND CLA,INA SET FOR COMPLETION EXIT JMP XITXS * * * SRBGN JSB TYMSY CHECK TIME TO SEND SYNC JMP XMIT1 NOT TIME XNTSY CLA,INA,RSS SET TO INCREMENT STATE XMTSY CCA SET TO DECREMENT STATE LDB ESYN STB BYTE SEND SYN JMP XITXS AND SET STATE * XMIT1 JSB BYTLD GET A BYTE LDB SRCCT GET CNTRL CHAR PROCR ADDRESS JMP RDCOD DECODE BYTE * SRCCT DEF *+1,I DEF XITX DATA DEF XITX ENQ DEF XITX NAK DEF XITX EOT DEF XITX ETX DEF XITX ETB DEF SETXT SOH DEF XITX ITB DEF SETXT STX DEF XITX SYN DEF TINC2 DLE * STX? JSB BYTLD GET A BYTE LDB ESTX CPB BYTE IS BYTE = STX ? JMP SETPM YES. SET TRANSPARENT MODE LDA M2 NO. REVERT BACK TO SRCH HEADER. JMP XITXS * * SETPM LDB XMTI ` ADB M2 IF NOT IN TEXT MODE SZB,RSS CLEAR BCC STB BCC LDA P6 JMP XITX1 SET STATE TO TRANSPARENT MODE * TXTXT JSB TYMSY TIME TO SEND SYNC ? RSS NO JMP XNTSY YES. GO SEND NON-TRANS SYN DLE? JSB BYTLD GET A BYTE LDB EDLE CPB BYTE BYTE = DLE ? JMP TINC2 YES. SET TO CHECK FOR STX . JMP XITX NO, THEN MAINTAIN THIS MODE. * TTXTX JSB TYMSY TIME TO SEND SYN ? JMP XMTT NO CLA,INA,RSS YES. SEND DLE NOW, GTDLD LDA P9 GTDLE LDB EDLE AND INCREMENT STATE STB BYTE TO SEND SYN NEXT TIME. JMP XITXS * XMTT LDA SNDL GET REMAINING LENGTH INA,SZA,RSS WILL NEXT BYTE BE THE LAST ONE ? JMP GTDLD NEXT STATE TO LOAD LAST BYTE. JMP DLE? GO CHECK FOR DLE * TXDLE LDA M2 GO BACK TO TRANS MODE AND JMP GTDLE SEND DLE THIS TIME * LSLD JSB BYTLD LOAD LAST TRANS BYTE JMP END? THIS SHOULD NOT BE * SYNCT DEC -300 SYNOW NOP TYMSY NOP ISZ SYNOW TIME FOR SYNC PATTERN JMP TYMSY,I NO ISZ TYMSY YES, THEN BUMP RETURN LDB SYNCT STB SYNOW RESET COUNT TO NEXT SYNC JMP TYMSY,I * SETXT LDA P3 JMP TXBCX * ETXI LDA P9 JMP XITX1 * ITXBC JSB TBCPA,I GET BCC JMP XITX CONTINUE LDA P14 INDEX TO SEND SYN AFTER BCC JMP TXBCX * ITXSY LDA P3 SET UP TO SEND ONE MORE SYN STA XMTI AND THEN GO BACK TO NON-TRAN JMP XNTSY MODE * TXBCC JSB TBCPA,I GET BCC BYTE JMP XITX CONTINUE CONTU LDA P11 TXBCX CLB STB BCC CLEAR ACCUMULATED BCC JMP XITX1 INDEX TO SEND NEXT SEQUENCE * * * CRCS NOP LDA BCC GET FIRST BCC BYTE FOR XMIT AND CMASK STA BYTE LDA CRS2A STA TBCPA SET TO SEND NEXT BCC BYTE JMP CRCS,I * CRS2uA DEF CRCS2 * CRCS2 NOP LDA CRCSA STA TBCPA RESTORE CRCS ADDRESS ISZ CRCS2 BUMP TO COMPLETION RETURN LDA BCC ALF,ALF AND CMASK GET SECOND CRC BYTE FOR XMIT STA BYTE JMP CRCS2,I * * * LRCS NOP ISZ LRCS BUMP TO COMPLETION RETURN JSB VRCS GO DO VRC ON LRC BCC IF ASCII STA BYTE JMP LRCS,I * BCNT NOP BIT COUNTER * VRCS NOP LDA BCC ALF,ALF AND DMASK MASK TO GET 7 OR 8 BITS LDB PCCTA ADB P2 LDB B,I CPB ECCTA+3 EBCDIC CODE ? JMP VRCS,I YES, THEN NO VRC. LDB M7 STB BCNT SET UP BIT COUNTER CLB HR SLA,RAR IS BIT = 1 INB YES, THEN BUMP B ISZ BCNT DONE ? JMP HR NO SLB,RSS NUMBER OF BITS EVEN ? INA YES, THEN INSERT PARITY. RAR POSITION THE CHARACTER ALF,ALF JMP VRCS,I RETURN * * CRCK NOP LDA BYTE GET FIRST CRC BYTE XOR BCC XOR TO COMPUTED CRC STA BCC SAVE IT LDA CRK2A SET TO CHECK NEXT BYTE STA RBCPA JMP XITRD * CRK2A DEF CRCK2 * CRCK2 NOP LDA CRCKA STA RBCPA RESTORE CRC CHECK ADDRESS LDA BYTE GET SECOND CRC BYTE ALF,ALF MOVE TO HIGH 8 BITS XOR BCC XOR TO COMPUTED CRC LDB CRCK2 B= RETURN ADDR JMP LRCEX * LRCK NOP JSB VRCS COMPUTE VRC ON LRC IF ASCII XOR BYTE XOR WITH RECEIVED LRC/VRC BCC LDB LRCK RETURN ADDR LRCEX SZA CLA,INA CRC/BCC BAD, NON-ZERO STATUS STA RSTAT CLA STA BCC CLEAR BCC JMP 1,I RETURN SKP * RECEIVE ROUTINE * BSCR NOP SSB INITIALIZATION CALL ? JMP RDINT YES AND CMASK NO, THEN SET UP TO DECODE BYTE. STA BYTE CLB gU STB RSTAT CLEAR STATUS BYTE JMP RNXT,I JUMP TO PROCESSING ROUTINE * RDINT ADB P4 ACCOUNT FOR FIRST & LAST LINKS. STB RCVL SET REMAINING LENGTH. LDB RBFAD,I STB BFRPT SET POINTER TO CHAIN WORD CLE,INB SET BUF BYTE POINTER ELB STB RCVA SET CURRENT BUF AND LDB LRCKA SET SSA BCC LDB CRCKA PROCESSOR STB RBCPA ADDRESS. LDB INPRT+1 STB RNXT SET NEXT ENTRY CLB STB ECHAR CLEAR END-CHAR TYPE STB RCVI CLEAR RECEIVE STATE INDEX STB RLOG AND RECV LOG STB RSTAT CLEAR STATUS WORD JSB EDINT GO INITIALIZE THINGS. JMP ENDRD ERROR RETURN JMP XITRD NORMAL RETURN * RBFAD DEF BUFRA LRCKA DEF LRCK CRCKA DEF CRCK RLOG NOP RSTAT NOP RCVL NOP RCVA NOP RCVI NOP RBCPA NOP RNXT NOP * EOB LDA P9 INDEX TO READ INTERMEDIATE BCC JMP SETIS EOM LDA P8 INDEX TO READ BCC JMP SETIS * PADC AND LO4 CPA LO4 IS PAD OK ? JMP PADOK YES. DECR1 CCA,RSS DECREMENT INDEX INCR2 LDA P2 INCREMENT INDEX BY 2 SETX ADA RCVI SETIS STA RCVI SET NEW INDEX ADA INPRT SET NEW LDA A,I PROCESSOR STA RNXT ADDRESS. XITS JSB BYTST STORE RECEIVED BYTE XITRD ISZ BSCR BUMP TO CONTINUATION RETURN. ENDRD LDB RSTAT GET STATUS LDA RLOG AND XMISSION LOG JMP BSCR,I LEAVE EDITOR * BYTST NOP LDB RCVL GET LENGTH ISZ RCVL REMAINING LENGTH AFTER BUMP =0 ? SSB SKIP IF >0 JMP CARYN BFST LDA BFRFL YES. SET BFR FULL IN STATUS. JMP FRMST SET UP READ BUF AND END READING. * CARYN LDB RCVA CLE,ERB CHANGE TO WORD ADDRESS LDA 1,I GET NEXT WORD SEZ,RSS ALF,ALF POSITION BYTE AND UPBYT MASK IT IOR PBYTE MERGE NEW BYTE SEZ,RSS ALF,ALF POSITION FOR STORE STA 1,I BACK INTO BUFFER ISZ RCVA BUMP BYTE ADDRESS JSB DOBCC COMPUTE BCC ISZ RLOG BUMP RECEIVED LOG JMP BYTST,I * * PCCTA NOP MAXCC NOP PRTA NOP BFRFL OCT 100 * * INPRT DEF *+1 DEF SRHDR SEARCH FOR START OF HEADER DEF PADC CHECK PAD AFTER CONTROL SEQUENCE DEF STICK CHECK STX/STICK AFTER DLE DEF RDTXT READ NON-TRANSPARENT TEXT DATA DEF PADC CHECK PAD AFTER ENQ DEF DLSTX CHECK STX AFTER DLE DEF RTTXT READ TRANSPARENT TEXT DATA DEF DLECC CHECK CONTROL CHAR AFTER DLE DEF RDBCC READ BCC DEF RIBCC READ INTERMEDIATE BCC DEF RDTXT READ DATA AFTER ITB AND BCC DEF PADC CHECK PAD AFTER ENQ DEF DLSTX CHECK STX AFTER DLE * SKP * SRHDR LDB SRPRT GET PROCESSOR TBL ADRS JMP RDCOD GO DECODE RECEIVED BYTE * SRPRT DEF *+1,I DEF XITS NON-CONTROL CHAR PROCESSOR DEF ENQI ENQ PROCESSOR DEF NAKI NAK PROCESSOR DEF EOTI EOT PROCESSOR DEF EOM ETX PROCESSOR DEF EOM ETB PROCESSOR DEF SOM SOH PROCESSOR DEF XITS ITB PROCESSOR DEF SOM STX PROCESSOR DEF XITRD SYN PROCESSOR DEF INCR2 DLE PROCESSOR * * * EDINT NOP STA BCCFG SIGN = BCC MODE CCB STB BCC SET ILLEGAL BCC AND LET STX CLEAR IT AND CMASK SET LINE-CODE TABLE CPA ECCTA+3 ACCORDING TO JMP EB SYN CHARACTER CPA ACCTA+3 RSS JMP EDINT,I ERROR RETURN LDB M177 STB DMASK SET ASCII DECODING MASK=177 LDB ACCTA LDA ACCTA+5 JMP EB+4 EB LDB CMASK STB DMASK SET EBCDIC DECODING MASK = 377 LDB ECCTA LDA ECCTA+10 STA MAXCC SET MAX CONTROL CHARACTER STB PCCTA SET CNTRL CHAR TBL ADDRESS ISZ EDINT ADB P2 LDA B,I STA ESYN ADB P6 SET LINE CODE FOR 'SYNC' LDA B,I AND 'EOT' BEING USED. STA EEOT JMP EDINT,I * * * * * * EBCDIC CODE SET * OCT 340 EBCDIC STICK MASK OCT 140 EBCDIC STICK ECCTA DEF *+1 DEC -10 OCT 20 DLE OCT 62 SYN OCT 2 STX OCT 37 ITB OCT 1 SOH OCT 46 ETB OCT 3 ETX OCT 67 EOT OCT 75 NAK OCT 55 ENQ * * * ESQCC DEF *+1,I DEF CONTU DATA DEF CONTU ENQ DEF CONTU NAK DEF CONTU EOT DEF ETXI ETX DEF ETXI ETB DEF CONTU SOH DEF CONTU ITB DEF CONTU STX DEF CONTU SYN DEF CONTU DLE * * * DLEOT LDB DEOT SET DLE EOT RECEIVED RSS ENQI LDB ENQR SET ENQ AS END CHAR RSS NAKI LDB NAKR SET NAK AS END CHAR RSS EOTI LDB EOTR SET EOT AS END CHAR STB ECHAR SET END CHAR TYPE AND PADOK LDA ECHAR END-CHAR TYPEED STATUS FRMST IOR RSTAT INCLUDE IN ACCUMULATED STATUS STA RSTAT SET NEW STATUS JMP RDEND AND END READ * DEOT OCT 10 ENQR EQU ABORT EOTR OCT 20 NAKR OCT 40 * * ECHAR NOP LO4 OCT 17 * * * * TSTX LDA P6 SET TRANSPARENT TEXT INDEX RSS SOM LDA P3 SET NON-TRAN TEXT INDEX STA RCVI JSB BYTST STORE BYTE CLA STA BCC CLEAR BCC JMP SETI SET INDEX * * RDBCC JSB RBCPA,I VALIDATE BCC RDEND LDA RLOG CMA,INA SET NEG BYTE LEN STA BFRPT,I OF LAST BUF IN CHAIN. CLA LDB RCVA GET BYTE ADDRESS INB FORM WORD ADDRESS CLE,ERB STA B,I SET ZERO IN LAST CHAIN WORD LDA RBFAD,I CMB ADA 1 BIT9 ALS SET NEG BYTE LEN OF REC BUF STA RLOG IN RLOG. JMP ENDRD END READING. * * RIBCC JSB RBCPA,I VALIDATE BCC LDA RCVL GET REMAINING LENGTH LDB RCVA GET NEXT BYTE ADDRESS SLB,RSS IS IT BYTE ADDRESS ? JMP *+3 NO INB YES, THEN BUMP TO WORD ADRS INA AND DECREMENT LENGTH. ADA P2 INCREMENT FOR CHAIN WORD STA RCVL AND UPDATE REMAINING LENGTH. INA SSA,RSS WILL 1 MORE WORD FIT IN ? JMP BFST NO, LESS THAN 2. TERMINATE. LDA RLOG SET LENGTH CMA,INA OF STA BFRPT,I LAST BUFFER. RBR STB BFRPT SET POINTER TO NEXT CHAIN WORD. INB RBL STB RCVA SET BUF POINTER CLA STA RLOG RESET LOG FOR NEXT BUF. BMPI CLA,INA JMP SETI * STICK CPA EEOT JMP DLEOT CPA ESTX IS BYTE = STX ? JMP TSTX YES, THEN SET TRANSPARENT MODE. LDB PCCTA NO ADB M3 AND B,I MASK BYTE WITH STICK MASK INB CPA B,I IS BYTE = STICK ? JMP DECR1 YES. INDEX TO CHECK PAD. CLA NO. CLEAR END-CHAR-TYPE AND STA ECHAR SET INDEX TO SEARCH FOR HEADER. JMP SETIS * * * * * * RDTXT LDB TXTCC GET PROCESSOR TABLE ADDRESS JMP RDCOD * TXTCC DEF *+1,I DEF XITS DATA DEF ENQI ENQ DEF XITS NAK DEF XITS EOT DEF EOM ETX DEF EOM ETB DEF XITS SOH DEF EOB ITB DEF XITS STX DEF XITRD SYN DEF INCR2 DLE * DLSTX CPA ESTX IS BYTE=STX ? JMP STRMD YES. SET TRAN MODE. LDA M2 DECREMENT INDEX BY 2. JMP SETX STORE BYTE. * STRMD LDA P6 SET TRAN MODE WITHOUT RESETTING VJMP SETIS BCC. * RTTXT CPA EDLE RECEIVED BYTE " DLE ? JMP BMPI YES. DONT STORE IT & BUMP INDEX. JMP XITS NO, THEN STORE IT. * * RTCC DEF *+1,I DEF RTER ILLEGAL DLE SEQ DEF ENQI ENQ DEF RTER NAK DEF RTER EOT DEF EOM ETX DEF EOM ETB DEF RTER SOH DEF EOB ITB DEF RTER STX DEF DECR SYN DEF DECR1 DLE * * RTER LDB ILDLE SET STATUS FOR ILLEGAL DLE SEQ. STB RSTAT JMP DECR1 DECREMENT STATE & STORE BYTE. ILDLE OCT 2 * * DECR CCA SETI ADA RCVI DECREMENT INDEX STA RCVI SET NEW INDEX ADA INPRT AND LDA A,I NEW ENTRY ADDRESS STA RNXT JMP XITRD SKP * * LINE CODE DATA * CCADD DEF EOT ADDRESS OF CONTROL CHARACTER LST EOT BSS 1 ETB BSS 1 ETX BSS 1 NAK BSS 1 RVI BSS 1 SOH BSS 1 STX BSS 1 ACK0 BSS 1 ACK1 BSS 1 WABT BSS 1 ENQ BSS 1 SYN BSS 1 SYNC CHAR SYNC BSS 1 SYNC-REFERENCE CMD. ('SYN'+BIT#14) ITB OCT 37 DLE OCT 20 STOR OCT 160010 CONFIGURED SEND-TO-RECEIVE CMAND SSEND OCT 171010 CONFIGURED SYNC SEND COMMAND SREVC OCT 151030 CONFIGURED SYNC RECEIVE COMMAND MASK EQU CMASK PADD EQU CMASK * EBCCC DEF ECCC ASCCC DEF ACCC * * EBCDIC CODE * ECCC OCT 67 EOT OCT 46 ETB P3 OCT 3 ETX OCT 75 NAK OCT 174 RVI P1 OCT 1 SOH P2 OCT 2 STX OCT 160 ACK0 OCT 141 ACK1 OCT 153 WACK OCT 55 ENQ OCT 62 SYNC OCT 40062 CONFIGURED SYNC * * * ASCII CODE * ACCC OCT 4 EOT OCT 227 ETB OCT 203 ETX OCT 25 NAK OCT 274 RVI OCT 1 SOH OCT 2 STX OC*B@ FOR ALL REQUESTS ): * * BIT# MEANING * ---- ---------------------- * 0 0 = REQUEST SERVICED W/O ERROR 1 = IRRECOVERABLE LIN~dE ERROR. * 1 0 = TERMINAL OFF LINE 1 = TERMINAL ON LINE. * 2 0 = * 1 = TRANSMIT MODE. * 3 0 = * 1 = RECEIVE MODE. * 4 0 = [ DON'T CARE ] 1 = 'RVI' RECEIVED. * 5 0 = [ DON'T CARE ] 1 = BUFFER OVERFLOW. * * * BITS #2&3 =0, AND BIT #1 =1 IMPLIES: CONTROL MODE. * * EQT12 ( RETURNED IN FOR EXTENDED STATUS REQUEST ): * * BIT# MEANING WHEN EQUAL TO 1 * ---- ----------------------- * 0 SECURITY CODE VIOLATION. * [ RJE: 20 ] * 1 PASSWORD VIOLATION. * [ RJE: 21 ] * 2 ILLEGAL MODE FOR REQUEST ISSUED TO DRIVER. * [ RJE: 22 ] * 3 ILLEGAL BUFFER FORMAT SPECIFIED. * [ RJE: 23 ] * 4 ILLEGAL BISYNC SEQUENCE RECEIVED REPEATEDLY (7 TIMES). * [ RJE: 24 ] * 5 LOSS OF 'CLEAR-TO-SEND' FROM MODEM. * [ RJE: 25 ] * 6 RECEIVED BUFFER 'NAK'ED' 7 TIMES. * [ RJE: 26 ] * 7 XMITTED BUFFER 'NAK'ED' BY REMOTE 7 TIMES. * [ RJE: 27 ] * 8 RECEIVE TIMEOUT OCCURRED REPEATEDLY (7 TIMES). * [ RJE: 30 ] * 9 LONG TIMEOUT FAILURE. * [ RJE: 31 ] * 10 DISCONNECT (DLE-EOT) SENT TO REMOTE & LINE DROPPED. * [ RJE: 32 ] * 11 DISCONNECT (DLE-EOT) RECEIVED FROM REMOTE & LINE DROPPED. * [ RJE: 33 ] * 12 LOSS OF 'DATA-SET-READY' FROM MODEM. * [ RJE: 34 ] * 13 LOSS OF 'CARRIER-DETECT' FROM MODEM, DURING RECEIVE MODE. * [ RJE: 35 ] * 14 'TTD' OR 'WACK' LIMIT EXCEEDED. * [ RJE: 36 ] * 15 CONTROL-TIMEOUT FAILURE - LINE IN 'CONTROL-MODE' AND USER * FAILED TO MAKE A REQUEST BEFORE EXPIRATION OF 'LONG TIMEOUT. * THEf LINE IS DISCONNECTED, FOLLOWING A 'CONTROL-TIMEOUT. * [ RJE: 37 ] * SKP * INITIATION SECTION * I.50 NOP STA SCODE SAVE SELECT CODE OF RCV BOARD LDA EQT6,I AND M3777 CPA M3 CLEAR REQUEST ? JMP RSET YES. CLEAN DRIVER & DROP LINE. CPA M3003 EXTENDED STATUS REQUEST ? JMP STATR YES. RETURN EXTENDED STATUS. LDB EQT15,I GET CLOCK VALUE SZB,RSS IS CLOCK ACTIVE ? JMP ICHK NO. CHECK FOR INITIALIZE CALL. CPA M3703 IS IT INITIALIZE AGAIN. JMP MVIOL YES, RECORD MODE VIOLATION. * * CHECK SECURITY CODE BEFORE ALLOWING ENTRY INTO LIBRARY SECTION. * SURCH LDA SPTR,I GET SECURITY WORD FROM LIBRARY DVR CPA SECD IS SECURITY VIOLATED ? JMP IENTR NO, THEN ENTER #I.50 JSB SVIOL YES, RECORD SECURITY VIOLATION. REJ2 LDA P2 INDICATE: CLB ERROR RETURN! JMP I.50,I RETURN * * THIS SECTION IS ENTERED WHEN EQT15=0. IN THAT CASE * IT MUST EITHER BE AN INITIALIZATION CALL OR HAND- * SHAKE/AUTO-ANSWER CALL. IF HAND-SHAKE OR AUTO- * ANSWER THEN PASSWORD AND SECURITY CODE MUST BE VALID. * ICHK CPA M3703 IS IT INITIALIZE CALL ? JMP SETUP YES. SET UP INITIALIZATION. CPA M3403 HAND-SHAKE ? JMP SURCH YES, CHECK SECURITY CODE. CPA M3303 AUTO-ANSWER ? JMP SURCH YES, CHECK SECURITY CODE. * MVIOL LDB P4 JSB SET RECORD MODE VIOLATION IN BIT 2 JMP REJ2 REJECT REQUEST. * SVIOL NOP CLB,INB RECORD SECURITY VIOLATION JSB SET IN BIT 0 . JMP SVIOL,I REJECT REQUEST. * SET NOP LDA EQT12,I SET APPROPRIATE ERROR IOR B BIT IN EXTENDED STATUS WORD STA EQT12,I CLB,INB LDA EQT5,I ALSO SET 'OPERATION IN IOR B ERROR' BIT IN STANDARD STA EQT5,I STATUS WORD. JMP SET,I RETUMRN * RSET JSB CLC$ INHIBIT INTERRUPTS STB FLG CLEAR REQUEST-IN-PROGRESS FLAG. JSB OFBRD TURN OFF MODEM JMP IMCMP GO FOR IMMEDIATE COMPLETION * * IENTR CLA STA FLG LDA TIMAD PASS #TIME ADDRESS FOR INITIALIZATION. JSB #I.50,I * SZA,RSS REQUEST INITIATED ? ISZ FLG YES, SET FLAG JMP I.50,I RETURN. * * RESOLVE REG-A POINTER * APTR NOP APTR1 SSA,RSS INDIRECT ADDRESS ? JMP APTR,I NO, THEN RETURN. ELA,CLE,ERA CLEAR BIT15 LDA A,I GET NEXT ADDRESS LINK JMP APTR1 RESOLVE INDIRECT AGAIN * * RETURN EXTENDED STATISTICS IN REG-B * STATR CCA OFFSET SYSTEM EQT15 POINTER TO ADA EQT15 PREVENT RESETTING OF CURRENT STA EQT15 CLOCK VALUE. LDB EQT12,I GET EXTENDED STATUS FROM EQT12 IMCMP LDA P4 INDICATE IMMEDIATE COMPLETION JMP I.50,I RETURN TO THE CALLER. * SKP * THIS IS THE INITIALIZATION SET-UP ROUTINE. IT * ESTABLISHES #I.50, #C.50 AND #P.50 LINKS WITH * THE LIBRARY RESIDENT DRIVER. A POINTER TO A * SECURITY CODE (LOCATED IN #BSC) IS ESTABLISHED. * SOME EQT POINTERS ARE SET UP AND "CLC" & "OTA" * INSTRUCTIONS ARE CONFIGURED. * SETUP LDA EQT7,I GET ADDR OF "IPRM" FROM CALL JSB APTR LDB A,I STB EQT7,I SET ASC/EBCDIC & CRC/LRC FLAG INA BUMP POINTER LDB A,I GET MAP SWITCHING PARAMETER. INA POINT TO NEXT PARAMETER. SZB IF MAP SWITCHING IS NOT NEEDED (B#0), JMP CKPRV LEAVE BYPASS INSTRUCTIONS INTACT; STB MAP1 ELSE, STB MAP2 CLEAR ALL OF THE STB MAP3 BYPASS INSTRUCTIONS, STB MAP4 IN ORDER TO ENABLE STB MAP5 MAP SWITCHING FOR RTE-III. JMP *+3 CONTINUE THE PROCESS. CKPRV INB,SZB IF =-1, ENABLE DMS STATUS-ONLY; JMP GTAD ELSE, IGNORE ALL DMS IN/STRUCTIONS! STB MAP6 ALLOW P.50 TO SAVE DMS STATUS, ON ENTRY. STB MAP7 ALLOW P.50 TO RESET DMS STATUS, ON EXIT. GTAD LDB A,I GET THE TIMEOUT-ARRAY ADDRESS STB TIMAD AND SAVE FOR #BSC INITIALIZATION. INA ADVANCE POINTER TO #BSC ADDRESS. LDA 0,I GET THE ADDRESS OF #BSC JSB APTR LDB 0 STB SPTR SET POINTER TOWARDS SECURITY LOC INB BUMP TO NEXT ADDRESS LDA B,I SET JSB APTR STA #I.50 POINTERS INB TO LDA B,I #I.50 JSB APTR STA #C.50 #C.50 INB AND LDA B,I #P.50 JSB APTR STA #P.50 IN THE LIB DVR. * MAP1 JMP FCLC BYPASS MAP SWITCH (NOP: SWITCH) LDA BUF1A USA GET USER MAP FOR RJE/#BSC * FCLC LDA CLC CONFIGURE IOR SCODE CLC XX,C STA CLC1 FOR RECEIVE INA AND STA CLC2 TRANSMIT BOARDS. LDA OTA CONFIGURE "OTA XX" INSTRUCTIONS IOR SCODE STA OTA1 STA OTSYN INA BUMP TO XMIT CHANNEL STA OTA2 LDA EQT1,I GET ADDRESS OF WORD #16 ADA P15 OF CALLING PROGRAM'S ID SEGMENT STA STPNT WHICH HAS STATUS OF PROGRAM. LDA EQT15 SET STA EQP15 EQT15 POINTER JMP SURCH GO FOR #I.50 ENTRY * SKP * * ** TIME-OUT / COMPLETION SECTION ** * * THIS ROUTINE IS ENTERED ON A 'TIME-OUT' (DVR50 SETS BIT#12 OF EQT4 TO * TELL RTE THAT IT IS HANDLING IT'S OWN TIMEOUT). COMPLETION IS INDICATED * BY A (P+1) RETURN FROM THIS SECTION TO RTIOC. * BEFORE JUMPING TO THE LIBRARY RESIDENT #C.50, SECURITY CODE IS CHECKED. * IF VIOLATED, AND A REQUEST WAS IN PROGRESS, THEN RETURN TO RTIOC WITH * =1 (MALFUNCTION). IF NO REQUEST, $UPIO (IN RTIOC) HANDLES THE EXIT. * #C.50 MAKES A P+1 RETURN TO DVR50, IF NOt REQUEST WAS IN PROGRESS * ($IOUP IN RTIOC HANDLES THE DRIVER'S EXIT); #C.50 MAKES A (P+2) RETURN * TO DVR50, IF A REQUEST WAS COMPLETED (RETURN TO RTIOC IS VIA C.50); * #C.50 RETURNS TO DVR50 AT (P+3) FOR REQUEST COMPLETION (RETURN TO * RTIOC IS VIA (C.50+1). * C.50 NOP TIMAD EQU C.50 TEMPORARY STORAGE: INITIALIZATION. CLF 0 TURN OFF INTERRUPT SYSTEM LDA EQT4,I AND MTBIT CLEAR TIME-OUT BIT STA EQT4,I LDA EQT15,I GET CLOCK VALUE SZA IS EQT15=0 ? JMP CEXIT NO, ILLEGAL INTERRUPT, DO P+2 RETURN * MAP2 JMP CLRTO BYPASS DMS STATUS (NOP: SAVE STATUS) RSB STB TOSTS SAVE DMS STATUS BLF,SLB JMP CLRTO ALREADY IN USER MAP, JUMP * * UNDER SYSTEM MAP, GET RJE USER MAP LDB BUF3A USB SAVE CURRENT USER MAP CONTENTS LDB BUF1B USB SET RJE MAP UJP *+2 NOW RUNNING UNDER RJE MAP * CLRTO JSB CLC$ PROHIBIT INTERRUPT ON BOARDS STF 0 TURN ON INTERRUPT SYSTEM CPA ABTFG TEST ABORT FLAG SET BY P.50 JSB EXIST NO ABORT, CHECK SEC CODE & DORMANCY JMP VIOLA * JSB #C.50,I CALL #BSC TIMEOUT SECTION JMP IOUP REQUEST NOT BEING PROCESSED JMP CP1 RETURN VIA C.50: REQUEST COMPLETED. ISZ C.50 RETURN VIA C.50+1: REQUEST CONTINUATION. STB SAVB TSMAP JSB MAPIT DO POSSIBLE MAP RESTORE LDB SAVB JMP C.50,I RETURN * SKP * * SUBROUTINE TO RESTORE ORIGINAL MAP STATUS * MAPIT NOP MAP3 JMP MAPIT,I RETURN IMMEDIATELY (NOP: PROCESS MAPS) LDB TOSTS BLF,SLB JMP MAPIT,I JUMP IF DVR50 DIDN'T SWITCH USER MAP CLF 0 SJP *+2 ENABLE SYSTEM MAP LDB BUF3B USB RESTORE ORIGINAL USER MAP STF 0 JMP MAPIT,I * * CEXIT ISZ C.50 P+2 RETURN STF 0 JMP C.50,I * VIOLA JSB SVIOL RECORD SECURITY VIOLATION JSB OFBRD TURN OFF BOARDS CLA,INA EXIT IN PROPER DIRECTION. LDB FLG GET DIRECTION FLAG SZB REQUEST BEING PROCESSED JMP C.50,I YES. RETURN WITH A=1 AND B=1 JMP $IOUP+1 EXIT VIA $UPIO [$IOUP+1=$UPIO: RTE-C]. * CP1 STB SAVB SAVE REG-B TEMPORARILY CLB NO REQUEST BEING SERVICED SO STB FLG CLEAR THE FLAG WORD. JMP TSMAP * IOUP JSB MAPIT RESTORE MAP IF SWITCHED JMP $IOUP 'UP' THE DEVICE & AWAIT NEXT REQUEST. * * SAVB NOP B-REGISTER TEMPORARY STORAGE. TOSTS NOP DMS STATUS TEMPORARY STORAGE. * SKP * * DISABLE I/O BOARDS * CLC$ NOP CLC1 NOP DISABLE RECEIVE INTERRUPTS. CLC2 NOP DISABLE TRANSMIT INTERRUPTS. JMP CLC$,I * * DISABLE MODEM * OFBRD NOP LDA OFCOD GET CONTROL WORD TO OFF BOARDS OTA1 NOP OUTPUT ON RECEIVE BOARD OTA2 NOP OUTPUT ON TRANSMIT BOARD LDA CLMSK GET MASK=OCT177400 AND EQT5,I CLEAR STANDARD STATUS STA EQT5,I SET UP NEW STATUS CLB STB ABTFG CLEAR ABORT FLAG STB SPTR CLEAR SECURITY CODE POINTER STB EQT15,I PREVENT TIME-OUT ENTRY JMP OFBRD,I RETURN * * CHECK IF SECURITY CODE IS INTACT AND CALLING * PROGRAM IS NOT DORMANT. IF SO, RETURN (P+1) * AND IF NO VIOLATION THEN (P+2). * EXIST NOP LDA SPTR,I GET SEC CODE FROM LIBRARY DVR CPA SECD SECURITY VIOLATED ? JMP *+2 NO JMP EXIST,I YES, RETURN (P+1). LDA STPNT,I GET STATUS WORD OF PROGRAM AND P15 MASK IN STATUS SZA BUMP RETURN IF ISZ EXIST PROGRAM NOT DORMANT. JMP EXIST,I RETURN * * SKP * ** PRIVILEDGED ROUTINE ** * * AN I/O INTERRUPT CAUSES ENTRY HERE. BEFORE ENTRY * INTO #P.50 , THIS ROUTINE CHECKS THE SECURITY * CODE. IF VIOLATED (LIB DVR ABSENT) THEN A 10 MSEC * INTERRUPT TO C.50 IS SET, WHICH WILL CAUSE A PROPER * EXIT FROM THE DRIVER, AFTER RESETTING ITSELF (DEVICE WILL BE SET 'DOWN'). * P.50 NOP PRIVILEGED INTERRUPT ENTRY/EXIT CLF 0 TURN OF ALL INTERRUPTS IMMEDIATELY! MAP6 JMP CLDMA BYPASS DMS STATUS (NOP: SAVE IT) SSM SAVST SAVE DMS STATUS CLDMA CLC 6 TURN OFF CLC 7 DMA INTERRUPTS STA ASV S STB BSV A ERA,ALS V SOC E INA STA EOSV REGISTERS LDA MPTFL SAVE MEMORY STA MPFSV PROTECT FLAG CLA,INA TURN OFF STA MPTFL MEMORY PROTECT FLAG * LDA SYNCM GET THE SYNC-HUNT COMMAND (OR 0). SZA,RSS IF SYNC ALREADY OBTAINED, JMP MAP4 NO NEED TO SUPPLY A NEW REFERENCE; LIB 4 ELSE, GET THE LAST INTERRUPT S.C. CPB SCODE IF LAST INTERRUPT WAS FROM RECV., OTSYN OTA 0 THEN SEND IT A NEW SYNC-REFERENCE. * * SWITCH USER MAPS--IF NECESSARY. * MAP4 JMP INTON BYPASS MAP SWITCH (NOP: SWITCH) LDA BUF2A USA SAVE CURRENT USER MAP * LDA BUF1B USA LOAD RJE/#BSC MAP * UJP INTON ENABLE USER MAP. INTON STF 0 ENABLE INTERRUPTS. JSB EXIST CHECK SECURITY CODE. CCA,RSS VIOLATION OCCURRED JMP PENTR ENTER #P.50 * * SECURITY VIOLATION * JSB CLC$ CLC XX,C ON I/O BOARDS STA ABTFG SET ABORT FLAG FOR C.50 STA EQT15,I SET 10 MSEC ENTRY AT C.50 CLA CLEAR SYNC-HUNT COMMAND. JMP PEXIT SKP * PENTR JSB #P.50,I GO TO #BSC INTERRUPT SECTION * PEXIT CLF 0 STA SYNCM SAVE SYNC-REFERENCE CMD. OR ZERO. MAP5 JMP MPT? BYPASS MAP SWITCH (NOP: SWITCH) SJP *+2 NOW UNDER SYSTEM MAP LDA BUF2B USA RESTORE USER MAP * MPT? LDA MP[;FSV SZA WAS MEMORY PROTECT ON ? JMP E&O NO, FORGET DMA'S LDB INTBA TURN LDA B,I DMA'S SSA BACK STC 6 ON INB IF LDA B,I THEY SSA WERE STC 7 ON. * E&O LDA EOSV RESTORE CLO E SLA,ELA O STO AND LDB BSV B REGISTERS LDA MPFSV RESTORE MEMORY STA MPTFL PROTECT FLAG IN THE SYSTEM MAP7 JMP NODMS FOR DMS, A NOP IS PLACED HERE DURING INIT SZA MEMORY PROTECT ON ? JMP NOSTC NO LDA ASV YES, RESTORE A STF 0 TURN ON INTERRUPTS STC 5 SET MEMORY PROTECT JRS SAVST P.50,I * NOSTC LDA ASV RESTORE A STF 0 TURN ON INTERRUPTS JRS SAVST P.50,I * NODMS SZA JMP NOST1 LDA ASV STF 0 STC 5 JMP P.50,I * NOST1 LDA ASV STF 0 JMP P.50,I * * * SKP * *** DATA / CONSTANTS *** * A EQU 0 B EQU 1 EQT1 EQU 1660B EQT4 EQU 1663B EQT5 EQU 1664B EQT6 EQU 1665B EQT7 EQU 1666B EQT12 EQU 1771B EQT15 EQU 1774B MPTFL EQU 1770B INTBA EQU 1654B EOSV NOP ASV NOP BSV NOP SCODE NOP SYNCM NOP SYNC-HUNT REFERENCE--OR ZERO. STPNT NOP ABTFG NOP SAVST NOP MPFSV NOP EQP15 NOP #I.50 NOP #C.50 NOP #P.50 NOP SPTR NOP FLG NOP CLC CLC 0,C OTA OTA 0 P2 DEC 2 P4 DEC 4 P15 DEC 15 OFCOD OCT 140000 SECD OCT 150003 MTBIT OCT 173777 M3 OCT 3 M3777 OCT 3777 M3703 OCT 3703 M3403 OCT 3403 M3303 OCT 3303 M3003 OCT 3003 CLMSK OCT 177400 MASK OFF LOW 8 BITS BUF1A DEF BUF1,I BUF1B DEF BUF1 BUF2A DEF BUF2,I BUF2B DEF BUF2 BUF3A DEF BUF3,I BUF3B DEF BUF3 * BUF1 BSS 32 MAP FOR RJE/#BSC BUF2 BSS 32 MAP FOR INTERRUPTED USER AREA BUF3 BSS 32 USER-AREA MAP (SAVT NLHED ON TIMEOUT ENTRY) * BSS 0 **** SIZE OF DVR50 **** END MN  91780-18016 1840 S C0122 &#TRAC RJE TRACE MAIN             H0101 /FTN4,L PROGRAM TRACE(19,90),91780-16016 REV 1840 780725 C C **************************************************************** C C NAME: TRACE C SOURCE: 91780-18016 C RELOC: 91780-16016 (PART OF) C PGMR: D. BOLIERE ( 07/24/78 ) C C **************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. 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 TRACE IMPLEMENTS A DIAGNOSTIC CAPABILITY FOR RJE/1000. C C :RU,TRACE [,LU OR NAME:SC:CRN] C C INTEGER AREG,BREG,IREG(2),IBUF(128),IDCB(144) EQUIVALENCE (AREG,REG,IREG(1)),(BREG,IREG(2)) C C INITIALIZE THE CONSOLE PTR AND THE OUTPUT DEVICE TO MAG TAPE C LUC=LOGLU(ISES) LUO=8 C C FETCH PARAMETER STRING. IF NONE, JUST USE DEFAULT DEVICE C CALL GETST(IBUF(11),-80,LOG) IF(LOG.EQ.0) GO TO 40 C C FETCH FIRST PARAMETER. IF NULL, USE DEFAULT. C +NUM, SET LU TO IT C ELSE, TREAT AS FILE NAMR ISTRC=1 IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 40,20 20 IF(IBUF(4).EQ.0) GO TO 40 IF(IBUF(4).NE.1) GO TO 30 IF(IBUF(1).GE.0) LUO=IBUF(1) GO TO 40 C C MUST BE A FILE NAME! TRY TO OPEN. C 30 LUO=-1 CALL OPEN(IDCB,IERR,IBUF,0,IBUF(5),IBUF(6)) IF(IERR.GE.0) GO TO 50 IF(IERR.EQ.-6) GO TO 35 WRITE(LUC,910) IERR GO TO 99 C C FILE NON-EXISTENT! TRY TO CREATE. C 35 CALL CREAT(IDCB,IERR,IBUF,24,3,IBUF(5),IBUF(6)) IF(IERR.GE.0) GO TO 50 WRITE(LUC,920) IERR GO TO 99 C C MUST BE A LU! TRY TO LOCK. C 40 IF(LUO.LE.0) GO TO 50 REG=LURQ(1,LUO,1) IF(AREG.EQ.0) GO TO   50 WRITE(LUC,930) GO TO 99 C C INITIALZE SUBROUTINE BY SETTING OVERRUN COUNT TO POSITIVE. C 50 IOVER=0 C C REQUEST SUBROUTINE TO FILL BUFFER WITH NEXT BLOCK OF DATA. C ICNT=LENGTH OF BLOCK UPON RETURN. IOVER=+ IF LAST BLOCK. C 60 CALL RETRV(IBUF,ICNT,IOVER) IF(ICNT.EQ.0) GO TO 70 IF(LUO.GE.0) GO TO 65 C C OUTPUT DEVICE= FILE! C CALL WRITF(IDCB,IERR,IBUF,ICNT) IF(IERR.GE.0) GO TO 70 WRITE(LUC,940) IERR GO TO 80 C C OUTPUT DEVICE= LU! C 65 IF(LUO.GT.0) CALL REIO(2,LUO,IBUF,ICNT) C C IF DONE, REPORT OVERRUN COUNT. C 70 IF(IOVER.LT.0) GO TO 60 WRITE(LUC,950)IOVER C C IF OUTPUT TO LU, WRITE EOF C IF(LUO.LE.0) GO TO 80 CALL EXEC(3,100B+LUO) C C IF OUTPUT TO FILE, CLOSE IT. C 80 IF(LUO.LT.0) CALL CLOSE(IDCB) 90 CONTINUE 910 FORMAT(" TRACE ABORTED WITH FILE OPEN ERROR ",I4) 920 FORMAT(" TRACE ABORTED WITH FILE CREATE ERROR ",I4) 930 FORMAT(" TRACE ABORTED DUE TO LOGICAL UNIT LOCK FAILURE") 940 FORMAT(" TRACE ABORTED DUE TO FILE WRITE ERROR ",I4) 950 FORMAT(" TRACE COMPLETED WITH",I4," OVERRUN ERRORS") 99 END END$   91780-18017 1940 S C0122 &#TDMP RJE TDUMP MAIN             H0101 +FTN4,L PROGRAM TDUMP(19,90),91780-16017 REV.1940 790528 C C **************************************************************** C C NAME: TDUMP C SOURCE: 91780-18017 C RELOC: 91780-16017 (PART OF) C PGMR: D. BOLIERE ( 07/25/78 ) C L. DIETZ ( 05/28/79 ) C C **************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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 ADD CAPABILITY TO DECODE TRACE INTO ASCII CHARS WHEN C USER SPECIFIED. DEFAULTS TO EBCDIC. ( 05/28/79 ) C C ADD AUTO TOF AT COMPLETION IF OUTPUT DEVICE IS LINEPRINTER C (DRIVER TYPE = 12B). ( 06/08/79 ) C C **************************************************************** C C PROGRAM TDUMP IS USED TO PROVIDE AN OFF-LINE ANALYSIS OF THE TRACE C DATA (EBCDIC/ASCII) RJE/1000 BY THE PROGRAM TRACE. C C RU,TDUMP [,INPUT [,OUTPUT [,LINECT [,LNCODE ] ] ] ] C C WHERE: INPUT AND OUTPUT ARE ANY LU OR LEGAL FILE C NAME IN THE FORMAT NAMR [:SC [:CR ] ]. C C INPUT IS THE LOCATION WHERE THE RAW TRACE DATA CAN BE C FOUND. C C OUTPUT IS THE DESTINATION FOR THE INTERPRETED LISTING. C IF A FILE IS SPECIFIED AND CANNOT BE FOUND, ONE IS C CREATED OF TYPE 3 AND 24 BLOCKS WITH THE OPTIONAL USER C SPECIFIED SECURITY CODE AND CARTRIDGE. C C LINECT IS THE MAXIMUM NUMBER OF LINES OF INFORMATION TO C PRINT AFTER EACH LINE TURNAROUND. C C LNCODE IS THE COMMUNICATION LINE CODE WHICH WAS USED IN C TRANSMISSION DURING TRACE AND FROM WHICH IT WILL BE C * DECODED INTO CHARACTERS. LNCODE IS SPECIFIED AS C EB[CDIC]/AS[CII]. C C DEFAULTS ARE: INPUT=8, OUTPUT=6, LINECT=999, LNCODE=EB C C INTEGER PARAM(5),DATA(2,64),LABL(14),TIME(2),TIM(16) INTEGER IREG(2),AREG,BREG,LBUF(40),LUARY(2),IDCB(144,2) INTEGER DIREC,IBUF(50),TYPE EQUIVALENCE (REG,IREG,AREG), (IREG(2),BREG) EQUIVALENCE (LUARY(1),LUIN), (LUARY(2),LUOUT) DATA TIME/2*0/,LCNT/999/,LUARY/8,6/ DATA LCNTR/0/,DIREC/0/,LNCODE/2HEB/ C C PICK UP CONSOLE LU AND GET USER PARAMETER STRING C LUC=LOGLU(ISES) CALL GETST(IBUF(11),-80,LOG) ISTRC=1 C C DECODE FIRST TWO PARAMETERS THE SAME WAY C DO 40 I=1,2 C C IF NO OR NULL PARAMETERS, USE DEFAULTS C IF(LOG.EQ.0) GO TO 20 IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 20,10 10 IF(IBUF(4).EQ.0) GO TO 20 C C CHECK FOR FILE NAME C IF(IBUF(4).NE.1) GO TO 30 C C IF NUMERIC AND + , USE AS NEW LU # C IF(IBUF(1).GT.0) LUARY(I)=IBUF(1) C C LOCK LU # C 20 REG=LURQ(100001B,LUARY(I),1) IF(AREG.EQ.0) GO TO 40 WRITE(LUC,930) LUARY(I) GO TO 999 C C TRY TO OPEN SPECIFIED FILE C 30 LUARY(I)=-1 CALL OPEN(IDCB(1,I),IERR,IBUF,0,IBUF(5),IBUF(6)) IF(IERR.GE.0) GO TO 40 IF(IERR.EQ.-6.AND.I.NE.1) GO TO 35 WRITE(LUC,910) IERR,(IBUF(J),J=1,3) GO TO 999 C C TRY TO CREATE THE FILE INSTEAD C 35 CALL CREAT(IDCB(1,I),IERR,IBUF,24,3,IBUF(5),IBUF(6)) IF(IERR.GE.0) GO TO 40 WRITE(LUC,920) IERR,(IBUF(J),J=1,3) GO TO 999 C 40 CONTINUE C C DECODE THIRD PARAMETER AS LINE COUNT LIMITATION C 60 IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 80,70 70 IF(IBUF(4).NE.1) GO TO 80 IF(IBUF(1).GE.0) LCNT=IBUF(1) C C DECODE FOURTH PARAMETER AS CHARACTER TRANSMISSION TYPE (EB/AS) C 80 IF(NAMR(IBUF,IBUF(11),LOG,ISTRC)) 100,90 90 IF(IBUF(4).EQ.0) GO TO 100 IF(IBUF(1).EQ.2HEB) GO TO 100 IF(IBUsF(1).EQ.2HAS) GO TO 95 WRITE(LUC,925) GO TO 999 95 LNCODE=2HAS C C INITIALIZATION ALL DONE, NOW START INTERPRETING THE FILE C 100 NREC=0 C C IF INPUT DEVICE IS A LU, READ FROM IT C 110 IF(LUIN.LT.0) GO TO 120 REG=REIO(1,LUIN,DATA,128) LEN=BREG GO TO 130 C C OTHERWISE READ DATA FROM THE FILE SPECIFIED C 120 CALL READF(IDCB(1,1),IERR,DATA(1,1),128,LEN) IF(IERR.GE.0) GO TO 130 WRITE(LUC,940)IERR GO TO 999 C C MUST BE AN EOF: TERMINATE TDUMP C 130 IF(LEN.LE.0) GO TO 790 C C SUCCESSFUL READ, START PROCESSING THE NEXT RECORD. IF ITS THE FIRST C RECORD, DECODE TIME STAMP. C 200 NREC=NREC+1 IPT=1 IF(NREC.NE.1) GO TO 210 CALL TMDA1(TIM,DATA) CALL CODE WRITE(LBUF,800)TIM KCNT=25 GO TO 700 C C PICK UP NEXT PAIR OF DATA ENTRIES C 210 I1=DATA(1,IPT) I2=DATA(2,IPT) C C IF UPPER BYTE OF I2 IS 200B OR 0B, THEN DECODE AS I/O ENTRY C WHICH MEANS I1 IS LOWER TIME STAMP AND LOWER BYTE OF I2 IS DATA BYTE C IF(IAND(I2,77400B).NE.0) GO TO 300 TIME=I1 C C RESET LINE DIRECTION INDICATOR IF WE'VE TURNED AROUND. ONLY C PRINT OUT USER SPECIFIED NUMBER OF LINES AFTER EACH TURNAROUND. C K=0 IF(I2.LT.0) K=1 IF(K.NE.DIREC) LCNTR=0 DIREC=K IF(LCNTR.GE.LCNT) GO TO 720 LCNTR=LCNTR+1 CALL TMVAL(TIME,TIM) C C CONVERT BYTE TO 4 CHARACTER DESCRIPTION C CALL EBC(I2,LNCODE,LABL) C C PRINT OUT AS RECEIVED IF UPPER BYTE OF I2=0 C IF(I2.GE.0) GO TO 250 CALL CODE WRITE(LBUF,810) TIM(4),TIM(3),TIM(2),TIM(1),I2,LABL(1),LABL(2) KCNT=14 GO TO 700 C C PRINT OUT AS SENT IF UPPER BYTE OF I2=200B C 250 CALL CODE WRITE(LBUF,820) TIM(4),TIM(3),TIM(2),TIM(1),I2,LABL(1),LABL(2) KCNT=21 GO TO 700 C C IF UPPER BYTE OF I2=100B, ENTRY IS NEW UPPER TIME STAMP. C 300 IF(IAND(I2,40000B).EQ.0) GO TO 400 TIyME(2)=I1 GO TO 750 C C IF UPPER BYTE OF I2=40B, ENTRY IS OVERRUN INDICATOR C 400 IF(IAND(I2,20000B).EQ.0) GO TO 500 CALL CODE WRITE(LBUF,830) KCNT=18 GO TO 700 C C IF UPPER BYTE OF I2=20B, ENTRY IS NEW I/O REQUEST. ADDITIONALY, C IF THE LOWER BIT OF I2 IS SET, WE'VE ALSO STARTED A NEW TRACE. C 500 IF(IAND(I2,10000B).EQ.0) GO TO 600 IF(IAND(I2,1).EQ.0) GO TO 550 CALL CODE WRITE(LBUF,840) KCNT=37 DATA(2,IPT)=IAND(I2,177776B) IPT=IPT-1 GO TO 700 C 550 CALL CMD(I1,LABL) CALL CODE WRITE(LBUF,850)I1,LABL KCNT=25 GO TO 700 C C IF UPPER BYTE OF I2=10B, ENTRY IS A I/O COMPLETION/STATUS REPORT C 600 IF(IAND(I2,4000B).EQ.0) GO TO 650 CALL CODE WRITE(LBUF,860)I2,I1 KCNT=23 GO TO 700 C C IF WE'VE GOT HERE, ITS AN ENTRY TYPE THAT IS NOT RECOGNIZED, SO C PRINT OUT DECODE ERROR. C 650 CALL CODE WRITE(LBUF,870) KCNT=7 GO TO 700 C C IF LUOUT=-1, WRITE EXPLANATION BUFFER TO DISC FILE C 700 IF(LUOUT.GE.0) GO TO 710 CALL WRITF(IDCB(1,2),IERR,LBUF,KCNT) IF(IERR.GE.0) GO TO 720 WRITE(LUC,950) IERR GO TO 999 C C IF LUOUT>0, WRITE BUFFER TO THAT LU. C 710 CALL REIO(2,LUOUT,LBUF,KCNT) C C IF JUST WROTE HEADER, WRITE SECOND LINE AS WELL C 720 IF(NREC.NE.1.OR.IPT.NE.1) GO TO 750 IPT=3 CALL CODE WRITE(LBUF,880) KCNT=21 GO TO 700 C C IF MORE DATA IN RECORD, REPEAT ANALYSIS BEFORE ACCESSING I/O DEVICE C 750 IPT=IPT+1 IF(IPT*2.LE.LEN) GO TO 210 GO TO 110 C C COMPLETION! C 790 IF(LUIN.LT.0) CALL CLOSE(IDCB(1,1)) IF(LUOUT.LT.0) CALL CLOSE(IDCB(1,2)) WRITE(LUC,890) IF(LUOUT.LT.0) GO TO 999 C C GET EQUIPMENT TYPE CODE OF LUOUT. DO TOF IF TYPE = 12B (LP). C CALL EXEC(13,LUOUT,TYPE) TYPE=IAND(37400B,TYPE)/256 IF(TYPE.EQ.12B) CALL EXEC(3,11B*64+L8UOUT,-2) GO TO 999 C C FORMAT STATEMENTS C 800 FORMAT("1RJE/1000 TRACE OF",16A2) 810 FORMAT(5X,I2,":",I2,":",I2,".",I2,3X,@3,1X,2A2,1X) 820 FORMAT(5X,I2,":",I2,":",I2,".",I2,17X,@3,1X,2A2,1X) 830 FORMAT(" OVERRUN! ",6X,20("*")) 840 FORMAT(" NEW TRACE STARTED ",55("*")) 850 FORMAT(" I/O REQUEST=",@6,3X,14A2) 860 FORMAT(" COMPLETION/ERROR REPORT, STATUS=",@3,4X,@6) 870 FORMAT(" DECODE ERROR!") 880 FORMAT(5X,"HR:MN:SECOND",2X,"SENT",10X,"RECEIVED ") 890 FORMAT(" TDUMP COMPLETED!") 910 FORMAT(" TDUMP ABORTED DUE TO OPEN ERROR",I4," ON FILE ",3A2) 920 FORMAT(" TDUMP ABORTED DUE TO CREATE ERROR",I4," ON FILE ",3A2) 925 FORMAT(" TDUMP ABORTED DUE TO LINECODE PARAMETER ERROR") 930 FORMAT(" TDUMP ABORTED DUE TO LOCK FAILURE ON LU",I4) 940 FORMAT(" TDUMP ABORTED DUE TO FILE READ ERROR",I4) 950 FORMAT(" TDUMP ABORTED DUE TO FILE WRITE ERROR",I4) C 999 END END$ (  91780-18018 1840 S C0122 &#RETV RJE TRACE UTILITY             H0101 $zASMB,R,L,C HED RETRV: RJE TRACE SUPPORT ROUTINE * (C) HEWLETT-PACKARD CO.1978 * NAM RETRV,7 91780-16016 REV.1840 780725 ENT RETRV EXT .ENTR,IFBRK,EXEC EXT #TBUF,#OVRN,#RDPT,#WRPT,#BFEN * * DATE: 780725 * NAME: RETRV * SOURCE: 91780-18018 * RELOC: 91780-16016 (PART OF) * PGMR: D. BOLIERE * * **************************************************************** * * (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. * * **************************************************************** * * THIS SUBROUTINE IS USED BY THE TRACE CAPABILITY OF RJE/1000 TO * RETRIEVE DATA FROM A CIRCULAR SPEED BUFFER LOCATED IN THE * RJE/1000 MODULE CALLED #COMN. THIS DATA IS IN THE FORMAT OF TWO * WORDS PER ENTRY. RETRV COLLECTS THIS DATA AND BLOCKS IT INTO THE * USERS BUFFER. WHEN EITHER THE USERS BUFFER IS FULL, OR WHEN A * OPERATOR BREAK OF THE TRACE PROGRAM IS DETECTED, THE BLOCK OF * DATA IS RETURNED TO THE CALLER. * * FORMAT OF SPEED BUFFER IN #COMN: * * #TFLG NOP 0=TRACE OFF,1=TRACE ON * #TBUF DEF BUF FWA OF SPEED BUFFER * #OVRN NOP NON-ZERO INDICATES THE NUMBER OF OVERRUNS * CAUSED BY THIS RETRV NOT EMPTYING THE SPEED * BUFFER AS FAST AS RJE/1000 FILLS IT. * #RDPT DEF BUF POINTER INTO SPEED BUFFER OF NEXT ENTRY TO * RETRIEVE * #WRPT DEF BUF POINTER INTO SPEED BUFFER OF NEXT ENTRY TO * BE WRITTEN BY RJE/1000. * #BFEN DEF BFEN LAST WORD ADDRESS OF CIRCULAR SPEED BUFFER * BUF BSS 200 TRACE BUFFER LOCATED IN SSGA * BFEN DEF * NEXT WORD PAST BUFFER *  * * CALLING SEQUENCE: * * CALL RETRV (BUF,BUFCT,OVRN) * * WHERE: BUF=USERS BUFFER (AT LEAST 128 WORDS) * BUFCT=LENGTH OF BLOCK OF DATA RETURNED TO CALLER * OVRN= UPON ENTRY: + INDICATES THAT RETRV SHOULD * INITIALIZE ITSELF AND THE * SPEED BUFFER POINTERS * - INDICATES THAT RETRV SHOULD * JUST REFILL THE USERS BUFFER * UPON EXIT: - INDICATES TO CALLER THAT MORE * DATA IS AVAILABLE AFTER THIS * CALL * + INDICATES TO CALLER THE NUMBER * OF OVERRUNS DETECTED AND THAT * A BREAK OF TRACE HAS BEEN * ENTERED BY THE USER. * BUF NOP BUFCT NOP OVRN NOP * RETRV NOP JSB .ENTR PASS PARAMETER ADDRESSES DEF BUF * LDA BUFLN INITIALIZE COUNT TO REPORT TO CALLER STA BUFCT,I ARS DIVIDE BY 2 CMA,INA COMPLEMENT STA CNTR AND INITIALIZE INTERNAL COUNTER LDA BUF STA PTR SETUP INTERNAL BUF POINTER LDB OVRN,I SSB CALL SAYS TO RE-START? JMP START NO, JUST RE-FILL THE BUFFER * ADA D5 YES, SETUP YEAR POINTER STA PTR6 JSB EXEC SAVE SIX WORD TIME STAMP DEF *+4 IN FIRST SIX BUFFER LOCATIONS DEF D11 PTR NOP FWA OF BUFFER PTR6 NOP ADDRESS OF WORD SIX * LDA PTR6 INA STA PTR RESET BUF PTR TO 7TH WORD LDA CNTR ADA D3 STA CNTR BUMP INTERNAL COUNTER * LDA #TBUF STA #RDPT STA #WRPT CLA STA #OVRN STA OVCNT cu * START CCA TELL CALLER THAT LAST RECORD NOT STA OVRN,I YET FOUND * LOOP JSB IFBRK CHECK BREAK STATUS DEF *+1 SSA BREAK? JMP EXIT YEP, GO TELL USER * LDA #RDPT CPA #WRPT POINTERS THE SAME? RSS JMP FETCH NO, MUST BE NEW DATA TO GET! * LDA #OVRN BUFFER OVERRUN? SZA,RSS JMP LOOP NO, REPEAT CHECKS * OVER CLA OVERRUN!!! STA #OVRN CLEAR FLAG ISZ OVCNT BUMP OVERRUN COUNT LDA #WRPT STA #RDPT RESET READ PTR DLD OVCNT CREATE AN OVERRUN ENTRY DST PTR,I SAVE ENTRY SAVE ISZ PTR ISZ PTR ISZ CNTR BUMP COUNTER RSS JMP RETRV,I IF BUFFER FULL, RTN TO CALLER JMP LOOP RETURN FOR CHECKS * FETCH DLD #RDPT,I GET POSSIBLE DATA DST PTR,I SAVE IN TEMP BUFFER LDA #OVRN FETCH OVERRUN FLAG SZA OVERRUN? JMP OVER YEP, FORGET DATA! * ISZ #RDPT NO, BUMP TEMP PTR ISZ #RDPT LDA #RDPT CPA #BFEN AT END OF SPEED BUFFER? LDA #TBUF YES, WRAP-AROUND STA #RDPT JMP SAVE FINISH BOOKKEEPING * EXIT LDA BUF COMPUTE AMOUNT OF DATA IN CMA,INA TEMP BUFFER ADA PTR STA BUFCT,I REPORT PROPER COUNT TO CALLER LDA OVCNT STA OVRN,I REPORT LAST RECORD TO CALLER JMP RETRV,I * * D3 DEC 3 D5 DEC 5 D11 DEC 11 BUFLN DEC 128 CNTR NOP * OVCNT NOP OCT 020000 * *STRBF DEF #BUF END   91780-18019 1840 S C0122 &#TMDA DATE & TIME UTILITY             H0101 ASMB,L,C HED TIME AND DATE TRANSLATION ROUTINE * (C) HEWLETT-PACKARD CO.1978 * NAM TMDA,7,0 91780-16017 REV.1840 780725 ENT TMDA,TMDA1,TMDA2 EXT .ENTR,EXEC,.MVW * * DATE: 780725 * NAME: TMDA * SOURCE: 91780-18019 * RELOC: 91780-16017 (PART OF) * PGMR: GARY E. MODRELL * * **************************************************************** * * (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. * * **************************************************************** * * THIS ROUTINE RETURNS THE DATE IN DAY OF WEEK, MONTH, * DAY OF MONTH, AND YEAR, AND THE TIME IN HOURS, MINUTES, * SECONDS, AND HUNDREDTHS OF SECONDS AS PACKED ASCII * CHARACTERS IN THE PROPER FORMAT. THESE CHARACTERS * ARE RETURNED IN A 16 WORD BUFFER. * * PROPER USE: * DIMENSION IA(16) * CALL TMDA(IA) * WRITE (6,10) IA * 10 FORMAT(16A2) * * FOR EACH CALL TO TMDA, AN EXEC CALL (RCODE=11) IS MADE * THEN THE RETURNED VALUES FOR YEAR, DAY OF YEAR (1,366) * AND TIME ARE TRANSLATED; DAY OF YEAR TO MONTH-DAY, AND * THE NUMERIC DATA TO ASCII CHARACTERS AS SHOWN BELOW. * * ENTRY POINT TMDA1 IS USED TO TRANSLATE A PROVIDED TMVAL * ARRAY RATHER THAN THE SYSTEM TIME. * * PROPER USE: * DIMENSION IA(16),IDAT(6) * CALL TMDA1(IA,IDAT) * WRITE (6,10) IA * 10 FORMAT(16A2) * * FOR EACH CALL TO TMDA1, THE CALLERS VALUE FOR YEAR,DAY * AND TIME ARE TRANSLATED; DAY OF YEAR TO MONTH-DAY, AND * THE NUMERIC DATA TO ASCII CHARACTERS IN THE FOLLOWING FORMAT: * * CONTENTS: MON JAN 01, 1973 16:02:19.53 * WORD # :01020304050607080910111213141516 * * IFr! ERROR IN IDAT ARRAY, DATE " SUN JAN 00, 1900 00:00:00.00" * IS RETURNED. * THE ROUTINE IS NOT PRIVILEDGED SO IT IS RTE-IV COMPATABLE * BFAD NOP BUFFER ADDRESS DAT NOP ADDR OF DATE TO BE TRANSLATED TMDA NOP ENTRY POINT JSB .ENTR DEF BFAD LDA DAT GET 2ND ARG ADDR SZA IS THERE TWO? JMP TMD1 YES, TMDA1 ENTRY JSB EXEC GET TIME OF DAY DEF *+4 DEF D11 DIMS DEF IMS DEF IYR JMP TMD2 TMD1 LDB DIMS A=ADDR OF SOURCE, B=ADDR OF DESTINATION JSB .MVW MOVE THE WORDS DEF D6 6 WORDS NOP CLA STA DAT CLEAR DAT FOR NEXT CALL TMD2 JSB DATE CONVERT DATE SSA CHECK FOR ERROR JMP ERR YES, DO ERROR EXIT BLS GET TABLE ADDRESS ADB DTBL3 DLD B,I GET ASCII DAY OF WEEK DST DW STORE IN PROPER FORMAT LDA MO NUMBER OF MONTH ALS GET TABLE ADDRESS ADA DTBL2 DLD A,I GET ASCII MONTH NAME DST MON STORE IN PROPER POSITION * * NOW CONVERT DAY OF MONTH, YEAR, HOURS, MINUTES, SECONDS * AND HUNDREDTHS OF SECONDS TO ASCII * LDA IMS HUNDREDTHS OF SECONDS JSB ACONV CONVERT TO ASCII STA MS LDA IMN MINUTES JSB ACONV CONVERT TO ASCII STA MN LDA DA DAY OF MONTH JSB ACONV CONVERT TO ASCII STA DAY LDA IYR CLB DIV D100 STB T1 HUNDREDS OF YEARS JSB ACONV CONVERT TO ASCII STA YR LDA T1 TENS & UNIT YEARS JSB ACONV CONVERT TO ASCII STA YR+1 LDA IHR HOURS JSB ACONV CONVERT TO ASCII LDB CNSP GET COLON-SPACE IN B-REG RRR 8 POSITION CHARS DST HR STORE INTO ASCII ARRAY LDA ISC JSB ACONV CONVERT TO ASCII LDB PDCN GET ASCII PERIOD-COLON RRR 8 POSITION CHARS DST SC STORE INTO ASCII ARRAY LDA DBUF ADDR OF SOURCE LDB BFAD ADDR OF DESTINATION JSB .MVW MOVE THE WORDS DEF D16 16 WORDS NOP JMP TMDA,I RETURN * * FOR ERROR RETURN USE JAN 00,1900 00:00:00.00 * ERR CLA ZERO TMVAL ARRAY STA IMS STA ISC STA IMN STA IHR STA IDA STA IYR JMP TMD2 DECODE ERROR VALUES * * CONVERTS BINARY NUMBER IN A-REG (0-99) * TO TWO PACKED ASCII CHARACTERS RETURNED IN A * ACONV NOP CLB PREPARE FOR DIVIDE DIV D10 RESULT A = TENS VALUE, B = UNITS VALUE ALF,ALF POSITION TENS VALUE IOR B MERGE IN UNITS VALUE IOR ASB MERGE IN ASCII BASE VALUE JMP ACONV,I * * DATE CONVERSION ROUTINE * CONVERTS DAY OF YEAR (1-366) TO DAY OF WEEK, * MONTH, DAY OF MONTH, ACCOUNTING FOR ALL LEAP * YEARS. CORRECT FOR ANY DATE AFTER JAN 00,1900 * UNTIL FEB 28,2100 * ON EXIT B-REG CONTAINS # OF DAY OF WEEK (0-6) * DAY ON MONTH IN "DA" (1-31) * MONTH NUMBER IN "MO" (1-12) * IF A-REG = -1 ERROR * DATE NOP CLB STB MO MO=0 LDA IYR GET YEAR ADA MYB SUBTRACT 1900 SSA IF YEAR <= 1900 CLA DEFAULT TO 1900 STA Y0 YEARS AFTER 1900 SZA IF Y0=0 SKIP NEXT STEP ADA M1 MINUS ONE FOR # PREV LP-YR DIV D4 DETERMINE # OF LEAP YEARS STA NLP SAVE # LEAP YEARS PREVIOUSLY CLA CPB D3 YEAR ENTERED A LEAP YEAR? CMA YES, MAKE FEB HAVE 29 DAYS STA LPFLG IF LP-YR, LPFLG=-1 ELSE =0 LDA IDA DAY OF YEAR (1-366) LDB DTBL1 L1 STA DA SUBTRACT DAYS IN EACH MONTH ADA B,I UNTIL DAY COUNT NEG CPB DTB11 IS MONPTH FEB? ADA LPFLG YES, SUBTRACT EXTRA DAY SZA SSA JMP OT1 INB NEXT ADDR IN TABLE ISZ MO MONTH # LEFT IN MO CPB DEND DAY OF MONTH LEFT IN DA JMP ERR1 ERROR IF MORE THAN 366 DAYS JMP L1 OT1 CLE DETERMINE DAY OF WEEK LDA Y0 YEARS AFTER 1900 MPY D365 DAYS AFTER JAN 0,1900 (RES=31 BIT INT) ADA NLP ADD LEAP DAYS SEZ CLE,INB CARRY OVERFLOW BIT ADA IDA ADD DAYS THIS YEAR SEZ INB CARRY OVERFLOW BIT DIV D7 REMAINDER=NUMBER OF DAY OF WEEK (0-6) JMP DATE,I RETURN * ERR1 CCA SET A<0 FOR JMP DATE,I ERROR RETURN SKP * * DECIMAL DATE ENTRY POINT * GIVEN ITIME ARRAY IT(6), THIS ROUTINE EXTRACTS THE JULIAN * DAY OF YEAR [IT(5)], AND THE YEAR [IT(6)], AND RETURNS THE * DAY OF WEEK # (0-6, 0=SUNDAY), THE MONTH # (1-12), AND THE * DAY OF MONTH NUMBER (1-31) AS BINARY NUMBERS. * USE: INTEGER IT(6) * CALL EXEC(11,IT,IT(6)) * CALL TMDA2(IT,IDOW,IMON,IDOM) * IF IT(5)=281 AND IT(6)=1976 THE RETURNED VALUES WOULD BE * IDOW=4, IMON=10, & IDOM=7. * IF ERROR IN GIVEN IT ARRAY, IDOW SET = -1 * * ADAT NOP ADDR OF TIME ARRAY ADOW NOP ADDR FOR RETURN OF DAY OF WEEK AMON NOP ADDR FOR RETURN OF MONTH NUMBER ADOM NOP ADDR FOR RETURN OF DAY OF MONTH NUMBER TMDA2 NOP ENTRY POINT JSB .ENTR GET ARG ADDRESSES DEF ADAT LDA ADAT GET ADDR OF START OF ITIME ARRAY ADA D4 COMPUTE ADDR OF ITIME(5) DLD A,I GET ITIME(5) & ITIME(6) STA IDA STORE JULIAN DAY OF YEAR STB IYR STORE JULIAN YEAR JSB DATE CONVERT DATE SSA CHECK FOR ERROR CCB YES, SET B=-1 STB ADOW,I RETURN DAY OF WEEK NUMBER (0-6) LDA MO V GET MONTH NUMBER INA CONVERT 0-11 TO 1-12 LDB DA GET DAY OF MONTH NUMBER STA AMON,I RETURN MONTH NUMBER STB ADOM,I RETURN DAY OF MONTH JMP TMDA2,I NORMAL RETURN * * CONSTANTS & STORAGE * D3 DEC 3 D4 DEC 4 D6 DEC 6 D7 DEC 7 D10 DEC 10 D11 DEC 11 D16 DEC 16 D100 DEC 100 D365 DEC 365 M1 DEC -1 MYB DEC -1900 -BASE YEAR ASB ASC 1,00 ASCII ZERO-ZERO CNSP ASC 1,: ASCII COLON-SPACE PDCN ASC 1,.: ASCII PERIOD-COLON DA OCT 0 DAY OF MONTH MO OCT 0 MONTH NUMBER (0-11) Y0 OCT 0 YEARS AFTER 1900 NLP OCT 0 # LEAP YEARS AFTER 1900 * 6 WORD ARRAY - DO NOT SEPERATE IMS NOP HUNDREDTHS OF SECONDS ISC NOP SECONDS IMN NOP MINUTES IHR NOP HOURS IDA NOP DAY OF YEAR (1-366) IYR DEC 1900 YEAR (BINARY) * DBUF DEF BUF BUF ASC 1, OUTPUT BUFFER DW ASC 2,SUN MON ASC 2,JAN DAY ASC 1,00 ASC 1,, YR ASC 2,1900 ASC 1, HR ASC 1, 0 ASC 1,0: MN ASC 1,00 SC ASC 1,:0 ASC 1,0. MS ASC 1,00 * DTBL1 DEF TBL1 DAYS IN MONTH TABLE TBL1 DEC -31,-28,-31,-30,-31,-30 DEC -31,-31,-30,-31,-30,-31 DEND DEF TBL1+12 DTB11 DEF TBL1+1 * DTBL2 DEF TBL2 TBL2 ASC 2,JAN MONTH NAME TABLE ASC 2,FEB ASC 2,MAR ASC 2,APR ASC 2,MAY ASC 2,JUN ASC 2,JUL ASC 2,AUG ASC 2,SEP ASC 2,OCT ASC 2,NOV ASC 2,DEC * DTBL3 DEF TBL3 TBL3 ASC 2,SUN ASC 2,MON ASC 2,TUE ASC 2,WED ASC 2,THU ASC 2,FRI ASC 2,SAT * A EQU 0 B EQU 1 T1 EQU Y0 TMDA1 EQU TMDA LPFLG EQU MS LP YR FLAG * LEN EQU * END $"$  91780-18020 1940 S C0122 &#CODE RJE TDUMP UTILITY             H0101 qASMB,R,L,C HED DCODE: RJE TRACE SUPPORT SUBROUTINE * (C) HEWLETT-PACKARD CO.1979 * NAM DCODE,7 91780-16017 REV.1940 790528 ENT CMD,EBC EXT .MVW,.ENTR * * DATE: 780725 * NAME: DCODE * SOURCE: 91780-18020 * RELOC: 91780-16017 (PART OF) * PGMR: D. BOLIERE & B. GUDZ * L. DIETZ ( 05/28/79 ) * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** * * ADD USER SPECIFIED CHARACTER LINE TYPE CAPABILITY OF 'TCHAR'. * ADD TRANSLATION TABLE OF ASCII CODES. ( 05/28/79 ) * * **************************************************************** * * THIS DCODE SUBROUTINE WAS WRITTEN FOR USE WITH THE TRACE CAPABILITY * OF RJE/1000. IT CONTAINS TWO ENTRY POINTS: * * CALL CMD(ICMD,LABEL) TO INTERPRET AN OCTAL COMMAND WORD 'ICMD' * FOR RJE/1000 INTO A 14 WORD ASCII DESCRIPTION WHICH IS PLACED * INTO THE USERS BUFFER IDENTIFIED BY 'LABEL'. * * CALL EBC(IEBC,TCHAR,CODE) TO TRANSLATE AN OCTAL CHARACTER CODE * LOCATED IN 'IEBC' INTO AN EBCDIC OR ASCII CHARACTER (AS SPECIFIED * BY 'TCHAR') TO BE PLACED INTO 'CODE'. * ICMD NOP LABEL NOP CMD NOP JSB .ENTR PASS PARAMETER ADDRESSES DEF ICMD * LDB CWTBL SET B-REG TO FWA OF CONTROL WORD TABLE LDA ICMD,I AND M3777 FETCH COMMAND TO DECODE * SCH CPA 1,I COMPARE AGAINST NEXT TABLE ENTRY JMP GOTIT FOUND A MATCH!! INB BUMP TABLE POINTER INB CPB LSTEN END OF TABLE? RSS YES, USE ERROR MESSAGE THEN JMP SCH NO, CONTINUE SEARCH * GOTIT INB MOVE 14 LDA 1,I WORD ASCII LDB LABEL DESCRIPTION JSB .MVW TO THE DEF D14 USERS BUFFER NOP JMP CMD,I RETURN TO CALLER * * M3777 OCT 3777 D14 DEC 14 * CWTBL DEF *+1 TABLE OF LEGAL CONTROL WORDS MESSAGE POINTERS OCT 3703 DEF INITL OCT 3603 DEF OFF OCT 3503 DEF RC2SD OCT 3403 DEF HNDSK OCT 3303 DEF ANSWR OCT 3203 DEF SEOF OCT 3103 DEF SD2RC OCT 2703 DEF LSN20 OCT 3702 DEF SEND OCT 3701 DEF SENDC OCT 3601 DEF READ1 OCT 3501 DEF READ2 OCT 3401 DEF READ3 OCT 3301 DEF READ4 LSTEN DEF * DEF ENMES * SUP INITL ASC 14,INITIALIZE DRIVER OFF ASC 14,DISCONNECT RC2SD ASC 14,BID FOR LINE HNDSK ASC 14,ESTABLISH MODEM CONNECTION ANSWR ASC 14,AUTO-ANSWER SEOF ASC 14,SEND EOT SD2RC ASC 14,LISTEN TO LINE FOR LONG T.O. LSN20 ASC 14,LISTEN TO LINE FOR 20 SECS SEND ASC 14,WRITE SENDC ASC 14,WRITE-CONVERSATIONAL READ1 ASC 14,READ (SEND RVI) READ2 ASC 14,READ (CONVERSATIONAL) READ3 ASC 14,READ(SEND NAK) READ4 ASC 14,READ(SEND ACK 0/1) ENMES ASC 14,ILLEGAL FUNCTION * * IEBC NOP TCHAR NOP CODE NOP EBC NOP JSB .ENTR PASS PARAMETER ADDRESSES DEF IEBC * LDA IEBC,I FETCH USER SPECIFIED CHARACTER ALR AND MULTIPLY BY TWO LDB TCHAR,I FETCH USER SPECIFIED CHAR LINE TYPE CPB =AEB LINECODE TYPE IS EB[CDIC]? JMP GETEB TCHAR = EB[CDIC] AND =B177377 STRIP PARITY ADA ASTBL INDEX INTO ASCII TABLE RSS GETEB ADA EBTBL INDEX INTO EBCDIC TABLE DLD 0,I AND FETCH CHARACTER DST CODE,I SAVE IN USER BUFFER JMP EBC,I AND RETURN * SUP * EBTBL DEF *+1 TABLE OF LEGAL EBCDIC CODES ASC 16,NULL SOH STX ETX PF  HT LC DEL --> 7 ASC 16, XXX RLF SMM VT FF CR SO SI --> 17 ASC 16, DLE DC1 DC2 DC3 RES NL BS IL --> 27 ASC 16, CAN EM CC XXX IFS IGS IRS IUS --> 37 ASC 16, DS SOS FS XXX BYP LF ETB ESC --> 47 ASC 16, XXX XXX SM XXX XXX ENQ ACK BEL --> 57 ASC 16, XXX XXX SYN XXX PN RS UC EOT --> 67 ASC 16, XXX XXX XXX XXX DC4 NAK XXX SUB --> 77 ASC 16, XXX XXX XXX XXX XXX XXX XXX -->107 ASC 16, XXX XXXCENT . < ( + OR -->117 ASC 16, & XXX XXX XXX XXX XXX XXX XXX -->127 ASC 16, XXX XXX ! $ * ) ; NOT -->137 ASC 16, - / XXX XXX XXX XXX XXX XXX -->147 ASC 16, XXX XXX BAR , % - > ? -->157 ASC 16, XXX XXX XXX XXX XXX XXX XXX XXX -->167 ASC 16, XXX \ : # @ ' = " -->177 ASC 16, XXX 'A 'B 'C 'D 'E 'F 'G -->207 ASC 16, 'H 'I XXX XXX XXX XXX XXX XXX -->217 ASC 16, XXX 'J 'K 'L 'M 'N 'O 'P -->227 ASC 16, 'Q 'R XXX XXX XXX XXX XXX XXX -->237 ASC 16, XXXTILD 'S 'T 'U 'V 'W 'X -->247 ASC 16, 'Y 'Z XXX XXX XXX XXX XXX XXX -->257 ASC 16, XXX XXX XXX XXX XXX XXX XXX XXX -->267 ASC 16, XXX XXX XXX XXX XXX XXX XXX XXX -->277 ASC 16,LBRA A B C D E F G -->307 ASC 16, H I XXX XXX XXX XXX XXX XXX -->317 ASC 16,RBRA J K L M N O P -->327 ASC 16, Q R XXX XXX XXX XXX XXX XXX -->337 ASC 16, / XXX S T U V W X -->347 ASC 16, Y Z XXX XXX XXX XXX XXX XXX -->357 ASC 16, 0 1 2 3 4 5 6 7 -->367 ASC 16, 8 9 XXX XXX XXX XXX XXX XXX -->377 * SUP * ASTBL DEF *+1 TABLE OF LEGAL ASCII CODES (STRIP PARITY) ASC 16,NULL SOH STX ETX EOT ENQ ACK BEL --> 7 ASC 16, BS HT LF VT FF CR SO SI --> 17 ASC 16, DLE DC1 DC2 DC3 DC4 NAK SYN ETB --> 27 ASC 16, CAN EM SUB ESC FS GS RS US --> 37 ASC 16, ! " # $ % & ' --;> 47 ASC 16, ( ) * + , - . / --> 57 ASC 16, 0 1 2 3 4 5 6 7 --> 67 ASC 16, 8 9 : ; < = > ? --> 77 ASC 16, @ A B C D E F G -->107 ASC 16, H I J K L M N O -->117 ASC 16, P Q R S T U V W -->127 ASC 16, X Y Z [ \ ] NOT - -->137 ASC 16, \ 'A 'B 'C 'D 'E 'F 'G -->147 ASC 16, 'H 'I 'J 'K 'L 'M 'N 'O -->157 ASC 16, 'P 'Q 'R 'S 'T 'U 'V 'W -->167 ASC 16, 'X 'Y 'ZLBRA BARRBRATILD DEL -->177 * END '  92000-18001 A S C0122 AUTO RESTART PROGRAM AUTOR             H0101 ASMB,R,L,C,B HED AUTO RESTART PROGRAM ** A-92000-16001-1 * NAME: AUTOR * SOURCE: 92000-18001 * RELOC: 92000-16001 * DATE: 750527 * * ******************************************************* ********** * * THIS PROGRAM CONTAINS INFORMATION WHICH IS PROPRIETARY TO * * * THE HEWLETT-PACKARD COMPANY. IT IS NOT TO BE DISCLOSED TO * * * ANY THIRD PARTIES OR REPRODUCED EXCEPT FOR ARCHIVE PURPOSES * * ******************************* ********************************** NAM AUTOR,1,1 92000-16001 750527 ENT AUTOR 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 S TATUS 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* 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 DIVID E 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 TI ME+2 FETCH DAY AND YEAR CLB DIV D365 GET YEAR CCE,INA 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 *+4 ERROR RETURN POINT DEF ICODE REQUEST CODE DEF LU LU# FOR STATUS TEST DEF EQT5 BUF LOCATION 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 BAD LD A 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 * * * * PRINT POWER FAIL MESSAGE * ON DVR00 DEVICE FOUND IN SCAN ROUTINE * * * * * PRINT JSB EXEC DEF *+5 RETURN DEF .2 WRITE COMMAND DEF LU LU# OF DEVICE DEF MESS P/F ME SSAGE 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 ONE S 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 F AILURE. * * 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 0200 60 ASCII OCT 030060 EMASK OCT 37400 .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,: BU F3 NOP ASC 1,: BUF4 NOP ASC 4,: 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 EQ U 1 N4 OCT -4 END AUTOR j  92000-18002 A S C0122 MEMORY ALLOCATION $ALC             H0101 }ASMB,R,L,C,B HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * A-92000-16002-1 * NAME: $ALC * SOURCE: 92000-18002 * RELOC: 92000-16002 * 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 $ALC,0 92000-16002 750327 * ENT $ALC,$RTN EXT $LIST,$WORK * * PROGRAMMER: G.A. ANZINGER HP AMD 1 MAY 70 BCS * 24 JUN 74 RTE * 26 MAR 75 RTE-B * * 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 * k* BLOCKS OF MEMO RY 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 EN D 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 RE QUEST 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 S EGMENT 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 eSETA RETURN TO USER * .A4 LDA B, I ALLOCATE ENTIRE BLOCK. STA ADX 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 AD DRESS 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 ST B 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 ADDRELSS 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 RETUR N 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 AD X 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 C ODE 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 o  92000-80003 B S 0422 REAL TIME (RTC) EXEC CONT.             H0104 ASMB,R,F,B,C,L HED * REAL TIME (RTC) EXEC. CONTROL A-92000-60003-2 REV. B * NAME: RTC * LISTING: A-92000-60003-2 * SOURCE: 92000-80003 * RELOC: 92000-60003 * * ********************************** ****************************** * * THIS PROGRAM CONTAINS INFORMATION WHICH IS PROPRIETARY TO * * * THE HEWLETT-PACKARD COMPANY. IT IS NOT TO BE DISCLOSED TO * * * ANY THIRD PARTIES OR REPRODUCED EXCEPT FOR ARCHIVE PURPOSES * * ********** ****************************************************** NAM RTC,7 92000-60003 750404 REV.B SUP * * * * * ENTRY POINTS FOR SYSTEM * * * ENT $LIST,$XCIC,$CIC,$STRT,EXEC,$TIME ENT $LIBX,$LIBR,.OPSY ENT $T MP1,$TMP2,$TMP3,$TMP4,$TMPW ENT $ER04,$XEQ,$RXIT,$IOER,$WRD2 ENT $L.13,$L.51,$L.55,$R02,$L.10 ENT $CVEQ,$SCLK,$UPIO ENT $PWR5,$MESS,$WORK ENT $L.16,$L.56,$R06 * EXT $ALC,$RTN * * * ***** < EXEC > PR OGRAM 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 BY THE USERS PROGRAM. * * SYSTEM REQUEST FORMAT: * ---------------------- * * THE GENERAL FORMAT OF A SYSTEM REQUEST IS * A BLOCK CONTAINING AN EXECUTABLE INSTRUCTION * TO GAIN ENTRY TO THE EXECUTIVE AN D 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 * 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 * -- ERROR RETURN IF NEGATIVE RCODE * -- NORMAL RETURN * - EXIT POINT - * * RCODE DEC N * P1 DEC/OCT/DEF,ETC TO DEFINE A VLAUE * * * SKP * EXEC NOP CLF 0 LDB EXEC * ANALYZE SYSTEM REQUEST * LDA B,I GET EXIT ADDRESS, ADB N1 STB XSUSP,I SAVE SUSPEND LOCATION INB STA RQRTN SAVE IN BASE PAGE STB TEMP1 SAVE REQUEST WORD 2 ADDRESS. CMB,INB SUBTRACT WORD 2 ADDRESS FROM ADA B EXIT ADDRESS. ADA N2 STA RQCNT AND SAVE # OF ACTUAL PARAMETERS. STA B * ADA N9 IS GREATER SSA,RSS THAN JMP RQERR 8. * LDA RQP1A SET (TEMP2) = STA TEMP2 ADDRESS OF RQP1 IN B.P. CMB ISZ TEMP1 SET (TEMP1) = ADDR OF WORD 4 R1 JSB EFFAD GET EFFECTIVE ADDRESS STA TEMP2,I SET IN B.P. ISZ TEMP2 INDEX ISZ TEMP1 ADDRESSES AND INB,SZB PARAMETER COUNT. JMP R1 - CONTINUE - SKP * * CHECK LEGALITY OF REQUEST CODE * LDA RQP1,I GET REQUEST CODE LDB XEQT GET ID SEG A DDR ADB .15 COMPUTE STATUS WORD ADDRESS STB TEMP1 AND SAVE LDB B,I GET STATUS WORD RAL,CLE,ERA PUT aBORT OPTION IB (E) RBL,ERB PUT ABORT OPTION STB TEMP1,I IN STATUS WORD SSB IF ABORT OPTION SET ISZ RQRTN THEN INCREMENT RETURN STA RQP1 SAVE REQUEST CODE SZA,RSS ERROR IF JMP RQERR ZERO CMA,INA SSA,RSS JMP :RQERR SUBTRACT FROM # ADA .3 SSA,RSS JMP R3 CPA N10 R3 JMP IOREQ IF REQ=1,2,3,6 OR 13 ITS OK CPA N3 IS THIS EXEC(6)/COMPLETION REQUEST JMP PCOMP YES! JMP RQERR * * SUBROUTINE , COMPUTE EFFECTIVE ADDRESS * EFFAD NOP LDA TEMP1,I GET ADDRESS SZA,RSS ERROR IF JMP RQERR ADDRESS = CPA .1 0 OR 1 JMP RQERR (A OR B REGISTERS) RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR RSS -INDIREC T- JMP EFFAD,I RETURN WITH (A) = ADDRESS. LDA A,I GET NEXT ADDRESS IN INDIRECT JMP EFFAD+2 CHAIN AND PROCESS. SPC 1 .3 DEC 3 N1 DEC -1 N2 DEC -2 N9 DEC -9 RQP1A DEF RQP1 * * * PROGRAM COMPL ETION REQUEST * * ALL PARAMETERS OTHER THAN REQUEST CODE=6 * ARE IGNORED. PROGRAM IS PUT IN DORMANT LIST * * PCOMP LDA XEQT ID SEG ADDR OF CURRENT PROGRAM STA *+3 JSB $LIST DORMANT REQUEST OCT 100 DEF * JMP $XEQ * HED SIMULATED $LIBR AND $LIBX SUBR. A-92000-60003-2 REV. B * *CALLING SEQUENCES: ENTRY TERMINATION * *PRIVILEGED: JSB $LIBR JSB $LIBX * NOP DEF (PROGRA M ENTRY PT) * *RE-ENTRANT: JSB $LIBR JSB $LIBX * DEF TDB DEF TDB * DEC 0 OR 1 * * BASIC ASSUMPTION: PRIVILEGED ROUTINES MAY NO CALL * RE-ENTRANT ROU TINES * * $LIBR NOP CLF 0 OFF THE INTERRUPTS STA TEMPA SAVE A LDA $LIBR,I ISZ $LIBR SET RETURN ADDRESS SZA NOP(PRIV) OR DEF TDB(RE-ENT) JMP RENT R RE-ENTRANT ISZ PRIV ADD ONE TO PRIV FLAG JMP EXITR EXIT RENTR ADA .2 A=DEF TDB+2=RETURN ADDRESS STB -TEMPB SAVE B ERB STB TEMPE SAVE E LDB $LIBR ADB N3 B=WORD BEFOR "JSB $LIBR" * =RETURN ADDRESS LDB B,I LOAD RETURN ADDRESS STB A,I AND STORE IN TDB+2 LDB TEMPE ELB RESTORE E LDB TEMPB RESTORE B EXITR LDA TEMPA RESTORE A JMP $LIBR,I RETURN * $LIBX NOP STA TEMPA SAVE A STB TEMPB SAVE B ERB STB TEMPE SAVE E LDA $LIBX,I LDB PRIV IF PRIV = 0? SZB,RSS JMP RENTX THIS IS A RE-ENTRANT ROUTINE ADB N1 ELSE PRIVILEGED STB PRIV SET PRIV=PRIV-1 LDA A,I A=RETURN ADDRESS JMP EXITX EXIT RENTX ADA .2 A=DEF TDB+2 LDA A,I A=ADDRESS IN TDB+2 ISZ $LIBX $LIBX POINTS TO DEC 0 OR 1 ADA $LIBX,I ADD O OR 2 TO RETURN ADDRESS EXITX STA $LIBX CLA CPA PRIV LDA STFO STA STFX LDA TEMPA RESTORE A LDB TEMPE ELB RESTORE E LDB TEMPB RESTORE B STFX NOP JMP $LIBX,I RETURN * PRIV OCT 0 STFO STF 0 * * HED SYSTEM ABORT SECTION A-92000-60003-2 REV. B * * * ROUTINE: < ABORT > * * 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 THEN RESTARTED. * * CALL: (P) JMP ABORT * (P+1) DOES NOT RETURN * ABORT JSB IOCL CLEAR I/O DEVICE QUEUE JSB $LIST REMOVE PROGRAM FROM SCHEDULE LIST  OCT 100 ABP NOP RSTRT JSB $LIST RESCEDULE BASIC OCT 101 BASA NOP JMP $XEQ * RS1 OCT 25000 RESET VALUE FOR TIME RS2 OCT 177574 $TIME OCT 25000 TIME OF DAY IN NEG 10S OF MS OCT 177574 OCT 33633 DAY 000 YEAR 197X .2 OCT 2 * * HED REAL TIME CLOCK PROCESSOR A-92000-60003-2 REV. B ******************************************************************** * THE REAL TIME CLOCK PROCESSOR SECTION OF HP-2100 REAL TIME* * EXECUTIVE HANDLES ALL TIME DEPENDENT FUNCTIONS: * * 1. INCREMEN T REAL TIME CLOCK VALUES EVERY 10 MILLISECOND. * * 2. RESTARTS THE REAL TIME CLOCK AFTER POWER FAILURES. * ******************************************************************** ** ** THE $SCLK ROUTINE IS CONFIGURED IN THE STARTUP ROUTINE A ND * ** IS CALLED BY THE POWER FAIL ROUTINE. * ** ONCE ENTERED, $SCLK RESTARTS THE SYSTEM CLOCK AND EXITS * ** BACK TO THE POWER FAIL DRIVER. * * * $SCLK NOP LDA .2 SETUP TIME BASE OTATB OTA 0 CONFIGURED TO STC TBG STCTB OCT 1100 CONFIGURED TO STC TBG,C STFTB OCT 1600 CONFIGURED TO STF TBG JMP $SCLK,I EXIT * * * * * 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 100MS * * THE TIME-OUT CLOCKS F OR ALL ACTIVE DEVICES ARE * UPDATED. IF ANY DEVICE HAS TIMED-OUT, * RTIOC IS ENTERED TO PROCESS THE CONDITION. * * * $CLCK ISZ $TIME INCREMENT TIME BY 10MS JMP IOTOP ISZ $TIME+1 JMP IOTOP LDA RS1 RESET THE COUNTER LDB RS2 TO THE FULL DAYS WORTH STA $TIME OF TENS OF MS. STB $TIME+1 * * PROCESS DEVICE TIME-OUT CLOCKS * IO TOP LDA EQT# SET NEGATIVE OF CMA,INA NUMBER OF EQT STA TEMP ENTRIES FOR INDEX LDA EQTA POINT TO WORD 15 IOTO2 ADA .14 OF 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 TEMP THRU? JMP IOTO2 NO: GO DO NEXT ONE * * * * * * * SKP HED ** R EAL TIME SYSTEM SCHEDULER ** A-92000-60003-2 REV. B * * THE $XEQ SECTION OF THE HP-2100 REAL TIME EXECUTIVE * * PERFORMS THE FOLLOWING FUNCTIONS: * * 1. IDLE LOOP WHEN NO PROGRAMS ARE SCHEDULED OR CA NNOT BE * * EXECUTED. * * * CALLING SEQUENCE * JMP $XEQ * $XEQ LDA SKEDD GET ID SEQ ADDRESS 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 P ROGRAM * * CURRENTLY EXECUTING. * * STORE ADDRESS OF 4 DUMMY WORDS INTO XSUSP-XSUSP+3 * * DUE TO I/O PROCESSING. * * TURN INTERRUPT SYSTEM BACK ON * * JUMP TO * * * * LDA N4 SET XSUSP TO XSUSP+3 TO ADDR STA TMP OF FOU R DUMMY WORDS LDB DSUSP ADDRESS OF XSUSP LDA VSUSP ADDRESS OF IDLE DUMMY WORDS STA B,I IN6A INB ISZ TMP JMP *-4 CLA STA XEQT CLEAR XEQT ADDRESS VALUE STF 0 TURN ON INTERRUPTS JMP * IDLE LOOP XQDEF DEF XEQT XEQT TABLE ADDRESS DSUSP DEF XSUSP ADDRESS OF XEQT SUSPEND VALUE VSUSP DEF *+1 ADDRESS OF IDLE DUMMY WORDS BSS 4 DUMMY XEQT IDLE WORDS * * THE SWITCHING SEC TION USES THE SCHEDULE LIST TO DETERMINE * * WHICH PROGRAM TO EXECUTE-STARTING FROM TOP OF LIST. * * IF PROGRAM FROM LIST OF LOWER PRIORITY, THEN * * EXECUTION OF CURRENT PROGRAM CONINUES. * * IF PROGRAM FROM LIST OF HIGHER PRIORITY * * EXECUTION SWITCHING TAKES PLACE.* * X0010 STA ZWORK SCHED LIST PROG ID SEG ADDR ADA .6 STA ZPRIO PRIORITY ADDRESS LDA XEQT IS PR OGRAM CURRENTLY EXECUTING SZA,RSS YES! JMP X0040 NO, SO EXECUTE IT LDA XPRIO,I IS CURRENT PRIO=NEW PRIO CMA,INA ADA ZPRIO,I SZA,RSS NO! JMP X0020 YES,CONTINUE EXISTING PROG SSA IS NEW PROG HIGHER PRIO JMP X0040 YES! X0020 LDA XSUSP,I CONTINUE AT PT OF SUSPENSION X0025 STA TEMP RETURN ADDRESS STORED * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM LDA XEO,I RESTORE CLO E, SLA,ELA OVERFLOW STF 1 LDA XA,I A AND LDB XB,I B REGISTERS STF 0 TURN ON INTERRUPTS JMP TEMP,I GO TO EXECUTE PROGRAM * * * * * LOAD PROGRAM ID SEGMEN T ADDRESSES INTO XEQT AREA X0040 LDA N12 LOAD PROGRAM TO BE EXECUTED STA TMP INTO XEQT AREA LDA XQDEF LDB ZWORK STB 0,I INA STB 0,I INB ISZ TMP JMP *-4 LDA XSUSP,I C HECK IF PROGRAM SUSPENDED SZA,RSS NO, SO START AT PRIMARY ENTRY LDA XPENT,I SET TO PRIMARY START ADDRESS JMP X0025 GO TO SET FENCE,REGISTERS AND XEQ * * * LLIST DEF DORMT TOP OF LIST ADDRESSES * .14 DEC 14 .15 DEC 15 N12 DEC -12 * HED RTE SCHED.LIST PROCESSOR SECTION A-92000-60003-2 REV. B * * THE $LIST PROCESSOR SECTION OF THE HP-2100 REAL TIME * * EXECUTIVE PROCESSES THE FOLLOWING LIST REQUESTS * * 1. D ORMANT * * 2. SCHEDULE * * 3. OPERATOR SUSPEND * * 4. NON-OPERATOR SUSPEND * * A. I/O * * B. MEMORY AVAILABLE * * * * CALLING SEQUENCE * * * JSB $LIST * * OCT (ADDRESS CODE)(FUNCTION CODE) * DEF (ADDRESS) * * WHERE * FUNCTION CODE * 0 = DORMANT REQUEST * 1 = SCHEDULE REQUEST * 2 = I/O SUSPEND REQUEST * 3 = *****NOT CURRENTLY USED***** * 4 = MEMORY AVAILABEL 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 * 3 = NOT USED * 4 = ID SEGMENT ADDRESS IN (B) * * * ADDRESS * 1 = ID SEGMENT ADDRESS * 2 = ASCII PROGRAM NAME ADDRESS * * :THIS WORD MUS T NOT BE SUPPLIED * FOR ADDRESS CODE = 4 * SKUP $LIST NOP ENTRY/EXIT LDA $LIST,I WORD 1 AND .15 STA $WORK SAVE REQUEST CODE XOR $LIST,I FORM ALF,ALF A DDRESS RAL,RAL CODE CPA .4 SEG. ADDR. IN B-REG.?? JMP XXXX YES, GO PROCESS REQUEST ISZ $LIST STEP TO ADDRESS WORD LDB $LIST,I GET IT TO B CPA .1 DEF TO SEG. JM P XXXX ADDRESS IN B-REG?? * JSB TNAME ADDRESS OF ASCII NAME IN B SZA,RSS ID SEG.ADDR. FOUND??? JMP $LIST,I NO. THIS IS AN ERROR RETURN * * XXXX STB WORK STB WLINK LINKAGE ADDRESS ADB .6 STB WPRIO PRIORITY ADDRESS ADB .2 STB WSUSP ADB .7 STB WSTAT STATUS ADDRESS LDA WSTAT,I GET OLD STATUS LDB $WORK GET REQUEST CODE FROM TEMP STORAGE STB WSTAT,I SET NEW STATUS AND .1 5 RRR 16 SWAP REGISTERS HED LINK UPDATE PROCESSOR A-92000-60003-2 REV. B * * 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. * * * * * * WHERE * B = CODE OF REMOVAL LIST * A = CODE OF INSERTION LIST * THE ID SEGMENT IS ASSUM ED TO BE LOCATED IN WORK * AND WLINK AND WPRIO SET * * * * THE REMOVAL OF PROGRAM FROM A LIST CONSISTS OF: * * 1. IF I/O LIST (CODE 2), THEN T HIS IS SPECIAL CASE * * AND DOES NOT REQUI ^RE REMOVAL. * * 2. IF NULL LIST, THEN ERROR EXIT TAKEN. * * 3. IF FIRST AND ONLY PROGRAM IN LIST, THEN LIST * * VALU E 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. * * SZB REMOVAL CODE IN B IGNORE DORMANT CPB .2 I/O LISj REQ UESTS 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 WLINK,I UPDATE LINKAGE TO BYPASS STB TEMP,I THE DELETED ID SEG HED LINK PROC.-ADD PROGRAM TO A LIST A-92000-60003-2 REV. B * * 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 I NSERTED INTO * * LI0ST ACCORDING TO PRIORITY LEVEL AND LINKAGES * * CHANGED TO REFLECT THIS INSERTION. * * 4. IF OF LOWER PRIOR. THAN ANY PROGRAM IN LIST, THEN* * LAST LINKA GE IS SET TO POINT TO THE PROGRAM TO * * BE ADDED AND THE PROGRAM LINKAGE IS CLEARED. * * LK100 SZA,RSS TEST FOR DORMANT REQUEST JMP CLRID CLEAR ID SEG PT OF SUSPENSION CPA .2 I/O LIST REQUESTS JMP LK150 YES, RETURN LK101 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 .6 OF WORK ID SEG LDB B,I AGAINST CMB,INB CURRENT ADB WPRIO,I ID SEG SS B,RSS WORK < CURRENT? JMP LK110 NO, SEE NEXT ONE * LK140 STA WLINK,I LINK THIS TO FOLLOW WORK LDA WORK LINK WORK TO FOLLOW STA TEMP,I PREVIOUS PROG * LK150 ISZ $LIST INCRE RETURN ADDR * CLA *FORCE XEQT RE-LOAD* STA XEQT CLEAR CURRENTLY " EXECUTING" POINTER * JMP $LIST,I FOR RETURN * * * CLEAR PROGRAM ID SEG FOR RESTART * * CLRID STA OPFLG CLEAR OPERATOR FLAG STA WSUSP,I CLEAR SUSPENSION P OINT STA XEQT JMP LK150 * .6 OCT 6 * HED PROGRAM ID SEARCH ROUTINE A-92000-60003-2 REV. B ********************************************************************* ****************PROGRAM ID SEARCH ROUTINE************* *************** * * * * * * * ON ENTRY  * * (B)=ADDRESS OF ASCII PROGRAM NAME * * * * ON RETURN * * IF ID SEGMENT FOUND. * * (B)=ADDRESS OF REQUESTED SEGMENT * * (E)=0 * * * * IF ID SEGMENT NOT FOUND. * * (A)=0 * * (E)=1 * * * ********************************************************************* * TNAME NOP ENTRY EXIT CCE SET E FOR ERROR RETURN STB TMP10 ADDRESS OF NAME CHAR 1&2 INB INCREMENT ADDRESS POINTER STB TMP11 ADDRESS OF NAME CHAR 3&4 INB INCREMENT ADDRESS POINTER LDA B,I FETCH CHAR 5&X AND MASKU (OCT 177400) AND OFF X STA TMP5. SAVE CHARACTER 5 SZA LDA KEYWD FETCH TOP OF KEYWORD LIST STA KEY SET FOR SEARCH * * TN005 LDA KEY,I CHECK TOP OF LIST SZA,RSS IF END JMP TNAME,I ERROR RETURN ADA .12 INCREMENT TO NAME CHAR 1&2 LDB A,I FETCH ASCII NAME CHAR 1&2 CPB TMP10,I COMPARE WITH REQUESTED CHAR 1&2 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG. LDB A,I FETCH CHAR 3&4 CPB TMP1 1,I COMPARE WITH REQUESTED CHAR 3&4 INA,RSS COMPARES JMP TN030 DOES NOT COMPARE-GO TO NEXT PROG LDA A,I FETCH CHAR 5 AND MASKU MASK OFF EXTRA CHAR CPA TMP5. COMPARE WITH REQUESTED CHAR 5  JMP TN040 COMPARES * * TN030 ISZ KEY INCREMENT TO NEXT ID SEGMENT JMP TN005 GO COMPARE NEXT PROGRAM * * TN040 LDB KEY,I PLACE ID SEGMENT ADDRESS IN B CLE CLEAR E FOR NORMAL RETURN JMP TNAME,I EXIT * * MASKU OCT 177400 .12 DEC 12 HED MESSAGE PROCESSOR SIMULATOR ROUTINE A-92000-60003-2 REV. B *************************************************************** *************************************************************** * THE MESSAGE PROCESSOR ROUTINE PROVIDES * * COMPATABILITY FOR THE POWER-FAIL DRIVER. * * THEREFORE,$MESS CAN ONLY BE CALLED BY * * DVP43. THE CALL IS THEN MAPPED INTO A CALL * * TO $LIST(TO ABORT AUTOR) . * * PRIOR TO CALLING $LIST, A SEARCH OF ID. * * SEGMENTS IS PERFORMED(VIA A CALL TO TNAME). * * IF AUTOR IS NOT FOUND,A 1 IS RETURNE D TO * * DVP43 IN THE A-REGESTER. IF AUTOR IS FOUND, $LIST * * IS CALLED AND AUTOR IS ABORTED.RETURN IS TO $XEQ. * *************************************************************** ************************************************ *************** $MESS NOP ADA .2 POSITION POINTER TO RRR 16 ASCII NAME(AUTOR) JSB TNAME SEARCH ID SEGMENTS * SEZ,INA AUTOR NOT FOUND JMP $MESS,I RETURN TO P/F ROUTINE * JSB $LIS T ABORT AUTOR OCT 400 ID SEG ADDR. IN B JMP $XEQ EXIT HED SYSTEM START UP A-92000-60003-2 REV. B ******************************************************************** * THE START SECTION: * * CLEARS INTERRUPT SYSTEM. * * SETS THE FENCE REGISTER TO 0. * * CLEARS XEQT. :TRN * * CONFIGURES AND STARTS THE SYSTEM CLOCK * * CALCULATES SYSTEM AVAILABLE MEMORY AND * * INITIALIZES THE MEMORY ALOCATION ROUTINE. * * CAN BE ENTERED ONLY ONCE FOR START UP. * * AFTER THAT IT IS USED FOR TEMP STORAGE * ******************************************************************** * * $STRT CLC 0 CLEAR INTERRUPT SYSTEM * WPRIO CLA STA FENCE SET FENCE TO 0 OTA 5B WLINK STA XEQT CLEAR XEQT WORD WSUSP LDB KEYWD FIND THE LAST ID SEGMENT WSTAT LDA B,I IN KEYWORD TABLE BECAUSE WORK INB THE EXECUTBLE PROGRAM ZWORK SZA WILL ALWAYS BE IN THAT ZPRIO JMP WSTAT POSITION. OR ELSE! TEMP ADB N2 TMP LDA B,I GOT THE LAST ID SEGMENT ADDRESS COMPL STA BASA SET UP START UP PROGRAM TEMP1 STA SSP SET UP SUSPEND PTR TEMP2 STA ABP SET UP ABORT POTR * SPC 1 TEMP3 LDA TBG SET UP TIME BASE TEMP4 IOR OTA TEMP5 STA TEMPL TMP5. STA OTATB TEMP6 IOR M1100 TEMP9 STA TEMPW KEY STA STCTB CONFL XOR STFTB SCONF STA STFTB TEMP0 LDA .2 TEMPL OTA 0 SET TBG INTERVAL TO 10MS TEMPW STC 0,C * LDB AVMEM RELEASE AVAIL. STB FWA. CMB,INB MEMORY FOR USE ADB BKORG BY $ALC STB RTN. JSB $RTN FWA. NOP RTN. NOP JMP $ALC GO INITIALIZE MEMORY ALLOCATION ROUTINE $WORK LDA BEGIN RETURN FROM $ALC INI TIALIZATION TMP10 JSB SYSMG OUTPUT "SET TIME" MESSAGE TMP11 JMP RSTRT T* SPC 1 * BEGIN DEF *+1 N10 DEC -10 $PWR5 OCT 6412 DO NOT USE FOR TEMPORARY STORAGE ASC 4,SET TIME * SPC 1 OTA OTA 0 M1100 OCT 1100 * HED ** CENTRAL INTERRUPT CONTROL ** A-92000-60003-2 REV. B * * 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 > A-92000-60003-2 REV. B * *** 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 * FUL LY 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 * P RESENT, 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 I NTERRUPT 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 C ONSISTS 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 * V ALUES: * * 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., CLOCK, * MEMORY PROTECT, I/O DEV ICE 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 C AUSES * 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 JUM P * SUBROUTINE INDIRECTLY TO < CIC >. * SKP * 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. * * * 6. TRANSFERS DIRECTLY TO THE INTERRUPT * PROCESSOR FOR SOURCES OF: * * (TBG) - TIME BASE GENERATOR * * FOR OTHER SOURCES, THE INTERRUPT SO URCE * 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 O F 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 VAL UE IS SET POSITIVE AND IS * SET IN A CALL TO IN THE * SCHEDULING MODULE- THE CALL IS MADE IF B * 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. * SKP CIC NOP * CLF CLF 0 DISABLE INTERRUPT SYSTEM * * PRESERVE CURRENT STATUS OF MACHINE * DST XA,I SAVE REGISTERS ERA,ALS A,B SOC E AND INA OVERFLOW STA XEO,I LIA 4 GET INTERRUPT SOURCE CO DE. 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 ENT RY TO SKIP CLF ### STA INTCD SAVE INTERRUPT SOURCE CODE. * LDB INTCD LDA CIC SAVE P-REGISTER AS POSSIBLE STA XSUSP,I POINT OF SUSPENSION. * * CHECK FOR TRANSFER TO NON-I/O SYSTEM PROCESSOR * CPB TBG IF TIME BASE GENERATOR, JMP $CLCK PROCESS CLOCK INERRUPT * * CHECK LEGALITY OF INTERRUPT * LDA INTCD INTERRUPT ADA N6 CODE - 6. STA B (SAVE FOR TABLE INDEX) SSA - ERROR IF CODE JMP CIC.4 LT 6, ISSUE DIAGNOSTIC. CMA CHECK FOR BEYOND RANGE ADA INTLG OF INTERRUPT TABLE SSA ERROR IF JMP CIC.4 NEGATIVE, ISSUE DIAG. * * GET PROCESSOR IDENT FROM INTERRUPT TABLE * ADB INTBA INDEX TO PROPER ENTRY BY SOURCE LDA B,I CODE. GET CONTENTS OF ENTRY SZA,RSS UNDEFINED INTERRUPT JMP CIC.4 IF VALUE = 0, ISSUE DIAG. * * LDB INTCD REMOVE CPB .6 BIT 15 OF INTBL WORD RSS IF DMA CPB .7 CHANNEL RAL,CLE,ERA INTERRUPT. * SSA,RSS SYSTEM PROCESSOR IS TO BE CALLED JMP CIC.2 IF VALUE IS POSITIVE. * SPC 1 * * * 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 SETEQ SET EQT ENTRY ADDRESSES. * LDA INTCD (A) = INTERRUPT SOURCE CODE * CIC.6 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. JMP X0020 RETURN TO INTERRUPTED SEQUENCE * * ILLEGAL OR UNDEFINED INTERRUPT * CIC.4 LDA INTCD GET INTERRUPT CODE CLB RRR 3 CONVERT IT TO ASCII ALF,ALS RRL 3 IOR FILL STA CICM1+6 LDA CICM1 PRINT JSB SYSMG "ILL INT XX", JMP X0020 RETURN TO INTERRUPTED SEQUENCE. * INTCD NOP HOLDS INTERRUPT SOURCE CODE SKP * CICM1 DEF *+1 DEC -10 ASC 5,ILL INT XX FILL OCT 30060 ASCII MASK HED < RT EXEC.INPUT/OUTPUT CONTROL > A-92000-60003-2 REV. B *** 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 D MA CHANNELS. * I/O DRIVERS OPERATE UNDER CONTROL OF AND * 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 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 D YNAMIC * 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 C ONTENTS * ---- ------------------)--------- * 1 * I/O LIST . LINK POINTER * * 2 *DRIVER *INITIATION ADDRESS* * 3 *DRIVER *COMPLETION ADDRESS* * 4 *DB//T/////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 * T: DEVICE TIM E-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 (A VAILABILITY 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 SIMULA TED 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 ENTR IES 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 UNI T,IN * BITS 5 - 0, AND THE SUBCHANNEL OF THE * EQT ENTRY TO BE REFERENCED BY THIS * LOGICAL UNIT NUMBER, IN BITS 13 - 11.  * * CERTAIN LOGICAL UNIT #S ARE PERMANENTLY * ASSIGNED TO FACILITATE SYSTEM, USER AND * SYSTEM SUPPORT I/O OPERATIONS. THE SE ARE: SKP * 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. T HE * 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 -IOREQ- BY THE EXECUTIVE REQUEST * PROCESSOR . 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 DYNAM IC 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 h * 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 DE C 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 # * * * B. CONTROL REQUEST FORMAT * * EXT E XEC * 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 ST ATUS (FOR PAPER TAPE INPUT) * 10 - GENERATE LEADER FOR PAPER TAPE * 11 - LIST OUTPUT LINE SPACING 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) * EXIT --- * . * . * RCODE DEC 13 STATUS REQUEST CODE = 13 * CONWD OCT NN LOGICjAL 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. SKP IOREQ CLA SET CONTROL FLAG = 0 TO MEAN STA CONFL *REQUEST* SECTION ENTERED * LDA RQCNT INSURE ADA N1 THAT AT LEAST 1 SSA PARAMETER WAS SUPPLIED. JMP ERR01 - NO, ISSUE DIAGNOSTIC. * * LOGICAL UNIT REFERENCE VALIDITY CHECK * LDA RQP2,I EXTRACT LOGICAL UNIT # FROM AND MASK1 PARAMETER 1 STA B (SAVE #) CMA,INA,SZA,RSS CHECK FOR ZERO AND JMP ERR02 FOR A ADA LUMAX VALUE GT THE LARGEST SSA DEFINED #. JMP ERR02 - ERROR, EXCEEDS RANGE. * ADB N1 INDEX TO ADB DRT DEVICE-REFERENCE-TABLE LDA B,I GET EQT ASSIGNMENT. AND MASK2 MASK OUT SUBCHANNEL SZA,RSS -ERROR JMP ERR03 IF NOT ASSIGNED. JSB CVEQT CONVERT TO ABSOLUTE EQT ADDRESSES * * REQUEST CODE ANALYSIS * LDB RQP1 GET REQUEST CODE (PARAMETER 1). CPB .3 IF REQUEST IS , JMP L.02 SKIP FURTHER ANALYSIS. * CPB .13 TRANSFER IF JMP L.15 * STATUS * REQUEST. * LDA RQCNT CHECK # OF O ADA N3 PARAMETERS SUPPLIED SSA FOR READ OR WRITE. JMP ERR01 -ERROR, LT 3. * * BUFFER LEGALITY CHECK FOR INPUT. * LDA RQP4,I GET THE LENGTH CLE,SSA,RSS CONVERT TO JMP *+3 WORDS IF ARS CHARACTERS CMA,INA SET POSITIVE AND STA TEMP2 SAVE. SPC 1 CPB .2 IF WRITE REQUEST, JMP L.02 SKIP B UFFER CHECK. SPC 1 LDA RQP3 GET THE BUFFER ADDRESS CMA AND CHECK TO SEE IF ADA RTORG BELOW THE PROGRAMS CLE,SSA,RSS AREA. ERROR IF ATTEMPT TO READ JMP ERR04 INTO SYSTEM AREA. * LDB TEMP2 CHECK TO SEE IF EXCEEDING ADB RQP3 LWA MEMORY. SEZ ERROR IF NEGATIVE WRAP-AROUND JMP ERR04 WITH OVERFLOW. CMB,INB -IF WRAP-AROUND ADB BKLWA ERROR, SSB,INB,SZB I SSUE JMP ERR04 ERROR 4 DIAGNOSTIC * SPC 1 * * * CHECK FOR AUTOMATIC BUFFERING REQUIREMENT * L.02 LDB RQP1 SKIP CHECK CPB .1 IF REQUEST JMP L.10 IS INPUT. LDA EQT4,I CHECK THE UNIT DE SCRIPTOR RAL WORD IN ITS EQT ENTRY,BIT 14, SSA FOR BUFFERING JMP $L.16 YES,AUTOMATIC BUFFERING SKP * * REQUEST IS A NORMAL WRITE, CONTROL OR READ. * THE PARAMETERS OF THE REQUEST ARE MOVED * I NTO 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 T O I/O SUSPENSION. * L.10 JSB WORD2 ASSEMBLE CONTROL WORD STA XTEMP,I SAVE IN TEMPORARY #1. LDB RQP1 (B) = REQUEST CODE. LDA RQP3 SET BUFFER ADDRESS CPB .3 OR CONTROL LDA RQP3,I PARAMETER STA XTEMP+1,I WORD, LDA u RQP4,I BUFFER STA XTEMP+2,I LENGTH AND LDA RQP5,I ADDITIONAL PARAMETERS IF STA XTEMP+3,I PROVIDED, LDA RQP6,I E.G., DISC STA XTEMP+4,I TRACK/SECTOR ADDRESSES . * LDA XPRIO,I SET PRIORITY OF REQUESTING STA TEMP2 PROGRAM IN TEMP2. LDA XLINK SET ADDRESS OF LINK WORD STA TEMP1 IN TEMP1. STA L.11 * JSB $LIST CALL SCHEDULER TO SUSPEND OCT 102 L.11 NOP - ADDRESS OF ID SEGMENT. * * CALL -LINK- TO PERFORM THE LINKING OF THE NEW * BLOCK INTO THE DEVICE QUEUE OF * WAITING OPERATIONS. * L.13 JSB LINK. * SZA,RSS IF QUE WAS EMPTY CALL DRIVR. * * EMPTY LIST, CALL TO INITIATE CURRENT REQUEST. * JSB DRIVR JMP L.14 - OPERATION INITIATED - LDA RQRTN STA XSUSP,I JMP NOTRD * L.14 LDA RQRTN SET REQUEST -EXIT- ADDRESS STA XSUSP,I AS P OINT OF SUSPENSION. JMP $XEQ TRANSFER TO EXECUTE 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' LDB EQT4,I STORE WORD 4 OF EQT ENTRY IN CPA .1 'STAT2' IF PARAMETER 3 IS STB RQP4,I PRESENT. * * JMP L. 14 GO TO RETURN TO XEQ. * * .1 OCT 1 SKP * * AUTOMATIC BUFFERING SECTION * * $L.16 CLA CPB .3 IF REQUEST IS FOR -CONTROL-, JMP L.03 SKIP BUFFER SIZE CHECK. LDA $TMP2 GET THE XFER LENGTH CMA,INA SET NEG AND STA $TMP3 -SET AS MOVE INDEX CMA,INA (SET POSITIVE) L.03 ADA .5 ADD 5 FOR BLOCK CONTROL WORDS. STA L.04 SET TOTAL LENGTH FOR ALLOCATION. ADA .2 CHECK FOR BUFFER CMA,INA $O SIZE TO BE GREATER LDB AVMEM THAN MAXIMUM CMB,INB AMOUNT ADB BKORG OF SYSTEM ADA B AVAILABLE MEMORY. SSA IF YES, THEN ABORT JMP $ER04 PROGRAM * * ALLOCA TE BLOCK IN TEMPORARY STORAGE * JSB $ALC CALL AT SYSTEM ENTRY POINT L.04 NOP - REQUESTED LENGTH OF BLOCK - * JMP L.10 NO MEMORY EVER, GO TRY NON-BUFFEREDFERED RSS NO MEMORY NOW-GO SUSPEND JM P L.06 BLOCK AVAILABLE, (A) CONTAINS STARTING ADDR. * * 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 . * LDA XEQT SET PROGRAM ID SEGMENT ADDRESS STA L.05 IN CALL TO LINK JSB $LIST CALL TO LINK PROGRAM INTO OCT 104 MEMORY SUSPEND L.05 NOP JMP $XEQ SKP * SET REQUEST PARAMETERS, PROGRAM PRI ORITY AND * USER BUFFER INTO TEMPORARY BLOCK. * L.06 STB L.05 SET ACTUAL BLOCK LENGTH. STA $TMP1 SAVE STA B LOCATION INB STB $TMPW SAVE ADDRESS JSB $WRD2 ASSEMBLE CONTROL WORD IOR MASK5 SET = 1 FOR BUFFERING. LDB $TMPW STA B,I AND SET IN WORD 2 OF BLOCK. INB LDA XPRIO,I SET REQUESTING PROGRAM PRIORITY STA B,I IN WORD 3. STA $TMP2 SAVE PRIORITY FOR LINKING INB LDA L.05 SET BLOCK LENGTH IN STA B,I WORD 4. INB LDA .3 IF REQUEST CPA RQP1 IS -CONTROL-, SKIP JMP L.08 BUFFER MOVE LDA RQP4,I SET USER BUFFER LENGTH STA B,I IN WORD 5. SZA,RSS IF LENGTH = 0, JMP $L.13 SKIP BUFFER MOVE * * MOVE USER BUFFER TO TEMPORARY BLOCK. * INB LDA RQP3 SET USER BUFFER STA $TMP4 ADDRESS FOR MOVE L.07 LDA $TMP4 PERFORM n LDA A,I STA B,I BUFFER MOVE ISZ $TMP4 ((B) = BLOCK ADDRESS INB (TEMP4) = BUFFER ADDRESS, ISZ $TMP3 (TEMP3) = BUFFER LENGTH INDEX) JMP L.07 JMP $L.13 GOTO EXIT SECjION * L.08 LDA RQP3,I FOR CONTROL REQUEST, SET WORD 3 STA B,I (PARAM) IN PLACE OF RECORD JMP $L.13 LENGTH SKP * * * RELEASE AUTOMATIC BUFFERING BLOCK * $L.56 LDA $TMP3 BY PASS RELEASE OF SZA BUFFER IF MALFUNCTION JMP $IOER OCCURED 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 SE T 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 - JMP $L.55 * RELEASE BUFFER BLOCK D UE TO ILLEGAL REQUEST ERROR * $R06 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 RELEA SE BLOCK. R01 NOP - FWA - NOP - # WORDS - JMP $RXIT * MASK5 OCT 40000 SKP * * ASSEMBLE CONTROL WORD * WORD2 NOP LDA RQP2,I COMBINE REQUEST CODE WITH AND MASK3 CONTROL INFOR MATION IOR RQP1 IN PARAMETER TWO AND STA B TEMPORARILY STORE IT- LDA RQP2,I EXTRACT LOGICAL UNIT # AND MASK1 FROM PARAMETER TWO ADA N1 INDEX TO ENTRY IN ADA DRT DEVICE REFERE NCE TABLE LDA A,I GET SUBCHANNEL AND MASK9 ASSIGNMENT AND COMBINE IOR B IT WITH CONTROL WORD JMP WORD2,I EXIT - SPC 1 SPC 1 MASK3 OCT 3700 .13 DEC 13 N3 D TRN DEC -3 T 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 REQUES T 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 * REQ UEST. * * * - JSB LINK * - (RETURN) (A) = 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 O PERATION. * * THERE ARE NO ERROR CONDITIONS * DETECTED OR DIAGNOSED BY THIS * ROUTINE. * * SKP LINK. NOP LDB EQT1,I IF THE I/O LIST IS NULL, SZB,RSS EQT LIST POINTER = 0, JMP LINK4 SKIP TO ADD NEW REQUEST. * * FIRST ENTRY IN LIST IS SKIPPED BECAUSE IT * IS THE CALLER FOR THE CURRENT OPERATION * ACTIVE ON THE I/O DEVICE. * JMP LINK7 GO START THE SCAN * LINK1 STB TEMP3 TEMP3 = ADDRESS OF CU RRENT ENTRY. INB EXAMINE THE LDA B,I TYPE FIELD IN WORD 2 OF BLOCK INB TO DETERMINE LOCATION RAL,SLA OF PRIORITY. JMP LINK5 IF SYS REQ, SET PR=0 SSA,RSS IF NORMAL USER RE QUEST, PRIORITY ADB .4 IS IN WORD 7 OF ID SEGMENT. LDA B,I GET PRIORITY OF CURRENT ENTRY. LINK2 LDB TEMP3 CMA,INA SUBTRACT CURRENT PRIORITY FROM ADA TEMP2 PRIORITY OF NEW REQUEST. SSA I F CURRENT IS LOWER PRIORITY JMP LINK3 (HIGHER #), GO TO LINK NEW. LINK7 STB TEMP5 SAVE PREVIOUS ENTRY POINTER LDB B,I GET NEXT ENTRY SZB IF END-OF-LIST, SKIP. JMP LINK1 -CONTINUE SCAN. * * PROP ER 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 STA TEMP5,I LINKAGE VALUE OF PREVIOUS ENTRY. LINK6 STB TEMP1,I SET ADDRESS OF NEXT OR 0 IF LAST JMP LINK.,I IN NEW - EXIT TO CALLER * * NULL LIST- REQUEST IS MADE FIRST IN LIST AND FLAG FOR SET FOR CALLER. * LINK4 LDA TEMP1 SET ADDRESS OF NEW IN LIST POINT- STA EQT1,I ER IN EQT ENTRY. CLA SET NEXT LINK ADDR. IN NEW = 0. JMP LINK6 GO FINISH LINK AND EXIT SPC 1 * A SYSTEM REQUEST HAS BEEN FOUND IN THE QUE * LINK5 CLA SYSTEM REQUEST, SET JMP LINK2 PRIORITY=0, LINK OLD R EQUEST SKP SKP * SUBROUTINE: -DRIVR- * * PURPOSE: THIS ROUTINE PROVIDES A CENTRAL POINT * FOR CALLING AN I/O DRIVER TO INITIATE * A NEW OPERATION. THIS ROUTINE, BEFOREJz * 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,RAL OF AND .3 DEVICE. STA TEMP6 SAVE AVAILABILITY STATUS. CPA .1 IF DOWN OR NOT READY JMP DRIVR,I EXIT IMMEDIATELY. CPA .2 IF CURRENTLY BUSY, JMP DRIVR,I ALSO EXIT. * * DEVICE IS AVAILA BLE - CHECK FOR DMA REQUIREMENT * CPA .3 IF IN DMA QUE JMP DVR00 GO ATTEMPT ASSIGNMENT LDA EQT4,I SKIP DMA CHANNEL ASSIGNMENT IF SSA,RSS NOT REQUIRED ( D FIELD = 0 ) JMP DRV02 IN WORD 4 OF E QT ENTRY. SPC 1 * LDB EQT1,I SKIP DMA CHANNEL ASSIGNMENT IF * INB CONTROL REQUEST (CODE = 3) * LDA B,I * R AND .3 * CPA .3 * JMP DRV02+2 * * DMA CHANNEL REQUIRED - ATTEMPT TO ASSIGN CHANNEL * DVR0 LDA DMACF IF DMA QUE IS NOT EMPTY SZA JMP DVR1 THEN JUST ADD THIS EQT TO QUE. * DVR00 LDA .6 INITIALIZE FOR STA CHA N 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 CHANN EL 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 MASK4 SET AVAIL TO SAY WAITING FOR STA EQT5,I DMA, ADD 1 TO ISZ DMACF # DEVICES WAITING. JMP DRIVR,I - EXIT TO CALLER - * * 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 TEMP6 PREVIOUS WAITING CPA .3 FOR A DMA ADB N1 CHANNEL, SUBTRACT 1 FROM # OF STB DM ACF UNITS WAITING. LDA EQT5,I CLEAR AND MASK6 STA EQT5,I FIELD. * * TRANSFER REQUEST PARAMETERS TO EQT ENTRY * DRV02 LDB EQT1,I GET CURRENT REQUEST ADDRESS INB FROM LINK WORD OF EQT ENTR Y. LDA B,I GET REQUEST CONTROL WORD, AND MASKS SET SUBCHANNEL BITS TO ZERO STA EQT6,I SET IN EQT 6. XOR B,I SET SUBCHANNEL ALF,ALF NUMBER INTO ALF,RAR BITS 8-6 STA TEMPL OF EQT4 LDA B,I RAL IF REQUEST IS SSA HELD AS A TEMPORARY BLOCK FOR JMP DRV03 BUFFERING, JUMP. INB s LDA B,I SET BUFFER 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. JMP DRV05 * DRV03 ADB .3 * TEMPORARY BLOCK * RAR,SLA CHECK REQUEST CODE. RSS - CONTROL REQUEST - JMP DRV04 - WRITE REQUEST - LDB B,I SET CONTROL PARAMETER JMP DVR4 IN THE EQT DRV04 LDA B,I GET BUFFER LENGTH STA EQT8,I OF THE BLOCK. INB ADDRESS OF WORD 6 IS DVR4 STB EQT7,I THE BUFFER ADDRESS. CLA CLEAR STA EQT9,I WORDS 9 AND 10 OF STA EQT10,I EQT ENTRY. * * CALL DRIVER -INITIATION- SECTION * DRV05 LDA EQT14,I SET DEVICE STA EQT15,I T IME-OUT CLOCK LDA EQT4,I ZERO TIME-OUT AND MASK7 BIT AND SET IOR TEMPL IN SUBCHANNEL STA EQT4,I SET (A) = CHANNEL AND MASK1 # 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 NUME RIC 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. SZA IF REJECTED, JMP DRV06 EXAMINE REASON * * OPERATION INITIATED * LDA EQT5,I SET IOR MSIGN = 2 TO SAY DEVICE STA EQT5,I IN OPERATION. JMP DRIVR,I EXIT. * * OPEtRATION REJECTED * DRV06 STB TEMPW SAVE (B) CLA CLEAR DEVICE STA EQT15,I T IME-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 MASK7 OCT 173077 MASK9 OCT 34000 MASKS OCT 143777 HED < I/O SUBSECT- SYS RQST PROC > A-92000-60003-2 REV. B * 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 COMPLETION ADDRESS CAN BE * SPECIFIED FOR OPERATION OF * AN OPEN SUBROUTINE AT THE * END OF T HE 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 bN * 6 DEF * 7 DEC * SKP * XSIO NOP LDB XSIO,I G ET LOGICAL UNIT #. ADB N1 SUBTRACT 1 AND INDEX TO ADB DRT DEVICE REFERENCE TABLE. LDA B,I GET ASSIGNED EQT ENTRY #. AND MASK9 MASK OUT SUBCHANNEL STA TEMPL AND SAVE IT XOR B,I EQT # INTO A JSB CVEQT CONVERT TO ABSOLUTE EQT ADDRESSES * LDB XSIO SET ADDRESS ADB .2 OF LIST POINTER WORD IN STB TEMP1 REQUEST FOR . * CCE,INB SET LDA B,I FIELD (B ITS 15-14) OF AND MASKS IOR TEMPL WORD 5 = 2 FOR SYSTEM REQUEST ELA,RAR AND SET IN SUBCHANNEL NUMBER STA B,I IDENTIFICATION. CLA SET PRIORITY OF REQUEST = 0 STA TEMP2 FOR
  • , STA CONFL SET CONTROL FLAG = 0 (REQUEST). ADB .3 SET B TO RETURN ADDR STB XSIO AND SAVE IT. JSB LINK. CALL TO LINK REQUEST IN I/O LIST * SZA,RSS IF DEVICE NOT BUSY * JSB DRIV R 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 HED A-92000-60003-2 REV. B * * 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 PRO GRAM 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 * . . . . * . . . . * N+5 * * * 3) 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 > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * * THE FIELD (BITS 15-14 IN CONTROL WORD) * IDENTIFI ES THE REQUEST TYPE AS: * * 00 USER (NORMAL OPERATION) * 01 USER (AUTOMATIC BUFFERING) * 10 SYSTEM * * SKP IOCOM RAL,CLE,ERA CLEAR THE SIGN BIT AND SAVE IN E STA TEMP3 SAVE STATUS FROM DRIVER AND STB TLOG TRANSMISSION 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 RETUR N 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 SZB,RSS IF ILLEGAL ENTRY JMP CIC.4 SEND ERROR MESSAGE INB REQUEST BLOCK TO LDA B,I EXTRACT FIELD. STA TEMP0 SAVE CONTROL WORD. RAL,SLA IF BIT 15 = 1 ( = 2) JMP L.53 PROCESS AS SYSTEM REQUEST. SSA IF = 0, PROCESS JMP $L.56 RELEASE AUTO BUFFER BLOCK * * * 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 T HE 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. * JSB $LIST CALL SCHEDULER MODULE TO PLACE OCT 101 USER PROGRAM INTO SCHEDULE L.52 NOP LIST. JMP L.54 * * SYSTEM REQUEST COMPLETION * L.53 LDB EQT1,I GET CURRENT REQUEST AD DR. 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 ADD RESS * HAS BEEN SAVED. * L.54 LDA TEMP3 BY PASS INITIATING THE NEXT SZA OPERATION IF A MALFUNCTION HAS JMP IOERR OCCURRED ON THIS DEVICE. * * L.55 LDA EQT5,I CHECK FIELD. SSA,RSS IF AV SAYS BUSY JMP IOCX SKIP ELSE GO EXIT * * SECTION <60> PROVIDES FOR INITIATING THE NEXT * OPERATION WAITING FOR THE COMPLETED DEVICE. * L.60 LDA EQT5,I SET AND MASK6 FIELD STA EQT5,I = 0 TO SAY AVAILABLE. JMP L.68 GO START THE NEXT REQUEST * .11 DEC 11 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. * kL.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 AND AFLD WORD 5. CPA DMACW 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 JMP IOCX1 -YES, 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 SAM E AS INTERRUPTING DEVICE, JMP L.68 SKIP SETTING EQT ADDRESSES. * JSB SETEQ 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. * * THIS ROUTI NE CHECK FOR A DMA QUE AND IF ANY AND IF A CHANNEL IS * AVAILABLE THE CHANNEL ASSIGNMENT ROUTINE IS ENTERED. * IOCX LDA DMACF GET THE DMA QUE 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 LDA COMPL IF SYSTEM REQUEST LDB TLOG SZA COMPLETION ROUTINE SPECIFIED, JMP COM PL,I OPERATE ITn. * LDB OPATN GET OPERATOR ATTENTION FLAG STA OPATN CLEAR OPERATOR FLAG SZB IF OPERATOR DESIRES CONTROL, JMP $TYPE ACKNOWLEDGE JMP $XEQ TRANSFER TO EXECUTE SECTION * HE D I/O REQUEST ERROR SECTION A-92000-60003-2 REV. B * * * * I/O REQUEST ERROR SECTION * * PART 1: ERRORS ENCOUNTED IN ANALYSING A * USER REQUEST CAUSE A DIAGNOSTIC * TO BE PRINTED ON THE SYSTEM * TELETYPEWRI TER AND THE USER * PROGRAM ABORTED. THE FORMAT OF * THE DIAGNOSTIC IS: * * 'ERR-XX' * * WHERE XX IS AS FOLLOWS: * * * XX = RQ EXEC REQUEST ERROR * PA NOT ENOUGH PARAMETERS * LU ILLEGAL LOGICAL UNIT * EQ LOGICAL UNIT NOT ASSIGNED * BF USER BUFFER VIOLATES SYSTEM * RW READ OR WRITE ILLEGAL FOR DEVICE * BY THE ROUTINE -ERMSG- IN * * * CODE IDENTIFYING THE ERROR TYPE. * RQERR LDA RQ REQUEST ERROR JMP ERRM * ERR01 LDA PA PARAMETER ERR JMP ERRM * ERR02 LDA LU LU ERR JMP ERRM * ERR03 LDA EQ EQT ERR JMP ERRM * ERR04 LDA BF BUFFER ERR JMP ERRM * ERR07 LDA RW READ/WRITE ILLEGAL ERRM STA MSG+2 JSB CKABT GO TEST ABORT OPTION LDA MSGA * JSB SYSMG WRITE MESSAGE JMP ABORT * * RQ ASC 1,RQ PA ASC 1,PA LU ASC 1,LU EQ ASC 1,EQ BF ASC 1,BF RW ASC 1,RW * MSGA DEF *+1 N6 DEC -6 MSG ASC 3,ERR-XX * SPC 10 * * SUBROUTINE TO CHECK FOR ABORT OPTION * * IF"NO ABORT" OPTION SET- RESCHEDULE * * IF "NO ABORT"OPTION NOT SET-ABORT * * CKABT NOP STA XA,I SAVE ERROR CODE ( IN A REG) LDB XEQT GET ADDRESS OF CURRENT ID ENTRY STB CKBT1 SAVE ID ENTRY FOR RESCHEDULE ADB .8 GET DISPLACEMENT RETURN ADDRESS STIB SY SMG SAVE FOR NO ABORT OPTION ADB .7 GET TO STATUS WORD LDA B,I RAL,CLE,SLA,ERA IS ABORT FLAG SET? RSS YES---DO NOT ABORT JMP CKABT,I NO--STANDARD ABORT CCA ADA RQRTN GET ERROR RE TURN ADDRESS STA SYSMG,I SAVE RETURN ADDRESS * JSB $LIST RESTART PROGRAM OCT 101 CKBT1 NOP ID SEG ADDRESS * CLA CLEAR XEQT STA XEQT FORCING A RELOAD LDA SCONF RESTORE STA CONFL *CONTROL FLAG* LDA TEMP9 RESTORE UNIT JSB SETEQ LDA MSG+2 GET ERROR CODE CPA RW IS IT A READ/WRITE ERROR?? JMP REXIT YES--CHECK OTHER DEVICES AND TERMINATE JMP $XEQ NO--IN ITATOR ERROR .8 DEC 8 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 DEV ICE. * 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 US ER 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 * %TRN CAUSES A DIAGN OSTIC TO BE ISSUED * AND THE PROGRAM ABORTED. AT SKP ILLCD CPA .4 IF CODE =4 FOR IMMEDIATE LDA .2 COMPLETION, TREAT AS CONTROL 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 FOR TYPE OF REQUEST BLOCK JMP $R06 RELEASE BLOCK * 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 PT OF SUSPENSION ADDR. LDB A,I GET RETURN ADDRESS STB RQRTN AND SAVE ON B.P. INA SET XSUSP TO POINT STA XSUSP TO SAVED INITIAL CALL ADDRESS LDA EQT1 SAVE CURRENT STA TEMP9 EQT ADDRES S LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* JMP ERR07 ILLEGAL READ OR WRITE 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 TEMP6 CPB .2 STORE TLOG IF IMMEDIATE RETURN CLB,RSS FROM DRIVER (A)=4; LDB TEMPW OTHERWISE, STORE ZERO INA TRAN SMISSION 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. } LDB CONFL I F THE IOC *COMPLETION* SZB SECTION IS IN CONTROL, JMP L.60 RETURN TO L.60 FOR NEXT REQUEST * LDA EQT6,I REJECT OCCURRED IN IOC *REQUEST* SSA SECTION. RETURN TO JMP XSIO,I SYSTEM CALLE R. LDA TEMP4 IF REJECTING LDB RQRTN A CONTROL REQUEST TO IOREQ, CPA .2 SET EXIT IN POINT STB XSUSP,I OF SUSPENSION. JMP $XEQ EXECUTE SECTION IN SCHEDULER 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 ERR MN * * WHERE NN IS THE EQT ENTRY # OF THE DEVICE * AND MN IS A MNEMONIC DESCRIBING THE * 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- * IOERR ADA ERTBL INDEX TO ERROR CODE TABLE. LDA A,I GET MNEMONIC AND STA MSG2+2 SET IN DIAG MESSAGE * LDA EQT1 STA TEMP9 * LDA EQT5,I GET STATUS WORD FROM EQT AND MASK6 SET FIELD IO R MASK0 = TO 1 STA EQT5,I -UNIT DOWN- * LDA CONFL SAVE CURRENT STA SCONF *CONTROL FLAG* * LDA MSGA2 ADDRESS OF MESSAGE JSB SYSMG CALL TO PRINT. * * LDA SCONF RESTORE *CONTROL FLAG*. STA CONFL LDB TEMP9 CPB SYSTY JMP L.60 LDB B,I GET FIELD INB WORD LDB B,I TO B. SZA SECTION IN CONTROL, JMP IOCX GO EXIT IOC SSB *REQUEST* SECTION. IF SYSTEM JMP XSIOE,I REQUEST, RETURN TO CALLER. JMP $XEQ EXECUTE SECTION IN SCHEDULER * * 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 * * MSGA2 DEF *+1 DEC -6 MSG2 ASC 3,ERR-XX HED < IO-DEVICE TIME-OUT PROCESSOR > A-92000-60003-2 REV. B * * * AFTER A DEVICE IS DISCOVERED TO HAVE TIMED-OUT * BY THE SCHEDULER'S CLOCK PROCESSOR,THIS * ROUTINE IS ENTERED. ITS PURPOSE IS TO * CLE AR 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 SETEQ SET EQT ADDRESSES LDA EQT4,I IOR MASK8 SET TIME-OUT BIT STA EQT4,I STA B SAVE WORD IN B FOR TEST AND MASK1 SELECT CODE TO A BLF,SLB IF DRI VER TO HANDLE TIME JMP CIC.6 OUT GO CALL THE DRIVER. JSB CLCHS CLEAR ALL CHANNELS LDA .4 SERVICED BY THIS ENTRY CLB SIMULATE COMPLETION JMP IOCOM RETURN FROM DRIVER SPC 1 N14 DEC -14 HED A-92000-60003-2 REV. B * CONSTANT AND VARIABLE STORAGE AREA .4 DEC 4 .5 DEC 5 .7 DEC 7 .9 DEC 9 * MASK1 OCT 77 MASK2 OCT 377 MASK4 OCT 140000 MASK6 OCT 37777 MASK8 OCT 4000 MSIGN OCT 100000 * TEMPA EQU TEMP1 TEMPB EQU TEMP2 TEMPE EQU TEMP3 * TLOG NOP AFLD EQU MASK4 DMACW EQU MASK4 DMACF NOP FLAGS USED IN ALLOCATING HED A-92000-60003-2 REV. B * * SUBROU TINE: < SYSMG > (SYSTEM MESSAGE) * * PURPOSE: THIS ROUTINE PROVIDES FOR THE * OUTPUT OF SYSTEM MESSAGES AND * ERROR DIAGNOSTICS ON THE SYSTEM * TELEPRINTER. * * CALL: (A) = ADDRESS OF FIRST WORD OF * MESSAGE BLOCK - THIS WORD * CONTAINS THE CHARACTER * LENGTH OF THE MESSAGE AS * A NEGATIVE VALUE. * * (P) JSB SYSMG * (P+1) -RETURN- * SYSMG NOP LD B A,I STB SLEN SET UP MESSAGE LENGTH INA STA SBAD SET UP MESSAGE ADDRESS JSB XSIO PRINT MESSAGE OCT 1 NOP NOP OCT 2 SBAD NOP SLEN NOP JMP SYSMG,I * SKP * SUBROU TINE: * * PURPOSE: THIS ROUTINE CONVERTS AN EQT * ENTRY # TO AN EQT DISPLACEMENT * AND CALLS TO SET THE * ENTRY ADDRESSES. * * CALLING SEQUENCE: * * (A) = EQT ENTRY # * * (P) JSB CVEQT * (P+1) -RETURN- REGISTERS MEANINGLESS * * CVEQT NOP $CVEQ EQU CVEQT ADA N1 SUBTRACT 1 AND STA B MULTIPLY EQT ENTRY # CMB,INB BY 15 ALF TO ADA B COMPU TE THE ADA EQTA ABSOLUTE ADDRESS. * JSB SETEQ SET ALL 15 ADDRESSES. * JMP CVEQT,I -RETURN- SKP HED I/O CLEAR SECTION A-92000-60003-2 REV. B * SPECIAL SECTION "I/O CLEAR " * * 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 * REQUESTING AN ABORT OPERATION * * PROCESS: THE LIST OF EACH EQT ENTRY * IS SEARCHED TO FIND THE QUEUED * A 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. * * CALLING SEQUENCE: * * (A)= ID SEGMENT ADDRESS OF PROGRAM * * (P) JSB IOCL * * -NO RETURN - * * SKP * IOCL NOP CLA STA OPFLG LDA EQT# SET TEMP2 = NEGATIVE CMA,INA NUMBER OF EQT STA TEMP2 ENTRIES. LDA EQTA INITIALIZE FOR * STA IOCL 5 EQT ENTRY WORD STA IOCL6 1 ADDRESS. * IOCL1 LDA A,I GET LINK ADDRESS. CPA ABP JUMP IF A JMP IOCL2 MATCH TO PROGRAM. * SZA IF NOT END OF LIST, JMP IOCL1-1 CONTINUE SCAN. * LDA IOCL5 SET (A) = ADDRESS OF ADA .15 NEXT EQT ENTRY. ISZ TEMP2 IF NOT END OF EQT, GO JMP IOCL1-2 TO SCAN NEXT ENTRY LIST. JMP IOCL,I RETURN * * PROGRAM REQUEST ENTRY FOUND, UNLINK REQUEST. * IOCL2 LDB A,I GET NEXT LINK AND SET STB IOCL6,I IN PREVIOUS LINK. LDA IOCL5 IF PROGRAM REQUEST WAS CPA IOCL6 CURRENT REQUEST CLB,RSS SKIP TO LEAR DEVICE JMP IOCL,I RETURN * JS B SETEQ STA CONFL FOR IOCOMPLETION STB COMPL COMPLETION FLAG STB EQT15,I CLEAR TIME OUT FLAG JSB CLCHS LDA EQT5,I CLEAR BUSY BIT AND MASK6 STA EQT5,I JMP IOCL,I RETURN SPC 1 IOCL5 NOP IOCL6 NOP SKP HED UP-IO-SECTION A-92000-60003-2 REV.B * * * THE UP - IO SECTION IS CALFbLED BY THE * POWER-FAIL DRIVER TO HELP IN RESTARTING * THE DMA CHANNELS. * * * $UPIO JSB CLDMA GO CLEAR DMA CHANNEL LDA EQT5,I GET AVAILABILITY ISZ CONFL SET CONTROL FLAG SSA,RSS IF DOWN OR AVAIL. JMP L.60 GO TRY TO OPERATE JMP $XEQ CONTINUE HED SET EQT TABLE A-92000-60003-2 REV. B * SUBROUTINE: < SETEQ > * * PURPOSE: THIS ROUTINE SETS THE ADDRESSES * OF THE 15 WORDS OF AN * EQUIPMENT TABLE ENTRY IN THE * 15 WORDS IN BASE PAGE COMMUNICATION * AREA LABEL LED -EQT1- TO -EQT15-. * * CALLING SEQUENCE: * * (A) - STARTING ADDRESS OF THE EQT * ENTRY FOR THE REFERENCED * I/O UNIT. * * (P) JSB SETEQ * (P+1) - RETURN - (A),(B) MEANINGLE SS * * THERE ARE NO ERROR RETURNS OR * ERROR CONDITIONS DETECTED. * * SETEQ 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 SETEQ,I * * SKP HED SYSMG BUFF & PRIV I-O CONFIG A-92000-60003-2 REV. B * * 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 ST F 6 6. STA B,I SET IT AVAILABLE IN INTBA SPC 1 IOCL3 INB STEP TO DMA 7 ENTRY 3 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 ST A 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 HED OUTPUT * ON SYTEM TELETYPE A-92000-60003-2 REV. B ************************************************************** * TH E $TYPE SECTION FUNCTIONS AS FOLLOWS: * ENTRY IS MADE BY STRIKING ANY KEY ON THE SYSTEM TTY * * IF TELETYPE IS NOT BUSY,THEN * IS OUTPUT AND REQUEST* * IS MADE FOR INPUT.IF FLAG IS SET THEN IQNORE REQUEST * * ON COMPLETION OF INPUT THE MESSAGE IS DECODED AND IF* * THE MESSAGE IS A "GO","AB","SS", OR "UP" THEN THE * CORRECT ACTION IS TAKEN ELSE "?" IS PRINTED. ************************************************************** * $TYPE LDA OPFLG CHECK SYSTEM TTY FLAG SZA JMP $XEQ BUSY SO IGNORE * LDA COLON JSB SYSMG OUTPUT ASTERISK * JSB XSIO INPUT OPERATOR MESSAGE OCT 1 DEF TYP10 GO HERE ON COMPLETION NOP OCT 401 DEF BUFFR DEC -4 * ISZ OPFLG SET SYSTEM TTY BUSZ JMP $XEQ * TYP10 CLA STA OPFLG LDA BUFFR GET MESSAGE CPA AB JMP ABORT ABORT PROGRAM CPA GO JMP TYP20 CPA SS JMP STP STOP EXECUTION(SUSPEND) CPA UP UP LOGICAL UNIT JMP UPLU * LDA QMRKA JSB SYSMG OUTPUT ? AND CONTINUE JMP $XEQ * TYP20 CLA CLEAR TTY FLAG CPA SUSP5 JMP $XEQ CONTINUE EXECUTION * JMP RSTRT ITS SUSPENDED,SO RESTART STP JSB $LIST SUSPEND PROGRAM OCT 106 SSP NOP * * UP A DOWNED LOGICAL UNIT * UPLU LDB EQTA GET EQT ADDRS ADB .4 ADDRESS OF STATUS WORD CLA,INA START COUNTI NG EQTS UPLU1 STA TEMP LDA B,I GET STATUS WORD AND MASK0 SEE IF THIS DEVICE IS DOWN SZA,RSS JMP NXTEQ NO,ITS NOT! LDA TEMP YES,ITS DOWN JSB CVEQT SET EQT ADDRESSES CLA,INA STA CONFL SET CONTROL FLAG=1 FOR IOCOM CLA STA OPFLG CLEAR OPER. FLAG STA COMPL CLEAR COMPLETION FLAG JMP L.60 GOTO IOCOM * NXTEQ ADB .15 INCREMENT TO NEXT EQT LDA TEMP CPA EQT# HAVE WE LOOKED AT ALL EQTS JMP $XEQ YES! INA JMP UPLU1 NO,GOTO NEXT ONE * AB ASC 1,AB GO ASC 1,GO SS ASC 1,SS UP ASC 1,UP * QMRKA DEF *+1 DEC -1 ASC 1,? COLON DEF *+1 N4 DEC -4 OC T 6412 CR,LF ASC 1,:_ PROMPT BUFFR BSS 2 MASK0 OCT 40000 SKP * HED SYSTEM DEFINE ROUTINE A-92000-60003-2 REV. B * * * * CALLING SEQUENCE: * * JSB .OPSY * * RESULT IN A REGIST ER * * A = -3 * * .OPSY NOP LDA N3 JMP .OPSY,I RETURN * * * * SKP HED * SYSTEM BASE PAGE COMM. AREA * A-92000-60003-2 REV. B A EQU 0 B EQU 1 * $CIC EQU CIC $L.13 EQU L.13 $L.51 EQU L.51 $L.55 EQU L.55 $L.10 EQU L.10 $R02 EQU R02 $TMP1 EQU TEMP1 $TMP2 EQU QTEMP2 $TMP3 EQU TEMP3 $TMP4 EQU TEMP4 $TMPW EQU TEMPW $WRD2 EQU WORD2 $ER04 EQU ERR04 $RXIT EQU REXIT $IOER EQU IOERR * * * . EQU 1650B ESTABLIS H 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 POI NT 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, SUSP5 EQU .+38 'OPERATOR SUSPEND' LIST * * DEFINITION OF EXECUTING PROGRAM ID SE GMENT' * * 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 SUSPENSIOu<:6N 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 DUMMY EQU .+55 I/O ADDRESS OF DUMMY INT. CARD * * 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 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 * * UTILITY PARAMETERS * FENCE EQU .+85 MEM PROTECT FENCE ADDRESS BKLWA EQU .+87 LWA MEMORY IN BACKGROUND END CIC ~_< ; 92001-18002 1732 S C0922 RTE II/III LOADER              H0109 _+ASMB,L,N,C *LOADR USE 'ASMB,R,N' (RTE-II) OR 'ASMB,R,Z' (RTE-III) * * *************************************************************** * * (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-MEU CODE **** HED RELOCATING LOADR FOR RTE-II <1732> NAM LOADR,3,90 92001-16002 REV.1732 770811 ******* END NON-MEU CODE ****** XIF IFZ ******* BEGIN MEU CODE ******** HED RELOCATING LOADR FOR RTE-III <1640> NAM LOADR,3,90 92060-16004 REV.1732 770811 EXT $ENDS,$MATA ******* END MEU CODE ********** XIF * UNL IFN ******* BEGIN NON-MEU CODE **** LST * NAME: RTE LOADER * SOURCE: 92001-18002 * RELOC: 92001-16002 * PGMR: P. KAPOOR, E. WONG, G. ANZINGER * UNL ******* END NON-MEU CODE ****** XIF IFZ ******* BEGIN MEU CODE ******** LST * NAME: RTE LOADER * SOURCE: 92001-18002 * RELOC: 92060-16004 * PGMR: E. WONG * UNL ******* END MEU CODE ********** XIF LST SUP EXT EXEC,$LIBR,$LIBX,PRTN * SKP * LIST OF ERROR DIAGNOSTICS * * * = MODULE NAME PRINTED BEFORE DIAGNOSTIC * **= ENTRY POINT NAME PRINTED AFTER MODULE NAME * * 01 * - CHECKSUM ERROR * 02 * - ILLEGAL RECORD * 03 * - MEMORY OVERFLOW * 04 * - BP LINKAGE OVERFLOW * 05 * - SYMBOL TABLE OVERFLOW * 06 * - COMMON BLOCK ERROR * 07 * ** - DUPLICATE ENTRY POINTS * 08 - NO TRANSFER ADDR * 09 * - RECORD OUT OF SEQUENCE * 10 - ILLEGAL PARAMETER IN ON OR GO STATEMENT * 11 - ATTEMPT TO REPLACE A CORE RESIDENT PROG * 12 - LG AREA USED WITHOUT RESETTING (P1=2 IN 'GO') * P1 WAS NOT INPUT AS 99 PREVIOUSLY. * 13 - LG AREA HAS BEEN ILLEGALLY RESET - OVERWRITTEN. * PROGRAM ADDITION ON LG AREA NOT ALLOWED FOR MAIN SEG * LOAD IF THE LOADER HAS ALREADY LOADED THE LAST SEGMENT. * HAVING ONCE USED LG AREA FOR FORCE LOADING WITH P1=99, * LOADER CANNOT BE RESCHEDULED WITH P1=99 IN THE 'GO' REQUEST. * 14 * - ASMB PRODUCED ILLEGAL RELOCATABLE . A DBL REC * REFERS TO AN EXTERNAL WHICH HAS NOT BEEN DEFINED. * (THE ORDINAL CAN NOT BE FOUND IN THE SYMBOL TABLE). * 15 * ** - FORWARD REFERENCE TO A TYPE 3 OR TYPE 4 ENT OR TO * AN EXT WITH OFFSET WHICH HAS NOT YET BEEN DEFINED, * OR A FORWARD INDIRECT EXTERNAL REFERENCE. * 16 - ILLEGAL PARTITION NUMBER OR CORRUPT MAP TABLE. * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. * 18 - TOTAL NUMBER OF PAGES REQUIRED EXCEEDS 32. * * * LIST OF WARNINGS (THE RELOCATION IS NOT ABORTED) * * 17 - NUMBER OF PAGES REQUIRED EXCEEDS AMOUNT IN PTTN. SKP * * VARIABLES AND CONSTANTS * PLIST NOP LIST/NO LIST FLAG = 0/1 CWABP NOP CURRENT BASE PAGE ADDR 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 TMDY1 NOP ADDR OF TIME OF DAY ,LS TMDY2 NOP ADDR OF TIME OF DAY , MS NUPLS NOP NO. UTILITY PROGS LOADED TPREL NOP CURRENT MAX PROG RELOC ADDR DBLAD NOP DATA BLOCK RELOCATION ADDR OPRND NOP ABSOLUTE MEMORY ADDR WDCNT NOP TEMPORARY COUNTER DSKUN NOP CURRENT DISK LOGICAL UNIT NO. DTRAK NOP CURRENT DBUF TRACK DSECT NOP CURRENT DB*UF SECTOR DCNT NOP CURRENT DBUF COUNT CURAL NOP CURRENT LBUF ADDR CURAT NOP CURRENT TBUF ADDR TBUF BSS 5 TEMPORARY BUFFER MSEGF NOP MAIN/SEGMENT FINAL LOAD FLAG NPAR BSS 7 NAME REC PARAMETERS BKLWR NOP LAST WORD OF AVAILABLE MEM LWA NOP LOADING AREA, BPFWA NOP FWA OF ACTUAL BP LINK AREA FWABP NOP FWA AND LWA OF DUMMY LWABP NOP BASE PAGE AREA. SEGB NOP SEGMENT BASE PAGE LOWER BOUND DBFLG NOP NO DEBUG/DEBUG FLAG = 0/1 LGO NOP LOAD-AND-GO FLAG: 0=NO, >0=YES MSEG NOP MAIN/SEGMENT LOAD FLAG: 0=NO, >O=YES DBLFL NOP FIRST DBL REC: -1,YES; 0,NO. EDFLG NOP EDIT FLAG: 1=ADDITION, 2=REPLACEMENT PTYPE DEC 3 PROG TYPE PPRI NOP PROG PRIORITY OPCOD NOP COMTP NOP TYPE OF COMMOM MXCOM NOP MAXIMUM COMMON LENGTH PAM1 NOP PARM1 OF ON REQ PAM2 NOP BATCH NOP BATCH MODE FLAG: 0=NO, -1=YES INDLU NOP N1 DEC -1 N9 DEC -9 N64 DEC -64 N128 DEC -128 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P12 DEC 12 P16 DEC 16 P18 DEC 18 P20 DEC 20 P22 DEC 22 P23 DEC 23 P26 DEC 26 P42 DEC 42 P98 DEC 98 P99 DEC 99 P128 DEC 128 P9999 DEC 9999 M7 EQU P7 M17 OCT 17 M20 OCT 20 M60 OCT 60 M77 OCT 77 M177 OCT 177 M200 OCT 200 M300 OCT 300 M377 OCT 377 M400 OCT 400 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 BLANK OCT 40 UBLNK OCT 20000 UCHRG OCT 43400 MSIGN OCT 100000 CHRDE ASC 1,DE CHRBU ASC 1,BU MESS2 DEF MBUF AMEM3 DEF MBUF+3 AMEM6 DEF MBUF+6 MES10 DEF *+1 AS5tC 7,LOADR ABORTED PGMIN OCT 305 SEOT OCT 705 SET END OF TAPE CONWORD LISTU OCT 206 LIST OUTPUT UNIT NO. 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 SEOFG NOP ODD/EVEN SEC FLAG FOR MAIN/SEG LBOEF NOP LIB ODD/EVEN SECOR FLAG LGTMP NOP PREVIOUS LG ODD/EVEN SEC FLAG LGOEF NOP CURRENT LG ODD/EVEN SECTOR FLAG LGOBF NOP LG ON GO REQ. FLAG #IDAD NOP ADDR OF LONG ID SEGMENT * SPC 1 IFN ******* BEGIN NON-MEU CODE **** N40 DEC -40 ******* END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN MEU CODE ******** N140 DEC -140 N34 DEC -34 P1000 DEC 1000 P21 DEC 21 M40 OCT 40 MES11 DEF *+1 ASC 9,00 PAGES REQUIRED MS11# EQU MES11+1 #PGS NOP # PAGES NEEDED IN PTTN #PTTN NOP REQUESTED PTTN NUMBER #PGPT NOP # PAGES IN PTTN #MPFT NOP MEMORY PROTECT FENCE TABLE INDEX #MNPG NOP LOWEST PAGE NO. USED BY PROG #MXPG NOP HIGHEST PAGE 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 # RSS ER.17 LDA ERR17 #PAGES REQ.>PTTN SIZE RSS ER.18 LDA ERR18 TOTAL PAGES > 32 JMP ABOR ERR16 ASC 1,16 ERR17 ASC 1,17 ERR18 ASC 1,18 ******* END MEU CODE ********** XIF 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 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 ADDR BKLWA EQU .+87 LWA OF MEMORY IN BG SPC 1 IFN ******* BEGIN NON-MEU CODE **** BPA1 EQU .+58 FWABP RT DISC RES BPA3 EQU .+60 FWABP BG DISC RES BKGBL OCT 1646 LWABP BG DISC RES URFWA EQU .+64 FWA OF USER RT DISC RES AREA URLWA NOP LWA OF USER RT DISC RES AREA UBFWA EQU .+68 FWA OF USER BG DISC RES AREA UBLWA EQU BKLWA LWA OF USER BG DISC RES AREA ******* END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN MEU CODE ******** 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 ******* END MEU CODE ********** XIF SPC 1 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 MAI*N 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: * * ************************************************************* * * NAME - * NAME - * NAME - *ENT/EXT FLG* * * * CHARS 1,2 * CHARS 3,4 * CHAR 5/ * 'V' BIT * * * * * * ORDINAL * ENT TYPE * SYMB VALU * * ************************************************************* * * EACH WORD IN THE LST ENTRY CONSISTS OF THE FOLLOWING: * * WORD 1: SYMBOL NAME - ASCII CHARACTERS 1,2 * BIT 15 = 1 MEANS THE ENTRY HAS BEEN LISTED * BIT 15 = 0 MEANS THE ENTRY HAS NOT BEEN LISTED * WORD 2: SYMBOL NAME - ASCII CHARACTERS 3,4 * WORD 3: (8-15) SYMBOL NAME - ASCII CHARACTER 5 * (0-7) EXT ORDINAL * 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 FORCE LOADING OF USER * PROGRAM. * 2 - EXT ENTRY (UNDEFINED SYMBOL). * 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 RELOCATIONA). * ENT TYPE (BITS 8 TO 15) - IS 0 FOR EXT ENTRY AND * 0 TO 4 (RELOCATION INDICATOR) FOR ENT SYMBOL. * WORD 5: BASE PAGE LINKAGE ADDR IF 'V' BIT IS SET * ELSE SYMBOL VALUE . * * INITIALLY, THE LOADER SYMBOL TABLE CONSISTS OF THE ENTRY POINTS * FOR THE LIBRARY ROUTINES IN THE RESIDENFT LIB AND THE * SYSTEM ENTRY POINTS (TYPE 1 ENT NOT PICKED UP). AS EACH * USER PROGRAM IS LOADED AND ENT/EXT RECS PROCESSED, SYMBOLS * ARE ADDED TO THE LIST. WHEN ALL USER PROGS HAVE * BEEN LOADED, AND LIB LOADING IS INITIATED, THE LOADER * SCANS LST FOR UNDEFINED SYMBOLS AND MATCHES THESE WITH THE * ENT SYMBOLS IN LIBRARY DIRECTORY. ON FINDING A MATCH, THE * LOADER LOADS THE CORRESPONDING LIB PROG AND ADDS ITS * ENT'S AND EXT'S TO THE LST. THIS PROCEDURE CONTINUES UNTIL ALL * UNDEFINED SYMBOLS HAVE BEEN DEFINED OR A COMPLETE PASS THROUGH * THE DIRECTORY FAILED TO RESOLVE ANY EXTERNAL . * FOR MAIN/SEGMENT LOAD, IF UNRESOLVED SYMBOLS STILL REMAIN * THEN THE ENTIRE LG AREA IS SCANNED FOLLOWING WHICH THE DISC * LIBRARY DIRECTORY IS AGAIN SCANNED - IF NEED BE. IF ANY * SYMBOL STILL REMAINS UNDEFINED AFTER THIS THEN IT LISTED * - EXCEPT FOR UNDEFINED SYMBOLS IN MAIN - AND THE LOADER * SUSPENDS. * IF THE LOADER IS OPERATING UNDER BATCH, ALL OUTPUT * THAT NORMALLY COMES ON THE SYSTEM CONSOLE GETS LISTED * ON LU 6. * * THE LST IS ORIGINED AT THE UPPER END OF THE LOADER AND EXTENDS * TOWARD HIGH CORE. AN IRRECOVERABLE ERROR IS DETECTED IF LST * EXTENDS PAST THE LAST WORD OF AVAILABLE MEMORY. * IN CASE OF ERROR THE LOADER PRINTS THE NAME OF THE MODULE * IN WHICH THE ERROR OCCURED, FOLLOWED BY THE ERROR CODE. * IN CASE OF ERRORS 7 & 15 , NAME OF THE ENTRY POINT CAUSING * THE VIOLATION IS ALSO PRINTED FOLLOWING THE MODULE NAME. * SKP * * LOADER INITIALIZATION SECTION * * LOADR IS SCHEDULED BY AN 'ON' STATEMENT HAVING * THE FOLLOWING FORMAT: * * 'ON,LOADR,P1,P2,P3,P4,P5' , WHERE: * * P1 = N, N IS THE LOGICAL UNIT NUMBER OF THE * BINARY INPUT DEVICE FOR LOADING * PROGRAMS. IF P1 = 0, UNIT #5 IS USED. * IF P1 = 99, LOAD FROM THE DISC * LOAD-AND-GO AREA. * * P2 = N, N IS THE LOGICAL UNIT NUMBER OF THE * LIST OUTPUT DEVICE FOR PRINTING * LOADING INFORMATION. IF P2 = 0, * UNIT #6 IS USED. * * P3 = N, N IS A CODE FOR THE TYPE OF OPERATION: UNL IFN LST * N IS A 2 DECIMAL DIGITS CODE (YZ) UNL XIF IFZ LST * N IS A 3 DECIMAL DIGITS CODE (XYZ) * 100'S DIGIT (X) - SUBSYSTEM GLOBAL AREA * --------------------------------------- * 0 - SSGA NOT USED (DEFAULT) * 1 - SSGA USED BY PROG (ONLY IN RTE-III) UNL XIF LST * * 10'S DIGIT (Y) - COMMON TYPE * ----------------------------- UNL IFN LST * 0 - DEFAULT RT COMMON FOR RT PROGS, * BG COMMON FOR BG PROGS * LOCAL COMMON FOR TEMPORARY LOADS UNL XIF LST UNL IFZ LST * 0 - DEFAULTS TO LOCAL COMMON !! (*** NOTE THIS ***) !! UNL XIF LST * 1 - SYSTEM COMMON * RT COMMON FOR RT PROGS, * BG COMMON FOR BG PROGS * 2 - LOCAL COMMON * 3 - REVERSE COMMON * RT COMMON FOR BG PROGS, * BG COMMON FOR RT PROGS * * DEFAULT * COMMON 1'S DIGIT (Z) - OPERATION CODE * ---------------------------------------- * 2 0 - BG TEMPORARY(DEFAULT) * 2 1 - BG TEMPORARY WITH DEBUG * 1 2 - ONLINE EDIT * - 3 - LIST PROGS * - 4 - PURGE PROG * 2 5 - REAL-TIME TEMPORARY * 1 6 - REAL-TIME REPLACE * 1 7 - REAL-TIME ADD NEW * 1 8 - BG REPLACE * 1 9 - BG ADD NEW * NOTE : VALUES N=13,14,23,24,33 AND 34 ARE INVALID. * * P4 = N, N IS THE STRUCTURE PARAMETER ! UNL IFZ LST * (5 DECIMAL DIGITS CODE XXYYZ) * XX - NUMBER OF PAGES REQUIRED * ----------------------------- * 00 - USE PROG SIZE (DEFAULT) * 01-32 - NUMBER OF PAGES * * YY - PTTN ASSIGNMENT * ------------------------- * 00 - NONE ASSIGNED (DEFAULT) * 01-64 - PTTN NUMBER * * Z - STRUCTURE * -------------- UNL XIF LST * 0 - MAIN PROG ONLY (DEFAULT) * 1 - BG MAIN+SEGMENT LOADING. * * P5 = 1, OMIT PROG NAME AND BOUNDS LIST * = 2, OMIT LIST OF ENTRY POINTS * = 3, OMIT BOTH * = 0, DO BOTH LISTINGS (DEFAULT) * PARAMETERS P3, P4 AND P5 DEFAULT TO ZERO IF OMITTED. * SKP * MESS7 DEF *+1 THIS MESS MUST PRECEDE MBUF ASC 11,DUPLICATE PROG NAME - MBUF BSS 66 NAM REC BUFFER MBUF1 EQU MBUF+1 SBUF BSS 128 DIRECTORY BLOCK BUFF XBUF BSS 128 DISC BUF FOR RELOCS DBUF BSS 128 DISC BUF FOR ABS LBUF BSS 128 RELOC IN, UREAD, COMP TRKS .BUF EQU * END OF BUFFERS IN OVERLAYED CODE * ORG MBUF PUT INIT CODE IN BUFFER LOADR LDA B,I SAVE STA PAM1 PARAMETER 1 INB LDA B,I CHECK PARAMETER STA PAM2 SAVE PARAMETER P2 SZA,RSS IF LIST DEVICE NOT GIVEN LDA P6 USE 6 IOR M200 ADD V BIT TO USE COLUMN ONE STA LISTU SET NEW LU. INB LDA B,I AND 3, STA OPCOD OPERATION CODE. INB LDA B,I AND 4, SPC 1 IFN * BEGIN NON-DMS CODE *************** AND P1 KEEP ONLY BIT 0 IF RTE-II *** END NON-DMS CODE *************** XIF SPC 1 STA MSEG (MAIN/SEGMENT FLAG) INB LDA B,I AND 5. STA PLIST (LIST/NO LIST) SPC 2 UNL * ************}E******DEBUGGING*********************** * EXT DBUG * AND P3 * CPA PLIST PARAM > 3 ? * JMP LOADP NO, NORMAL EXECUTION * STA PLIST YES, SET CORRECT PARAM * JSB DBUG WE WANT DDT ! * DEF *+1 LOADP EQU * * ******************DEBUGGING*********************** LST SPC 1 * JSB EXEC DEF *+3 INDICATE UNDECLARED CORE DEF P22 USAGE. DEF P3 JSB LGSET SET UP LG PARAMETERS LDA LGOC SET UP END OF LG AREA ADDR STA LGOCP FOR PROG INPUT STA LGOCL AND FOR LIB SCAN. CLB SET FLAG TO INDICATE SLA WHETHER LAST LGOC ENDED CCB ON ODD SEC BOUNDRY OR EVEN. STB LGOEF LDB XEQT (B)=ADDR OF LOADR'S ID SEG ADB P20 (B)=ID SEG'S WORD 21 ADDR LDA B,I GET WORD 21 TO CHECK BIT 15 LDB LISTU (B)=LIST LU CONTROL WORD SSA IF LOADR RUNNING UNDER BATCH STB LIST1 THEN SYSOUT DEVICE IS LIST LU. CLB SSA SET 'BATCH' FLAG TO NON-ZERO CCB IF RUNNING UNDER BATCH STB BATCH LDA PLIST CHECK PARAM 5 SSA IF NEGATIVE JMP LDI5 THEN INPUT ERROR ADA N4 SSA,RSS IF GREATER THAN 3 JMP LDI5 THEN INPUT ERROR. LDA PLIST ARS SET FLAG STA ENFLG FOR ENTRY POINT LISTING. LDA PAM1 CHECK PRAM 1. SZA,RSS IF ZERO, GO TO CHECK #2, JMP LDI2 LEAVE INPUT AS LU 5. CPA P1 IF INPUT IS SYS TTY, JSB CHKP1 TREAT AS ERROR UNLESS P3=3 OR 4. CPA P2 IS THIS TO THE DISK JMP LDI5 JUST WHO DO YOU THINK YOUR KIDDING?????? LDB P2 CPA P99 IF PARAM STA LGO WORD. CPA P99 IF LG TO BE USED STB LGOU SET 'LG IN USE' FLAG * LDI2 LDB XEQT (B)H=ADDR OF LOADR'S ID SEG ADB P23 (B)=ADDR OF LOADR'S HIGH MAIN LDA 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 LDA B,I GET LOADR'S PROG TYPE LDB RTLWA GET ADDR OF LOADR'S LAST WORD SPC 1 IFN ******* BEGIN NON-MEU CODE **** ADB N1 SUBTR 1 FOR RTE-II STB URLWA ******* END NON-MEU CODE ****** XIF SPC 1 SLA SKIP IF LOADR IS FG LDB BKLWA ELSE GET LWA OF BG. STB BKLWR SET AS LWA AVAILABLE TO LOADR LDA OPCOD GET P3 OF 'ON' REQUEST. SPC 1 IFN ******* BEGIN NON-MEU CODE **** ADA N40 ADD -40 TO CHECK RANGE ******* END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN MEU CODE ******** ADA N140 ADD 140 (MAX WITH SSGA) ******* END MEU CODE ********** XIF SPC 1 SSA,RSS IF OPCODE > 39 JMP LDI5 THEN INPUT ERROR LDA OPCOD GET P3 AGAIN CLB .MBUF EQU *-MBUF OVERLAY PROBLEM? STB MBUF CLEAR "VALID MODULE NAME PRESENT" FLAG DIV P10 GET 'COMMON TYPE' (REG-A) AND STA COMTP SAVE IT. STB OPCOD 10-119 RANGE IN 'OPCOD' ADB OPTBL ADD TABLE BASE ADDR TO OPCODE LDB B,I RESOLVE INDIRECT JMP B,I GO TO PROPER PROCESSOR * OPTBL DEF *+1 DEF BGTMP 0=BG TEMPORARY DEF DBGF 1=BG TEMP WITH 'DEBUG' DEF LEDIT 2=EDIT WITH "GO" REQUEST DEF LLIST 3=LIST ID SEGMENTS DEF LDI3 4=PURGE PROG DEF FGTMP 5=FG TEMPORARY DEF FGRPL 6=FG REPLACE DEF FGNEW 7=FG ADD NEW DEF BGRPL 8=BG REPLACE DEHFBF BGNEW 9=BG ADD NEW * DBGF ISZ DBFLG SET DEBUG FLAG BGTMP JMP LEDT3 TREAT AS BG TEMPORARY BGNEW CLB,INB,RSS EDIT FLAG = 1 FOR NEW BG BGRPL LDB P2 EDIT FLAG = 2 FOR REPLACE STB EDFLG SET PROPER EDIT FLAG JMP LEDT3 SET COMMON BOUNDS * FGNEW CLB,INB,RSS EDIT FLAG = 1 FOR ADD FGRPL LDB P2 EDIT FLAG = 2 FOR REPLACE STB EDFLG SET PROPER EDIT FLAG FGTMP LDB P2 STB PTYPE SET PROG TYPE = 2 JMP LEDT3 SET COMMON BOUNDS * * NORMAL ON-LINE LOADING OPERATION * LEDT3 EQU * SPC 1 IFZ ******* BEGIN MEU CODE ******** LDA MSEG GET PARAM P4 CLB DIV P1000 SAVE # PAGES REQ. STA #PGS 00XXX-32XXX LDA B CLB DIV P10 SAVE PTTN # REQ. STA #PTTN XX00X-XX64X STB MSEG SAVE XXXX0-XXXX1 * CCB GET ADDR MAP TABLE - 1 ADB $MATA WHERE # OF PART. IS KEPT SZA,RSS WAS PTTN# SPECIFIED? JMP NOPTN NO, DO SIZE CHECK LATER SPC 2 * PARTITION WAS SPECIFIED FOR THIS PROG * LDA B,I YES, DO SIZE CHECK NOW CMA ADA #PTTN SSA,RSS ERR16 IF PTTN# > #PTTNS JMP ER.16 * H CCA ADA #PTTN 6 * (PTTN# - 1) + $MATA MPY P6 IS ADDR OF ENTRY ADA $MATA IN MAP TABLE LDB A,I (A) IS ADDR MAP ENTRY SSB IF ENTRY NOT DEFINED, JMP ER.16 GIVE ERR16 * ADA P4 BUMP TO WORD 5 LDB A,I RBL,CLE,ERB REMOVE RESERVED FLAG STB #PGPT SAVE #PAGES IN PTTN CMB ADB #PGS ENOUGH PAGES IN SSB SPECIFIED PTTN? JMP PGSOK YES SZB OK IF EQUAL LDB #PGS NO, BUT WAS SPECIFIC SZB SIZE REQUESTED? JMP ER.17 YES, CAN'T FIT! * *PGSOK INA * LDB A,I * LDA P2 * SSB,RSS * INA * CPA PTYPE PTTN TYPE SAME * RSS SAME AS PROG TYPE? * JMP ER.16 NO, ERR16 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 LDA B,I NO PTTN SPECIFIED CMA,INA,SZA,RSS FIND MAX OF EACH TYPE JMP ER.16 ERROR IF NO PTTNS DEFINED STA WDCNT SAVE NEG # PTTNS INB NXPTN STB TBUF SAVE CURR PTTN DEF ADDR LDA TBUF,I SSA IS PTTN DEFINED? JMP A6PTN NO, SKIP THIS ENTRY ADB P4 LDA B,I GET WORD 5 SSA IF RESERVED, SKIP IT JMP A6PTN CAUSE WE GOT NO RESERVATION * INB LDB B,I GET WORD 6 SSB,RSS FIND TYPE OF PTTN: JMP BGPTN LDB A RT PTTN CMB,INB ADB #MXRT RT PTTN SIZE SSB BIGGER THAN PREVIOUS MAX? STA #MXRT YES, SAVE NEW MAX JMP A6PTN CHECK NEXT PTTN DEFINITION * BGPTN LDB A BG PTTN CMB,INB ADB #MqXBG BG PTTN SIZE SSB BIGGER THAN PREVIOUS MAX? STA #MXBG YES, SAVE NEW MAX * A6PTN LDB TBUF ADB P6 INCRE TO NEXT PTTN DEFINITION ISZ WDCNT SEARCH THROUGH UNTIL DONE JMP NXPTN * * CMMST LDA COMTP GET COMMON TYPE CLB DIV P10 DIV BY 10 AGAIN STB COMTP TO GET ONLY 2ND DIGIT STA #MPFT SAVE TO DETERMINE FENCE INDEX ADA B SZA ANY TYPE OF COMMON USED? JMP CMUSE YES LDA $ENDS NO COMMON USED ALF,ALF SHIFT #PAGES IN SYS RAL,RAL TO GET ADDR OF NEXT PAGE JMP CMNCM SET FWA USER CMUSE LDA BKORG SSGA OR COMMON ADA BKCOM WAS USED ADA M1777 USE ADDR OF NEXT PAGE AND M0760 AFTER COMMON FOR CMNCM STA URFWA SET FWA USER RAL,RAL SHIFT PAGE NO. TO ALF LOW BITS ADA #PGS ADD SPECIFIED PAGE NO. ADA N34 TOO BIG?? SSA,RSS WELL? JMP ER.18 YES TOO BAD BETTER LUCK NEXT TIME. * LDA URFWA RESTORE LOAD POINT TO A * 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 ******* END MEU CODE ********** XIF SPC 1 LEDT4 LDB EDFLG GET EDIT FLAG LDA COMTP GET COMMON TYPE SZA,RSS COMMON SPECIFIED ? JMP DFLCM NO, SET DEFAULT TYPE. CPA P2 LOCAL COMMON ? JMP LCLCM YES, SET LOCAL COMMON. SYSCM LDB P2 SET (B)=2 FOR SYSTEM COM CPA P3 REVERSE COMMON ? LDB P3 YES, SET REVERSE COMMON. LDA BKCOM (A) = LEN OF BG8 SYS COMM CPB PTYPE BG PROG ? LDA RTCOM YES, SET (A)=LEN OF FG COMM STA MXCOM SET MAXIMUM LEN OF COMMOM LDA BKORG ALSO SET ORIGIN CPB PTYPE OF THE RESPECTIVE LDA RTORG COMMON AREA. STA COMAD JMP CMEXI FINISH UP COMMON STUFF DFLCM EQU * SPC 1 IFN ******* BEGIN NON-MEU CODE **** SZB EDIT OPERATION ? JMP SYSCM YES, SET SYSTEM COMMON. ******* END NON-MEU CODE ****** XIF SPC 1 LCLCM CCA SET LOCAL COMMON FLAG STA COMIN TO ALLOC AT NAM REC SPC 1 IFZ ******* BEGIN MEU CODE ******** CLA (A)=0 IF LOCAL COMMON JMP CMLOC ******* END MEU CODE ********** XIF SPC 1 * CMEXI EQU * SPC 1 IFZ ******* BEGIN MEU CODE ******** LDA P3 (A)=3 IF BG COMMON CPB PTYPE LDA P2 (A)=2 IF RT COMMON CMLOC LDB #MPFT (A)=0 IF LOCAL COMMON SZB LDA P4 (A)=4 IF SUBSYSTEM GLOBAL AREA STA #MPFT SET MPFT INDEX ******* END MEU CODE ********** XIF SPC 1 * LDB PTYPE CPB P3 IF BG PROG JMP LDI3 THEN GO SET UP BG BOUNDS. * * RT REPLACEMENT OR ADDITION * LDA URFWA SET FWA USER RT DISC RES STA AFWA ORIGIN AS ABS. FWA AND LDA URLWA LWA USER RT DISC RES STA LWA LDA BPA1 SET FWA OF RT LINK AREA STA BPFWA AS REAL BP ADDR. STA BPREL AND BP REL BASE. CMA,INA CALCULATE # OF WORDS ADA BPA2 IN LINK AREA, LDB MSEG IF 'MSEG' FLAG = 0, (P4) SZB,RSS THEN GO TO JMP LDI4 COMPLETE SETUP. JMP LEDT1 ---CONFLICT IN PARAMETERS. * * BG REPLACEMENT OR ADDITION * LDI3 LDA UBFWA SET FWA USER BG DISC RES STA AFWA ORIGIN AS ABS FWA + LDA UBLWA SET UPPER STA LWA B9OUND. LDA BPA3 GET FWA OF BKG BASE PAGE AREA STA BPREL SET BASE PAGE RELOCATION BASE STA BPFWA SAVE IT CMA,INA AND SUBTRACT FROM LWA OF ADA BKGBL LINK AREA. * LDI4 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 MEM. ADD. STA PPREL MODULE BASE * LDB OPCOD IF THIS IS A PURGE CPB P4 THEN JMP PURGE GO DO IT SKP * * CALCULATE THE BLOCK NUMBER WHERE THE LIB DIRECTORY STARTS * AND THE POSSIBLE OFFSET IN NUMBER OF ENTRYS TO ACCOUNT FOR * AN ODD STARTING SECTOR. SPC 1 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" * 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 LDA MSEG (A)= MAIN/SEGMENT FLAG LDB P2 ASK 2 TRKS FOR SINGLE PROG LOAD SZA BUT IF DOING MAIN/SEG LOOADING ADB P2 THEN ASK FOR 4 TRACKS STB #TRAK INITIALLY. 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 'DEBUG' INTO LST * JSB LSTX SET CURRENT LST ADDRES NOP LDA CHRDE GET CHARS D,E 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 PAM1 GET THE INPUT PARAM CPA P99 IF LG AREA FOR INPUT JMP LDRN2 THEN READ FROM LG TRACKS. JMP JREAD ELSE READ FROM GIVEN INPUT UNIT. * CHKP1 NOP CHECK OPERATION VALIDITY IF P1 = 1 LDA OPCOD CLB DIV P10 GET OPERAND IN (B) LDA PAM1 RESTORE (A) CPB P3 ID SEG LIST OPTION ? JMP CHKP1,I YES - THEN OK RETURN CPB P4 PURGE OPTION ? JMP CHKP1,I YES - THEN OK RETURN JMP LDI5 SKP * * INITIALIZE CONDITIONS FOR EDITING OPERATIONS * LEDIT LDA P26 PRINT MESSAGE: LDB MESS6 "GO" WITH EDIT PARAMETERS JSB SYOUT ON SYSTEM TTY. CCB JSB EX&EC CALL FOR DEF *+2 PROG SUSPENSION. DEF P7 * * THE "GO" STATEMENT EXPECTED HAS 3 POSSIBLE PARAMETERS: * * GO,LOADR,P1,P2,P3 , WHERE: * * P1 = 1 FOR ADDITION, OR * 2 FOR REPLACEMENT * * P2 = 2 FOR REAL-TIME DISC RESIDENT, OR * 3 FOR BACKGROUND DISC RESIDENT * * P3 = N , WHERE N IS AN OVER-RIDING PRIORITY * DESIGNATION, 0 < N < 9999. IF * P3 IS NOT PRESENT OR = 0, THE * VALUE FROM THE NAM REC OF THE * MAIN PROG IS USED OR 9999 IF THE * NAM VALUE = 0. * * ANY ERRORS DETECTED CAUSE DIAGNOSTIC 'L10' TO * BE PRINTED AND THE MESSAGE REPEATED. * * SSB,RSS IF NO PARAMETERS INPUT, SKIP JMP LEDT2 -GO TO CHECK PARAMETERS. * LEDT1 LDA ERR10 PRINT ERROR DIAGNOSTIC JSB ERROR "L10" JMP LEDIT AND REPEAT. * LEDT2 LDA B,I SET TYPE STA EDFLG OF EDIT FLAG. CPA P1 CHECK RSS FOR CPA P2 = 1 OR 2 RSS -YES, JMP LEDT1 -NO,ERROR. * INB SET FOR PARAM # 2. LDA B,I SET CODE FOR STA PTYPE PROG TYPE. CPA P2 CHECK RSS FOR CPA P3 = 2 OR RSS 3. JMP LEDT1 -NO, ERROR. * INB GET LDA B,I P3 PARAMETER. LDB P9999 INITIALIZE PRIORITY SZA,RSS IF 0, JMP LEDT3 ASSUME 9999 CMB SET B = -10000 ADB A SUBTRACT 10000 FROM SSB,RSS P3. IF POSITIVE RESULT, THEN JMP LEDT1 ERROR, P3 >= 10000 STA PPRI SET NEW PRIORITY. JMP LEDT3 * * 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: * "5 SYSTEM PROGRAM LIST: NAME, TYPE, PRIORITY" * * EACH LINE OF OUTPUT FOR A DEFINED ID SEGMENT IS: * " PNAME T PR" , T IS TYPE AND PR IS PRIORITY. * * A BLANK ID SEGMENT (AVAILABLE FOR USE) IS * NOTED BY THE LINE OUTPUT: * "" OR "" * * LLIST JSB SPACE LDB LLM1 PRINT SPC 1 IFN ******* BEGIN NON-MEU CODE **** LDA P42 HEADING ******* END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ ******* BEGIN MEU CODE ******** LDA P54 ******* END MEU CODE ********** XIF SPC 1 JSB DRKEY JSB SPACE JSB SPACE * LDA KEYWD SAVE STARTING STA ABT1 KEYWORD ADDR. * LL1 LDB ABT1,I GET ID SEGMENT ADDR. SZB,RSS IF END-OF-LIST, GO TO SINGLE JMP EXIT TERMINATION * ADB P12 SET TO NAME AREA. LDA B,I GET NAME 1,2, STA LLM2+2 SET IN MESSAGE. SZA,RSS IF NAME WORD = 0, THEN JMP LL3 BLANK ID SEGMENT. INB LDA B,I SET NAME 3,4 STA LLM2+3 IN MESSAGE. INB LDA B,I GET NAME 5, AND M7400 ISOLATE, IOR BLANK ADD BLANK STA LLM2+4 AND STORE. * LDA B,I GET TYPE AND M7 CODE. STA B SAVE PROG TYPE IOR M60 MAKE ASCII, IOR UBLNK ADD UPPER BLANK, STA LLM2+5 AND STORE. LDA P12 OUTPUT LEGTH=12 CHAR FOR SEG CPB P5 IF PROG TYPE IS SEG JMP T5SEG THEN FORGET PRIORITY. * LDB ABT1,I GET ADB P6 "PRIORITY" LDA B,I WORD. LDB LLM2 GET BUFFER ADDR ADB P6 FOR CONVERSION ROUTINE JSB CONVD CONVERT TO DECIMAL SPC 1 IFZ ******* BEGIN MEU CODE ******** LDB ABT1,I GET ID SEG ADDR ADB P21 OF WORD 22 LDA B,I SSA,RSS ANY PTTN RESERVED? JMP LL4 NO AND M77 YES, GET PTTN# INA ADD 1 FOR REAL PTTN# JSB CNV99 CONVERT TO DECIMAL STA LLM2+10 ASCII AND SET LDA P20 FOR PRINTING RSS ******* END MEU CODE ********** XIF SPC 1 LL4 LDA P18 PRINT NAME T5SEG LDB LLM2 LINE JSB DRKEY * LL2 ISZ ABT1 GET NEXT KEYWORD ADDR. JMP LL1 -REPEAT SCAN. * * OUTPUT BLANK ID MESSAGE * LL3 ADB P2 (B)=ADDR OF NAM5 WORD LDA 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 * PURGE CLA,INA GO SET CLB JSB SETID ID ADDRS FOR LONG ID LDA A? SET ASC ? IN STA LLM2+5 MESSAGE LDA PAM1 GET INPUT PARAMETER P1 SZA INPUT SPECIFIED ? JMP USEIM YES - GO USE IT. LDB BATCH GET BATCH FLAG INA SET FOR LU1 SZB RUNNING UNDER BATCH ? LDA P5 YES-THEN DEFAULT INPUT TO LU 5 SZB,RSS RUNNING UNDER BATCH? USEIM STA LIST1 NO, SET PROMPT LU IOR M400 SET UP ECHO BITS STA INDLU SET UP INPUT LU. TRYAG LDA P10 SEND THE MESSAGE LDB LLM2 LOADR: PNAME ? JSB SYOUT TO THE OUTPUT DEVICE JSB EXEC READ THE REPLY DEF *+5 TO THE DEF P1 DEF INDLU DEF NAM12,I NAME AREA IN THE ID SEGMENT DEF P3 THREE WORDS ADB NAM12 ADD THE BUFFER ADDR TO THE TLOG LDA LLM2+1 GET A DOUBLE BLANK STA B,I BLANK UN SENT NAME CHARACTERS INB STA B,I 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 NOPGM NO GO SEND MESSAGE JMP ED0 GO PURGE THE PROG SPC 1 NOPGM LDA ERR10 INPUT ERROR JSB ERROR JMP TRYAG TRY AGAIN * * * A? ASC 1,?_ ASC "?_" SPC 2 LLM1 DEF *+1 ASC 17, SYSTEM PROG LIST: NAME, TYPE, ASC 4,PRIORITY SPC 1 IFZ ******* BEGIN MEU CODE ******** ASC 6,, PARTITION PART OF LLM1 P54 DEC 54 ******* END MEU CODE ********** XIF SPC 1 /A ASC 1,/A * LLM4 DEF *+1 ASC 9, LLM3 DEF *+1 ASC 9, LLM2 DEF *+1 ASC 10, PNAME T PRIO PT * * * * ****************************** SPC 1 IFZ ******* BEGIN MEU CODE ******** OVLYC BSS .BUF-* OVERLAYABLE CODE LEFT ******* END MEU CODE ********** XIF SPC 1 SPC 1 IFN ******* BEGIN NON-MEU CODE **** BSS .BUF-* IF NOT ENOUGH, UP IT ******* END NON-MEU CODE ****** XIF 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 SKP MESS1 DEF *+1 ASC 4,LOAD LIB * * PRINT 'LOAD', SUSPEND LOADER * TREAD LDA P4 TRED1 LDB MESS1 MESS1 = ADDR: LOAD JSB SYOUT PRINT: LOAD SUSP CCB JSB EXEC REQUEST PROG SUSPENSION DEF *+2 DEF P7 7 = OPERATOR-SUSPEND CODE * * * AT THIS POINT THE LOADER IS READY TO LOAD FROM EITHER * THE PROGRAM INPUT UNIT, THE LOAD-AND-GO AREA, * OR THE PROGRAM LIBRARY. THE INDICATION IS * MADE BY THE FIRST PARAMETER IN THE "GO" STATEMENT: * * "GO,LOADR,P1,P2,[P3]", WHERE * * P1 = N , N IS A CODE DESIGNATING THE NEXT * OPERATION: * * 0 - LOAD FROM BINARY INPUT UNIT * 1 - LOAD REFERENCED LIB PROGS * ( 2 - LOAD FROM LOAD-AND-GO AREA (LG NOT RESET) * 3 - LIBRARY LOAD FOR THE LAST SEGMENT * IN A MAIN SEGMENT LOAD. * 4 - IGNORE UNDEFINED EXTERNALS * 98 - LIST UNDEFINED EXTERNALS * 99 - USE LOAD-&-GO FOR INPUT FROM START * (LG AREA HAS BEEN RESET AND WAS * NOT PREVIOUSLY USED FOR INPUT). * X - IF NOT ANY OF ABOVE THEN 'X' IS * THE NEW PROG INPUT UNIT. * * P2 = 1 OMIT LIST OF ENTRY POINTS AT END OF LOADING * * P3 = 1 SCAN SPRCIFIED INPUT FOR LIB * * CARDINAL RULES FOR USING LG TRACKS * ---------------------------------- * * 1. IF LG TRACKS HAVE ONCE BEEN USED FOR FORCE LOADING, * THEY MUST NOT BE RESET WITH THE SYSTEM 'LG,X' COMMAND. * * 2. P1 = 99 MUST BE USED IF LG TRACKS HAVE BEEN RESET * WITH THE SYSTEM 'LG,X' COMMAND AND P1 = 2 MUST BE * USED IF LG TRACKS HAVE NOT BEEN RESET. * * REMEMBER THAT ANYTHING GIVEN TO THE LOADER DURING THE * 'ON' COMMAND IS AUTOMATICALLY FORCE LOADED. P3 IN THE * ABOVE GO COMMAND DEFAULTS TO 0 (FORCE LOAD) IF NOT * SPECIFIED. SKP * * * NOTE: P1=2 SHOULD BE USED IF ADDITIONAL INPUT HAS * TO BE APPENDED TO THE LG AREA. IN OTHER WORDS * P1=99 HAS BEEN USED PREVIOUSLY (EITHER IN THE * ON REQUEST IF ORIGNAL INPUT WAS FROM LG, OR * IN THE GO REQUEST IF ORIGNAL INPUT WAS NOT * FROM THE LG AREA). * IN A MAIN/SEG LOAD AFTER THE LAST SEG HAS BEEN * FORCE LOADED IN (EITHER AUTOMATICALLY WITH * LG OPERATION OR UNDER DIRECTION OF THE OPERATOR * HAVING TOLD THE LOADER TO SCAN LIB FOR THE * LAST SEGMENT - GO WITH P1=3), NO MORE FORCE * LOADING CAN BE DONE EITHER FROM THE LG AREA * OR FROM PROGRAM INPUT DEVICE. * IF UNDEFINED EXTERNALS REMAIN IN THE MAIN * OF A SEGMENTED PROG (WHICH THE LOADER * DISCOVERS AFTER LOADING THE LAST SEGMENT) * ,AND PRINTS "MAIN - UNDEFINED EXTS", THEY * CAN NOT BE SATISFIED AND THE ONLY RESPONSE * THAT CAN BE ENTERTAINED AT THAT TIME IS * 'GO' WITH P1=98 OR 4. SINCE THE LOADER SCANS THE * LG TRACKS FOR A MAIN SEGMENT LOAD, ONLY ONE COPY * OF A SUBROUTINE USED BY SEVERAL SEGMENTS NEED BE * PRESENT. AS LONG AS THE MAIN IS READ IN FIRST, THE * ORDER OF SEGMENTS AND THEIR SUBROUTINES IS ALSO * NOT IMPORTANT (SO LONG YOU DON'T CARE ABOUT UNWANTED * SUBROUTINES BEING ATTACHED TO THE SEGMENTS). RECALL * THAT EVERYTHING GIVEN DURING THE 'ON' REQUEST GETS * FORCE LOADED THUS IF UNWANTED SUBROUTINES EXIST * BETWEEN CONSQUETIVE SEGMENTS AND BETWEEN THE LAST * SEGMENT AND THE END OF LG AREA , THEY GET FORCE LOADED * WITH THE PREVIOUS SEGMENT. IF ADDITIONAL LIB IS * APPENDED THEN, HOWEVER, THAT DOES NOT GET FORCE LOADED. * * * P3 IS APPLICABLE ONLY IF P1 IS NOT 1, 3, 4 OR 98. * * IF LIBRARY IS READ FROM OTHER THAN THE LG TRACKS, IT * SHOULD BE REPEATEDLY INPUT TILL THE LOADER PRINTS 'LOAD' * INSTEAD OF 'LIB LOAD'. * * IF LOADING FROM THE PROG INPUT UNIT, THE DEVICE * SHOULD BE MADE READY BEFORE THE 'GO' STATEMENT IS * ENTERED ON THE SYSTEM TELETYPE TO INITIATE LOADING * SKP * NEWIN CLA STA LIBFL CLEAR LIB SCAN FLAG SSB SKIP - SOME PARAMETERS ENTERED JMP KREAD LOAD FROM PROG INPUT UNIT LDA B,I GET "P1". CPA P1 IF = 1 JMP LOADL OR CPA P3 = 3, JMP LOADL GO TO LOAD FROM LIB. CPA P4 IF = 4 JMP FIXCL THEN IGNORE UNDEFINED EXTS CPA P98 IF = 98 JMP LSTEX THEN LIST UNDEFINED EXTERNALS STA LLM2 SAVE P1 TEMPORARILY INB LDA B,I GET P2 (LIST,NO LIST) SZA SKIP IF NOT SET STA ENFLG SET NO LIST FLAG INB LDA B,I GET P3 (LIB LOOK PARAM) SZA,UHFBRSS P3 = ZERO ? JMP GETP1 YES,THEN FORGET IT. CCA STA LIBFL YES, SET LIB FLAG. STA NUPLS # OF LIB PROG LOADED=-1 STA PLFLG 'LOOKING FOR NAM FIRST' GETP1 LDA LLM2 GET P1 BACK CPA P2 USE LG FOR INPUT ? JMP PRC2 YES (FROM LG WITHOUT RESETTING). CPA P99 FROM LG AREA FROM START ? JMP PRC99 YES (LG SHOULD HAVE BEEN RESET). JREAD SZA,RSS IF P1=0, JMP KREAD LOAD FROM INPUT IOR M300 SET THE BINARY AND V BITS STA PGMIN SET NEW INPUT LU IOR M400 SET EOT CONTROL WORD STA SEOT * KREAD JSB EXEC SET EOT ON INPUT UNIT DEF *+3 DEF P3 DEF SEOT * CLA SET FLAG FOR 'LG NOT BEING USED' STA LGOU * IREAD LDA PLIST GET LIST/NO LIST FLAG SLA,RSS SKIP - OMIT LISTING JSB SPACE NEW LINE ON LIST OUTPUT DEVICE * LDRIN LDA LGOU GET 'LG USE' FLAG SZA LG BEING USED FOR INPUT ? JMP LDRN2 YES, READ FROM LG AREA. 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 P128 BUFFER LENGTH = 64 WORDS * AND M240 EOF OR EOT? SZA NO JMP REDL? YES, CHECK IF LIB READ. SZB SKIP - NO WORDS TRANSMITTED JMP TESTR TEST REC TYPE PQHREDL? LDA LIBFL GET LIB SCAN FLAG SZA,RSS IF NOT READING LIB JMP TREAD THEN PRINT "LOAD". ISZ NUPLS ELSE ANYTHING READ IN LAST SCAN ? RSS YES - NEED TO READ LIB AGAIN. JMP TREAD NO - THEN READY FOR PROG INPUT. LDA P8 GO PRINT "LOAD LIB" JMP TRED1 * M240 OCT 240 * FIXCL LDA MSEG FOURCE LOAD WITH SZA,RSS UNDEFINED EXTS MUST CLEAN JMP NODEX UP THE FIXUP TBL. IF SEGMENT * 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 * SKP * * PROCESS FOR P1=2. ADDITIONAL INPUT APPENDED TO LG. * LG TRKS SHOULD NOT HAVE BEEN RESET & MUST HAVE BEEN * USED FOR INPUT PREVIOUSLY BY P1=99 EITHER IN THE * 'ON' REQUEST OR 'GO' REQUEST. ADDITIONAL INPUT * CAN BE EITHER FOR LIB SCAN OR FOR FORCE * LOADING (WITH THE CONSTRAINT REGARDING UNDEFINED * SYMBOLS DISCOVERED IN THE LAST SEGMENT OF A * MAIN/SEG LOAD , IN WHICH CASE ADDITION TO LG MAY * ONLY BE FOR LIBRARY SCAN AND P3 MUST BE SPECIFIED AS 1). * LIMST LDA MSEGF GET FLAG FOR 'LAST SEG LOADED' CPA P3 LOADED LAST SEGMENT ? SZB YES - THEN IS LIB SCAN WANTED ? JMP GOON YES - THEN WE CAN HACK IT. JMP LD13 NO - BOMB HIM (COULD HAVE SEGS THERE) * PRC2 LDA LGO SZA,RSS LG PREVIOUSLY BEEN USED ? JMP LD12 NO - ERROR L12. LDB LIBFL GET LIB FLAG SSA,RSS USED PREVIOUSLY FOR FORCE LOAD ? JMP LIMST YES - CHECK IF LIB SCAN WANTED. GOON SZB NO - THEN WANT LIB SCAN AGAIN ? JMP LIBAG YES (LET LGO BE -1) LDA P99 NO - THIS IS PROG ADDITION. STA LGO SET LGO=99 (AS IF LG FROM START). LIBAG STB DREAD SAVE REG-B TEMPORARILY CLB,INB STB LGOBF SET FLAG THAT WE WERE HERE LDB LGOEF GET PREVIOUS FLAG STB LGTMP AND SET FOR CURRENT INPUT. JSB LGRES RESTORE LG - EXCEPT TRK & SEC! LDA LGOCL GET LAST ADDR OF END OF LG FOR LIB ALF,ALF GET STARTING TRACK ADDR TO RAL WHERE CURRENT APPEND TO LG AND M377 BEGINS AND SET UP. STA LGTRK LDA LGOCL ALSO GET STARTING SECT ADDR - BUT ERA,CLE,ELA BACK UP ONE SECT IF START IS AND M177 ON ODD SECT BOUNDARY. LGTMP WILL STA LGSEC TAKE CARE OF STARTING CORE ADDR. LDA LGOC UPDATE LDB DREAD RESTORE REG-B SZB,RSS SKIP IF ONLY LIB STA LGOCP END OF LG ADDR FOR PROG INPUT STA LGOCL END OF LG AREA FOR LIB SCAN. RDLGO LDA P2 STA LGOU SET FLAG FOR LG IN USE LDA XBUFA FORCE NEW SECTOR READ STA XCUR CLA STA XCNT LDA LGOC CLB SET FLAG TO INDICATE WHETHER SLA LAST LGOC ENDED ON ODD OR CCB EVEN SECTOR BOUNDRY. STB LGOEF JMP IREAD READ FROM LG AREA * SKP * * PROCESS P1=99 ON 'GO'. LG HAS BEEN RESET - IT * SHOULD NOT HAVE BEEN USED BEFORE FOR FORCE LOADING. * (THE FLAG WORD LGO USED FOR THIS PURPOSE SHOULD BE * ZERO OR -1. IF -1 THEN THE PREVIOUSLY PUT * LIBRARY ON LG HAS BEEN OVERWRITTEN AND USER * IS EXPECTED TO BE AWARE OF THIS). * PRC99 LDA LGO CPA P99  LG ALREADY USED FOR FORCE LOAD ? JMP LD13 YES - THEN ERROR L13. JSB LGSET NO, THEN SET UP START OF LG ADDR. LDA LGOC SET STA LGOCP END OF LG FOR FORCE LOAD STA LGOCL END OF LG FOR LIB SCAN. LDA LIBFL GET LIB FLAG ( P3 IN 'GO') LDB P99 LGO = 99 FOR FORCE LOAD SZA SKIP IF PROG LOAD CCB LGO = -1 FOR LIB SCAN STB LGO SET PROPER LGO CLB STB LGOBF CLEAR ODD/EVEN FLAGS STB LGTMP JMP RDLGO * SKP * * * INPUT FROM DISC LOAD-AND-GO AREA * LDRN2 LDB XCUR IF CURRENT ADDR. OF XBUF = CPB XBUFA FWA OF XBUF, JMP LDRN3 READ NEXT SECTOR CPB XBHLF =HALF THE ADDR OF XBUF ? RSS YES - LOOK IF END OF LG JMP LDRN4 NO - THEN BUFFER ALREADY IN CORE LDB SLIBF IF READING FROM SYS LIB SZB (WILL NEVER BE HERE FOR NAM) JMP LDRN4 THEN STUFF ALREADY IN CORE CCB ELSE CHECK FOR END OF LG ADB LGSEC LDA LGTRK ALF,ALF RAR IOR B LDB LIBFL STA BID2 SAVE ADDR LDA LGOCP END LG ADDR FOR FORCE LOAD SZB IF SCANNING LG AS LIB LDA LGOCL THEN END LG ADDR FOR LIB SCAN ELA,CLE,ERA REMOVE LU BIT CPA BID2 REACHED THE END ? RSS YES JMP LDRN4 NO - THEN STUFF ALREADY IN BUFFER LDB LGSEC SET UP LG ADDRS FOR POSSIBLE LGSAV CPB LGS# CLA,RSS JMP *+3 NO TRK BOUNDRY SO SKIP STA LGSEC ISZ LGTRK LDB LIBFL GO TO LDRN9 WITH LIB FLG IN B JMP LDRN9 DETERMINE NEXT MOVE * LDRN3 LDB LGSEC CHECK CURRENT SECTOR #. CPB LGS# IF CURRENT = LAST SECTOR, CLB,RSS SKIP JMP LDRN8 GO TO INPUT SECTOR. STB LGSEC RESET SECTOR # TO ZERO ISZ LGTRK  ADD 1 TO TRACK # * * CONTINUE IF READING LIB. * IF END OF LOAD-AND-GO AREA, GO TO PRINT * 'LOAD' OR TO LOAD LIB. * LDRN8 LDA SLIBF (B) = CURRENT SECTOR # SZA READING SYSTEM LIB? JMP LDRN6 YES, CONTINUE. LDA LGTRK NO, TEST FOR END OF LG ALF,ALF RAR TRACK # IN 14-07 IOR B SECTR # IN 06-00. STA BID2 SAVE CURR LG ADDR TEMPORARILY LDA LGOCP (A)= END OF LG ADDR FOR PROG INPUT LDB LIBFL GET LIB SCAN FLAG SZB IF SCANNING LG AS LIB LDA LGOCL THEN (A)=END OF LG ADDR FOR LIB SCAN ELA,CLE,ERA REMOVE LU BIT CPA BID2 REACHED END OF LG AREA ? RSS YES - SKIP JMP LDRN6 NO - THEN CONTINUE LG READ LDRN9 SZB IF SCANNING LG AS LIB JMP LBSCN THEN FIND OUT NEXT MOVE. JSB LGSAV ELSE SAVE END OF LG ADDR LDB MSEG GET MAIN SEGMENT FLAG SZB,RSS IF SINGLE PROG JMP RETRN THEN USER TRACKS NOT TO BE SCANNED. LDB P3 SET FLAG FOR LAST SEGMENT STB MSEGF LIB?? CCA SET FLAG TO COME BACK TO STA SCLG LG ONCE IF UNDEF AFTER DISC LIB SCAN. DLIB LDA PLIST GET LIST/NO LIST FLAG ARS JMP LOADM LOAD FROM DISC LIB IF NEED BE LIB? JSB LSTX1 ANY UNDEFINED IN LST ? JMP DLIB NO - GO FOR DISC LIB FOR NEXT MOVE JMP LBSEG YES - SCAN LG AS LIB * * LBSCN ISZ NUPLS ANYTHING LOADED IN LAST SCAN ? JSB LSTX1 ANY UNDEFINED SYMBOLS ? JMP RETRN NO, THEN FIND OUT NEXT MOVE. LBSEG CCA YES - SCAN LG AS LIB STA PLFLG SET FLAG FOR "NAM SHOULD BE FIRST" STA NUPLS "ANYTHING LOADED OR NOT" STA LIBFL "DOING LIB SCAN" JSB LGRST RESET LG READ FROM START JMP LDRIN READ FROM LG AREA * RETRN LDA LGO CPA P99 IF LG FROM START JMP DLIB THEN READ FROM DISC LIB. JSB LGSAV ELSE LGO IS -1 AND SAVE ADDRES JMP TREAD GO PRINT "LOAD". * ERR05 ASC 1,05 ERR10 ASC 1,10 ERR12 ASC 1,12 ERR13 ASC 1,13 P13 DEC 13 SCLG NOP PLFLG NOP LDI5 LDA ERR10 RSS LD12 LDA ERR12 RSS LD13 LDA ERR13 JMP ABOR SKP * * 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 P13 LDB MES10 MES10 = ADDR "LOADR ABORTED" JMP LTERM TERMINATE LOADER(AND THIS PROGMER) * * READ NEXT SECTOR FROM LG AREA OR SYS LIB * LDRN6 JSB EXEC DEF *+7 DEF P1 DEF LGLUN 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. * LDA LGOBF ARE WE TRYING FOR A SZA,RSS GO REQUEST TO L&G JMP LDR3 CLA CLEAR THE FLAG STA LGOBF LDA LGTMP WAS THE PREVIOUS PNTR SZA,RSS SET IN AN ODD SECTOR JMP LDRN4 -NO- CLA RESET THE FLAG STA LGTMP JMP LDR2 LDR3 LDA SLIBF ARE WE SCANNING THE LIBARY SZA NO JMP LDR1 YES LDA LIBFL GET LG LIB SCAN FLAG SZA SCANNING LG AS LIB ? JMP LDRN4 YES - SO AVOID HALF SEC CRAP LDB SEOFG IS THE MAIN/SEG ODD/EVEN SSB,RSS FLAG SET?? JMP LDRN4 -NO- CLA YES STA SEOFG CLEAR THE FLAG JMP LDR2 GO RESET BUFFERS LDR1 LDB LBOEF IS THE LIB ODD/EVEN SSB,RSS FLAG SET??? JMP LDRN4 a -NO- CLA CLEAR THE STA LBOEF FLAG LDR2 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 TO 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 ZERO LENGTH? 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. * 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 LDRN8 CHECK FOR END OF LG * SKP * * SUBROUTINES TO SAVE AND RESTORE DISC READ PARAMETERS. * * "LGSET" - SET ADDRESSES FOR START OF LG AREA AND ALSO SAVE THEM * LGSET NOP LDA LGOTK GET LGO CONTROL WORD LDB P2 SSA SET LU = 2 OR 3 (SIGN BIT SET) INB STB LGLUN STB ILGLU ALSO SAVE IT ALF,ALF RAL ISOLATE STARTING AND M377 TRA)CK ADDR STA LGTRK AND SET. STA ILGTR ALSO SAVE TRACK ADDR LDA SECT3 SET LGS# = NUMBER OF CPB P2 SECTORS PER TRACK LDA SECT2 FOR APPROPRIATE DISC. STA LGS# STA ILGS# ALSO SAVE IT JSB LGSAV SAVE ALSO AS DYNAMIC ADDRES. JSB LGRST ALSO RESET TO START JMP LGSET,I - RETURN - * * * "LGSAV" - SAVE CURRENT LG ADDRES * LGSAV NOP LDA LGTRK SAVE STA SVLGT TRACK ADDR LDA LGSEC STA SVLGS SECTOR ADDR LDA XCUR STA SVCUR BUFFER ADDR JMP LGSAV,I - RETURN - * LGLUN NOP LU 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 L6 OCT -6 XBHLF DEF XBUF+64 ADDR OF END OF XBUF XBUFA DEF XBUF DEFINE ADDR OF XBUF XCUR DEF XBUF * SKP * "LGRES" - RESTORE LG ADDRES * LGRES NOP LDA ILGLU RESTORE STA LGLUN LU LDA ILGS# STA LGS# # OF SECS / TRK LDA SVLGT STA LGTRK TRACK ADDR LDA SVLGS STA LGSEC SECTOR ADDR LDA SVCUR STA XCUR BUFFER ADDR CLA STA XCNT REC COUNT JMP LGRES,I - RETURN - * * * "LGRST" - RESET TO BEGINNING OF LG AREA * LGRST NOP LDA ILGLU RESET STA LGLUN LU LDA ILGTR STA LGTRK TRACK ADDR LDA ILGS# STA LGS# # OF SECS / TRK LDA XBUFA STA XCUR BUFFER ADDR CLA STA LGSEC SEC ADDR STA XCNT REC COUNT JMP LGRST,I - RETURN - * * STORAGE FOR LG READ PARAMETERS * ILGLU NOP ILGTR NOP ILGS# NOP LGOCP NOP LGOCL NOP LGOU NOP SVCUR NOP SVLGT NOP SVLGS NOP *  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 L6 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 SKIP - 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 SUSP GO SUSPEND AND WAIT FOR HELP * 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 PR-TNAM 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? 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 NAMR 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 * * PROCESS END REC * 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 I]XN LOWER HALF SSB LDA XBHLF SET FOR ODD SECTOR STA XCUR 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 IOR PTYPE SET PROG TYPE 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 PPRI STORE OVER-RIDING SZA PRIORITY IF 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 17 WORDS ADB A ADD DIFFERENCE TO MAP LENGTH BLS CONVERT TO WORDS STB NOIDS 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 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 NOIDS LDB MESS2 MESS2 = ADDR MEMORY MAP JSB DRKEY PRINT: XXXXX NNNNN NNNNN PRMA1 LDA TPREL GET NEXT AVAIL ADDR STA PPREL SET NEXT RELOCATION BASE JMP PRMAP,I RETURN SKP * SCAN LST FOR SAME ENT/EXT * * 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 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 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 HFB POINT TO NEXT LST1 JMP MACH? GET NEXT LST1 INB LDA 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 LINKAGE AREAS FOR OPERAND * * * SCAN SETS UP AREA ADDRES FOR 'ARSCN' ROUTINE WHICH * ACTUALLY DOES THE SCAN. THE AREAS SCANNED ARE THE * SYSTEM/FG RES/RES LIB , BG RES AND THE DUMMY LINK AREAS. * CALLING PROGRAM MUST SET THE APPROPRIATE OPERAND VALUE * IN 'OPRND'. * ON RETURN: * (P+1) - MATCH FOUND AND REG-A = 0 * REG-E = 0 LINK FOUND IN BASE PAGE * REG-E = 1 LINK FOUND IN DUMMY BASE PAGE * AND REG-B = ABSOLUTE LINK ADDR * * (P+2) - NO MATCH - REGS ARE MEANINGLESS. * SCAN NOP SPC 1 IFN * BEGIN NON-MEU CODE **** LDA INTLG (A)=NUM OF INT TBL ENTRIESH ADA P8 (A)=FWA OF SYS/FG RES/RES LIB LINK AREA STA LOWER SET LOWER BOUND FOR AREA LDA BPA1 (A)=UPPER BOUND OF AREA STA UPPER SET UPPER BOUND JSB ARSCN SCAN SYSTEM LINKAGE AREA JMP SYSFD OPERAND FOUND LDA BPA2 SET BOUNDS FOR BG RES LINK AREA SURCH INA STA LOWER LDA BPA3 (A)= LWA OF BG RES LINK AREA STA UPPER H JSB ARSCN SCAN BG RES LNK AREA FOR OPERAND JMP SYSFD OPERAND FOUND * END NON-MEU CODE ****** XIF SPC 1 SPC 1 IFZ * BEGIN MEU CODE ******** LDA BPA2 SET BOUNDS FOR RESIDENT INA LINKAGE AREA STA LOWER SEARCH LDA M1646 STA UPPER JSB ARSCN SCAN RES LINKS FOR OPERAND JMP SYSFD OPERAND FOUND * END MEU CODE ********** XIF SPC 1 LDA FWABP SET DUMMY LINKAGE AREA BOUNDS STA LOWER LDA CWABP STA UPPER JSB ARSCN SCAN DUMMY AREA FOR OPERAND JMP DMYFD OPERAND FOUND ISZ SCAN (P+2) RETURN FOR NO MATCH FOUND JMP SCAN,I (P+2) RETURN * DMYFD LDB FWABP GET REAL BASE PAGE LOCATION CMB,INB CORRESPONDING TO THE LOCATION ADB LOWER IN DUMMY LINK AREA. ADB BPFWA (B)=REAL BP LINK AREA CLA,CCE,RSS (A)=0, (E)=1 LINK FOUND IN DUMMY SYSFD CLA,CLE (A)=0, (E)=0 LINK FOUND IN BASE PAGE JMP SCAN,I (P+1) RETURN FOR MATCH FOUND. * M1646 OCT 1646 LWABP RES LINKS * * * SCAN SPECIFIED AREAS FOR THE OPERAND * * ARSCN SCANS THE SPECIFIED AREA FOR AN OPERAND IDENTICAL TO * THAT IN 'OPRND'. CALLING MODULE MUST SET: * OPRND = OPERAND TO BE SURCHED * LOWER = LOW ADDR OF AREA * UPPER = HIGH ADDR OF AREA (NOT INCLUDING LAST ADDR) * * RETURN IS: * (P+1) - MATCH FOUND AND REG-B = ABSOLUTE ADDR OF MATCHED * LOCATION IN THE AREA. * AND REG-A = OPERAND * * (P+2) - NO MATCH FOUND - REGS ARE MEANINGLESS. * * ARSCN NOP LDB UPPER SET NEGATIVE CMB,CLE,INB UPPER BOUND. ADB LOWER CHECK IF HIGHER SEZ EQUAL OF LOWER? JMP NOMAC YES,RETURN P+1 LDB LOWER GET LOWER BOUND LDA OPRND SET (A)=OPERAND SRC CPA B,I OPERAND IN AREA? M JMP FOUND YES, RETURN INB NO, BUMP TO NEXT ONE CPB UPPER DONE? RSS YES, RETURN P+2 JMP SRC NO, TRY NEXT ONE NOMAC ISZ ARSCN BUMP TO (P+2) RETURN FOUND STB LOWER SET LOWER FOR PAST ROUTINES JMP ARSCN,I RETURN RETURN SPC 1 LOWER BSS 1 UPPER BSS 1 * * 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 BP LINK ADDR FOR EXT * * DBLEX HANDLES ALL DBL EXTERNAL REFERENECS. IF A LINK HAS * BEEN ASSIGNED TO A SYMBOL (V BIT OF LST4 IS SET) AND THE * OFFSET IS NON-ZERO, THEN IT IS CONSIDERED AS AN ILLEGAL * FORWARD REFERENCE AND LOADER ABORTS WITH ERROR 15. * BEFORE ENTRY INTO DBLEX, 'EXORD' MUST BE SET UP WITH * THE PROPER ORDINAL AND OFFSET SHOULD HAVE A FINITE VALUE. * (TYPE 4 DBL RECORD SETS OFSET=0 AND TYPE 5 GETS OFSET FROM * THE RECORD). * * CALLING SEQUE"iNCE: * 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 P2 IS SYMBOL DEFINED? JMP DBLE0 NO GO 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 * * * OUTAB NOP  ROUTINE TO OUTPUT 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 * 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 * 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 * 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 * 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 BAS E DSTBL DEF *+1 NORMAL LOADING BASE ADDRESSES FWA NOP BASE OF CURRENT PROGRAM OR SEGMENT STRAK NOP BASE TRACK SSECT 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 * * * 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 INSTRUCTION FROM DBL RECORD BITS 01 =DBL TYP (3 OR 4) * 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 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 FIX2,I FIRST GET STA TLST THE RIGHT LST ENTRY JSB LSTX SET UP HLT 0 BETTER BE GOOD * 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 MEMORY ADDRESS STA DBLAD SET IT JSB FIXIT DO THE FIXUP CC"vA 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 * * 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 T1FIX GET THE DBL TYPE CPB P4 IF TYPE 4 THEN JMP FIX01 ALWAYS USE LINK * SZA ELSE USE LINK CPA MSIGN ONLY IF yJNOT 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 T2FIX NOP T3FIX NOP TFIX NOP EXORD BSS 1 SET2 NOP SET1 NOP M1740 OCT 174000 ERR14 ASC 1,14 ASMB IN ERROR - ORDINAL ABSENT. MPAG OCT 101777 PAGE OFFSET AND INDIRECT BIT SKP * * SET MEMORY REFERENCE ADDRES * * MREF RELOCATES THE MEMORY REFERENCE INSTRUCTIONS. IF THE CURRENT * REFERENCE IS OUTSIDE THE CURRENT PAGE, IT ESTABLISHES AN INDIRECTUb * 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 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 LDA FWABP SET BOUNDS FOR DUMMY LINK AREA STA LOWER LDA CWABP STA UPPER JSB ARSCN 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 LDA FWABP CMA,INA GET ACTUAL BP LINK ADDR ADA LOWER ADA BPFWA (A)=ACTUAL BP LINK ADDR 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 MREFn0 JUST ADD INSTR TO ADDR, RETURN * M2000 OCT 2000 M1777 OCT 1777 INSTR BSS 1 OPADD 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 STA 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 ENFLG BSS 1 SKP * * NORMAL LOAD TERMINATION * NODEX LDA ENFLG GET ENTRY POINT LIST FLAG 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 i STA EMES+4 SET NAME 5 INTO BUFFER LDA LST5,I A= SYMBOL VALUE 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 * * 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, RSS SKIP. JMP MSGP4 CONTINUE. CPA P2 CONTINUE IF JMP MSGP3 SEGMENT * * FIND AND CLEAR 'DEBUG' ENTRY POINTS * LDA MSGDC SET FWA OF STA ED20 ENT NAMES LDA N4 SET NEG STA ED21 INDEX OF -4. * MSGP2 LDA ED20,I SET STA TBUF ENTRY ISZ ED20 LDA ED20,I POINT STA TBUF+1 ISZ ED20 NAME LDA ED20,I STA TBUF+2 IN ISZ ED20 TBUF. * JSB LSCAN HFBFIND MATCH JMP MSGP0 -NO MATCH- CHECK NEXT LDA UBLNK SET STA LST3,I NAME IOR BLANK FIELD STA LST1,I OF STA LST2,I ENTRY = BLANKS. MSGP0 ISZ ED21 END-OF-LIST? JMP MSGP2 NO JMP MSGP3 YES. * N4 DEC -4 * MSGDC DEF *+1 ASC 3,DEBUG ASC 3,$DBP1 ASC 3,$DBP2 ASC 3,$MEMR * * MSGP3 LDA MSEGF SKIP DEBUG CHECK , ETC., CPA P3 IF FINAL JMP MSGP6 LOAD (=3). * JSB SILST INITIALIZE FOR SEGMENT AREA, JSB LSTX SET ADDRES FOR NEXT LST ENTRY NOP LDA CHRDE PUT STA LST1,I "DEBUG" 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. * * 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. LDA P5 SET PTYPE = 5 IOR M20 MASK IN 'SS' BIT FOR SEG ID H STA PTYPE FOR BKG SEGMENT. * * 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 PPREL , FWA STA TPREL CCA SET LAST ACCESS PNTR STA LELAD USED BY OUTAB ROUTINE LDA SEGB AND THE STA CWABP BASE PAGE AREA. CCA SET FIRST DATA BLOCK STA DBLFL FLAG = -1. * * 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 LGO GET LOAD AND GO FLAG CMA,SSA,INA,SZA IF IN LOAD AND GO AREA JMP IREAD CONTINUE THE LOAD,ELSE JMP TREAD GO PRINT "LOAD" MESSAGE SKP * * RE-OUTPUT "MAIN" BASE PAGE LINKAGES * MSGP6 LDA SLST SAVE SLST VALUE 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 ISZ MSEG SET MSEG FOR INLST LIUND LDA P6 LDB MESSM PRINT "MAIN'S" JSB SYOUT JSB PUDF GO REPORT THE UNDEFINEDS SSB IF NO PARAMETERS JMP ABORT THEN ABORT LDB B,I ELSE GET PARAMETER CPB P98 IF 98 JMP LIUND THEN LIST UNDEFINED AGAIN. CPB P4 IF 4 RSS THEN SKIP AND WRAP UP LOADING JMP ABORT ABORT IF ANY OTHER PARAMETER 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 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 LDA FWABP SE[T UP ADDR ADA N13 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 * 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 IN 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 M200 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 NO, 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. * MOVER LDA B,I SAVE DMAN OF LAST ID STA BID2 POINTING TO USER TRACKS. LDA B ADA N4 (A)=ADDRa 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 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 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 (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 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 ADA 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 ED183 YES, SET UP FOR NEXT SEG. * NTRM4 EQU * SPC 1 IFZ ******* BEGIN MEU CODE ******** Z LDA #MNPG CALCULATE CMA,INA NUMBER OF PAGES ADA #MXPG USED BY CODE ADA P2 +1 CURR PAGE, +1 BASE PAGE LDB #PGS # PAGES REQUESTED SZB,RSS BY USER? STA #PGS NO, USE PROG SIZE * LDA PLIST SLA LOADR LISTING SUPPRESSED? JMP PTNCK YES, SKIP #PAGES MESS. JSB SPACE LDA #PGS GET PROG SIZE + BASE PAGE JSB CNV99 CONVERT TO ASCII STA MS11# FILL INTO MESSAGE LDA P18 LDB MES11 PRINT MESSAGE JSB DRKEY '00 PAGES REQUIRED' * PTNCK CCA CHECK #PAGES REQ'D DOESN'T LDB PTYPE EXCEED MAX OF QUALIFIED PTTN CPB P2 RT? LDA #MXRT YES SSA (IF NO RT PTTNS, LDA #MXBG USE BG PTTN MAX) SSA (IF NO BG PTTNS, LDA #MXRT USE RT PTTN MAX) SSA SUPER-DUPER ERROR CHECK JMP ER.16 IF NONE, OH-OOH! INA ADD 1 FOR BASE PAGE LDB #PGS CMB,INB ADB A #PAGES REQ'D SSB > MAX ? JSB WN.17 YES, GIVE WARNING * CCB BUILD ID SEG WORD 22 ADB #PTTN PUT PTTN NUMBER CCE,SSB IN BITS 0-5 CLB,RSS SET BIT 15 IF PTTN RBL,ERB REQUESTED, ELSE 0 * CCA ADA #PGS PUT NUMBER OF PAGES ALF,RAR FOR PROG'S PTTN IOR #MPFT IN BITS 10-14 ALF,ALF & MEM PROT FENCE TABLE RAR INDEX INTO IOR B BITS 7-9 LDB #IDAD KEEP IT IN (A) ADB P21 GET ADDR WORD 22 OF STB SYR1 ID SEG FOR PROG JSB SYSET SET ID SEG IN MEMORY LDB EDFLG SZB,RSS PERMANENT PROG? JMP *+3 NO LDB SYR1 YES, FIX DISC ID SEG JSB SYRUW * JMP DONE FINISHED * * * ISSUE WARNING FOR CODE EXCEEDING PTTN SIZE * CALLm 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 * * * 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 M60 JMP CNV99,I RETURN ASCII IN (A) ******* END MEU CODE ********** XIF SPC 1 DONE LDA #IDAD INA GET ADDR OF ID TEMP AREA LDB #IDAD ADB P10 GET ADDR OF B-REG SAVE WORD STB SYR1 WITHIN THE ID SEG JSB SYSET SET TEMP ADDR IN B LDB EDFLG SZB,RSS JMP *+3 LDB SYR1 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 * * * RESET LGO CONTROL WORDS IF LGO USED * LDA LGO GET LG USE FLAG SZA,RSS IF LG NOT USED JMP EXIT THEN DO NOT RESET 'LGOC' * LDA LGOTK SET AND M7600 'LGOC' LDB C1766 = LU, STARTING TRACK #,SECT 0 JSB SYSET * EXIT 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 PAG6E EJECT IF JMP EXIT1 NOT LISTING ANYTHING AT ALL * 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. * * 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 C1766 OCT 1766 M1100 OCT 1100 M7600 OCT 177600 SPC 1 RELAD BSS 1 RELATIVE BG ADDR TEMPP BSS 1 ABSOLUTE PROG WORD LELAD DEC -1 OFFSET INTO CURRENT LOAD MODULE LOFST NOP OFFSET OF THE MODULE ABWRD NOP SAVED ABSOLUTE PROG WORD CELAD NOP TARGET REL ADDR TO BE ACHIEVED ENDMS DEF $END 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 * DEF BASE SECTOR OFSET * * 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 RELOCATION 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. 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 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 LDB ADBUF ADD POSITION IN SECTOR OF NEW ADB SPOS WORD TO ADDR OF DBUF. LD4HFBA 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, STB TPREL SET NEW ADDR. JMP ABOUT,I RETURN * 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 H 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: 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 %m 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 ABT10 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)= STARTING 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. * 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 LDA ABT3,I NO IS THE TRACK CPA XEQT ASSIGNED TO ME? RSS 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. * * 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 STA ABT10 SAVE EDIT NO-EDIT FLAG STB ABT11 SAVE DESTINATION ID ADDR * LDA DESA INITIALIZE DESTINATION STA DESAM ADDR ARRAY PNTR. LDA RTORG 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) = 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 N13 THEN SET MOVE COUNT=-13. STB NUMWD LDB ABT11 GET DESTINATION ID ADDR SZB,RSS DESTINATION SPECIFIED ? JMP FBLNK NO, THEN FIND 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. JMP MVIDS,I ERROR RETURN (LONG TO SHORT ILLEGAL). * * FIND BLANK ID OF APPROPRIATE LENGTH * FBLNK JSB BLKID FIND BLANK ID ASSIGNMENTS 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 ALLOCATION. 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 MVIDS,I 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 * AND DO MOVE TO SYSTEM AREA. 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. KEPON LDA SRADR,I GET WORD FROM SOURCE ID LDB DESAM,I (B)=ADDR OF DESTINATION ID WORD JSB SYSET STORE IN SYSTEM ID LDB ABT10 GET EDIT FLAG SZB,RSS PERMANENT ADDITION ? JMP UPDT NO LDB DESAM,I YES, SO RESTORE REG-B. JSB SYRUW STORE ON DISC UPDT ISZ DESAM BUMP DESTINATION ARRAY ADDR ISZ SRADR BUMP SOURCE ADDR OF ID WORD ISZ NUMWD ALL WORDS MOVED ? JMP KEPON NO, DO MORE. * LDB ABT11 GET DEST ADDR ADB P14 BUMP TO NAM5 ADDR LDA B,I GET TYYPE AND P7 CPA P5 IS IT A SEGMENT? CLA,RSS YES, SET SSFLG=0 CCA NO, SET SSFLG=-1 STA SSFLG SPC 1 IFZ ******* BEGIN MEU CODE ******** JSB MEM? USE MEM? TO GET ADDR OF MEM1 NOP IGNORE SHORT RETURN ******* END MEU CODE ********** XIF SPC 1 ISZ SSFLG SKIP IF NOT SEGMENT JMP MOVI2 BUT IF SEGMENT TRY FIND HIGH LDA ABT11 FIND LOW SINCE THIS IS MAIN STA #IDAD SAVE ADDR OF THIS ID SPC 1 IFZ ******* BEGIN MEU CODE ******** LDA B,I (B) STILL IS ADDR OF MEM1 ALF,RAL SHIFT PAGE NUMBER RAL TO BITS 0-4 AND M37 STA #MNPG SAVE LOWEST PAGE # ******* END MEU CODE ********** XIF SPC 1 * MOVI2 EQU * SPC 1 IFZ ******* BEGIN MEU CODE ******** INB INCRE TO MEM2 CCA SUBT 1 FCROM MEM2 FOR ACTUAL LAST WORD ADA B,I ALF,RAL SHIFT PAGE NUMBER RAL TO BITS 0-4 AND M37 LDB A CMB,INB IS THIS PAGE # ADB #MXPG HIGHER THAN PREVIOUS SSB HIGHEST PAGE #? STA #MXPG YES, SET NEW HIGH ******* END MEU CODE ********** XIF SPC 1 ISZ MVIDS BUMP TO SUCCESSFUL RETURN JMP MVIDS,I **RETURN** * * 'MVIDS' CONSTANTS * NUMWD NOP NUMBER OF WORDS TO BE MOVED SRADR NOP FWA OF SOURCE ID MOVE DESA DEF *+1 ARRAY CONTAINING ADDRES BSS 13 IN DESTINATION ID AREA. DESAM NOP CURRENT PNTR TO ARRAY SSFLG NOP 0 FOR LONG, -1 FOR SHORT SOURCE ID * SKP * * SUBROUTINE: "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 STA ABT4 INA SET STA ABT5 ADDRES INA OF STA ABT6 BOUNDS INA WORDS. STA ABT7 * 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 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. SKP * * 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 LDA 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: "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 * * (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 DISPS CLEAR DISC ALLOC FOR SHORT ID STA DISPL AND FOR LONG ID LDA KEYWD INITIALIZE ADDR OF STA KEYPT KEYWORD LIST. RSS SKIP ADDR BUMP FOR FIRST TIME BLK1 ISZ KEYPT BUMP KEYWORD ADDR LDB 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 CPA B,I IF NAM12=0 JMP BLK2 THEN BLANK ID. 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 LDA 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 SHND ISZ BID8 BUMP COUNT FOR SHORT ID W/O DSC CLA LDB 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. LDB 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 LDA KEYPT,I GET ID SEG ADDR ADA P15 (A)=ADDR OF MEM1 OF SHORT ID LDB FLGSS GET ID TYPE FLAG ]HFBSZB,RSS LONG ID ? JMP DLGND YES,ADJUST (A) FOR MEM1 OF BIG ID. JSB C#S 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 LDB 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#S 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 LDB KEYPT,I SET ADDR OF LONG ID STB BID1 WITH LEAST ALLOCATION. LGCNT ISZ BID5 COUNT LONG IDS WITH H 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 FLGSS NOP =0 FOR LONG ID, NON-ZERO FOR SHORT DISPL NOP LONG ID SECTOR COUNT DISPS NOP SHORT ID SECTOR COUNT KEYPT NOP KEYWORD * 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 LDB ABT1,I IF END-OF-LIST, SZB,RSS RETURN TO JMP MIDN,I NO MATCH RETURN, P+1. * ADB P12 COMPARE LDA B,I NAME CPA NAM12,I AREAS INB,RSS OF JMP MIDN2 DUMMY ID SEG. LDA B,I AND CPA NAM34,I CURRENT INB,RSS SYSTEM ID SEG. JMP MIDN2 LDA 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) LDB ABT1,I (B) = ADDR OF MATCH ID SEG. LDA BLKID GET THE ID WORD AND P7 STRIP TO TYPE CPA P4 Q IF CORE RSS 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 SKP * * SUBROUTINE: 'SYRUW' SYSTEM DISC READ/UPDATE/WRITE * * THIS ROUTINE PROVIDES FOR UPDATING A WORD IN * THE ID SEGMENT OR 'TAT' AREA OF THE SYSTEM DISC. * * CALL: (A) = VALUE TO BE STORED IN WORD * (B) = ADDR OF WORD IN ID SEG AREA OR TAT * * (P) JSB SYRUW * (P+1) -RETURN- * * SYRUW NOP STA SYR1 SAVE VALUE LDA KEYWD,I SUB. FWA OF 1ST ID SEGMENT CMA,INA AND ADD IN ADA B POSITION OF 1ST ADA IDSDP ID SEG TO GET RELATIVE ADDR. CLB DIVIDE DIV P64 BY 64 ADB ALBUF SET ADDR STB SYR2 WITHIN LBUF STA B SAVE REL SECTOR # LDA IDSDA GET DISC ADDR OF 1ST ID SEG, AND M177 ISOLATE SECTOR # AND ADB A ADD TO REL SECTOR # LDA IDSDA GET AND ALF,ALF SAVE STARTING RAL TRACK #. AND M377 STA UTRAK LDA B DIVIDE REL SECTOR CLB # BY # SECTORS/ DIV SECT2 TRACK STB USECT AND SET SECTOR # ADA UTRAK SET ABS. STA UTRAK TRACK #. * JSB UREAD READ IN SECTOR * LDA SYR1 UPDATE STA SYR2,I WORD ISZ P1 CHANGE 1 TO 2 (FOR UPDATE) JSB UREAD RE-WRITE SECTOR CLA,INA RESET 1 STA P1 IN 'P1'. * JMP SYRUW,I RETURN. * SYR1 NOP SYR2 NOP 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 OFR 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 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 GO TO PRINT MESSAGE * * LDA TRKLU DSKUN = DISC'S STA DSKUN LU # LDA TRAKB ITRKB = STARTING TRACK # ADA #TRAK ITRK6 = ENDING TRACK STA ITRK6 # +1. JMP ITRAK,I RETURN * * PRINT WAITING MESSAGE * ITRK3 LDA P22 LDB ITRKM JSB SYOUT JMP ITRK1 * ITRKM DEF *+1 ASC 11,WAITING FOR DISC SPACE * ITRK6 NOP * * #TRAK NOP # 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 #. 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#S # SECTORS STA ED60 AND SAVE * ED001 LDB TAT SET SIGN BIT LDA B,I ON SYS DISC TO TEST JSB SYRUW WRITE PROTECT BEFORE DAMAGE IS DONE * LDB ED25 ADB P12 SET ADDR OF NAM12 STB LH1 OF ID SEG. JSB $LIBR TURN OFF NOP INTERRUPT SYSTEM ADB P2 (B)=NAM5 ADDR OF MATCHED ID LDA B,I GET NAM5 AND AND P7 MASK IN PROG TYPE. CPA P5 IS THIS A SEGMENT ? JMP ED004 YES, FORGET DORMANY CHECK. ADB N6 (B)=ADDR OF SUSPEND WORD LDA B,I POINT OF SUSPENSION? SZA ZERO - CONTINUE JMP ED003 SUSPEND ADB P7 GET LDA B,I STATUS: SZA DORMANT? JMP ED003 NO - SUSPEND ADB P2 GET LDA B,I TIME LIST: AND BIT12 IN LIST? SZA,RSS YES - SUSPEND JMP ED004 NO - CONTINUE * SKP ED003 JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM LDA P18 PRINT MESSAGE LDB MES70 AND SUSPEND JSB SYOUT PROG IS NON-DORMANT JSB EXEC AND/OR HAS A NON-ZERO DEF *+2 PT OF SUSP AND/OR IS DEF P7 IN THE TIME LIST - JMP ED001 CHECK AGAIN * MES70 DEF *+1 ASC 9,SET PRGM INACTIVE BIT12 OCT 10000 LH1 NOP * ED004 CLB STB LH1,I ZERO ISZ LH1 NAME STB LH1,I IN ISZ LH1 CORE LDA LH1,I ID AND M20 @ SEGMENT (LEAVE 'SS' BIT) STA LH1,I JSB $LIBX RESTORE DEF *+1 INTERRUPT DEF *+1 SYSTEM * * RELEASE "OLD" TRACKS * 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 LDA B,I GET DISC WORD AND SAVE STA ED63 TEMPORARILY. SSA TRACKS ON LU3 ? JMP CLEAR YES, THEN RELEASE TRKS. CMA,INA SUBTRACK 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 LDA 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 JSB 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 THEN (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 LDB ED22,I GET NEXT ID SEGMENT ADDR. SZB,RSS JMP ED14 -END OF LIST * ADB P12 CHECK NAME(1) CLA IF CPA B,I = JMP ED17 0, CHECK FURTHER. ED12 ISZ ED22 CHECK JMP ED11 NEXT SEGMENT. * ED17 ADB P2 (B)=NAM5 ADDR JSB MEM? GET ADDR OF MEM1 CLA (REG-A NOT 0 FOR SHORT ID RETURN) ADB P4 (B)=ADDR OF DMAIN CPA B,I IF NO DISC ALLOC TO THIS SEG JMP ED12 THEN CONTINUE SCAN. * LDA B ADA N4 (A)=MEM1 ADDR JSB C#S 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 #. LDA ED22,I ALSO, SET STA ED24 ID SEGMENT ADDR. i 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 DUMMY 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 LDA B,I GET DESTINATION AREA ON SYS DSC ALF,ALF SET STARTING RAL TRACK AND M377 NUMBER. STA ED66 LDA 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.9 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 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 BGN 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 LDA 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 B 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,RSS 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 * DREL NOP STA ED63 LDA TAT STARTING SSB BASE ADA TATSD ADDR STA ED64 FYOR DISC UNIT. 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 LDA 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 NXTRK LDA DREL GET ID SEGMENT ADDR TO A CPA B,I THIS TRACK BELONG?? RSS YES SKIP JMP NXTR1 NO STEP TO NEXT ONE LDA XEQT ASSIGN JSB SYSET TRACK TO SELF NXTR1 INB STEP TRACK ADDR ISZ FIX24 DONE?? JMP NXTRK NO TRY NEXT TRACK JMP TATCL,I YES REETURN * * ROUTINE TO CLEAN OUT THE IsHFBD 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 * MESSM DEF *+1 ASC 3,MAIN'S * MESS3 DEF *+1 ASC 7,UNDEFINED EXTS * MESS4 DEF *+1 PRAM ASC 6, READY * MESS6 DEF *+1 ASC 13,"GO" WITH EDIT PARAMETERS * MESS8 DEF *+1 ASC 6,ENTRY POINTS * SYM4 DEF SYMES+4 SYMES ASC 20, /LOADR: $END ASC 2,$END * BSS 0 SIZE OF LOADR SPC 3 END LOADR zH x3 92001-18003 B S C0122 MUL. TERM. MONITOR (PRMPT, R$PN$)             H0101 (ASMB,L,C HED PRMPT - MTM PROMPTER * NAME: PRMPT * SOURCE: 92001-18003 * RELOC: 92001-16003 * 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 PRMPT,1,10 92001-16003 REV.B 741216 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 READ DEF *+1+7 Gl 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 ASMB,R,L,C HED R$PN$ MTM RESPONSE * NAME: R$PN$ * SOURCE: 92001-18003 REV.B * RELOC: 92001-16003 REV.B * PGMR: G.A.A. * DATE: AUGUST 1,1974 * * *************************************************************** * * (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 R$PN$,1,10 92001-16003 REV.B 741002 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 ASCFL 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$ v=  92001-18004 1631 S C0122 RTE-II POWER FAIL DRIVER              H0101 ASMB,L,C HED DVP43 - RTE POWER FAIL / AUTO RESTART * NAME: DVP43 * SOURCE: 92060-18001 * RELOC: 92001-16004 * 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 DVP43,0 92001-16004 REV.1631 760622 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 THE USER, PORT-A, AND PORT-B MAPS ARE SAVED * 4. TURN OFF POWER-FAIL INTERRUPTS UNTIL POWER RETURNS * * ON POWER UP: * 1. IN RTE-III THE USER, PORT-A, AND PORT-B MAPS ARE RESTORED * 2. THE SYSTEM MAP IS REBUILT FROM MEMORY * 3. 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. * 4. THE CURRENT SYSTEM TIME IS SAVED (THIS WILL BE THE * TIME OF POWER FAILURE). * 5. THE CLOCK IS RESTARTED BY CALLING $SCLK WHICH WILL * SET UP FOR AN IMMEDIATE INTERRUPT. * 6. 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 ISV 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) JMP PSAVE,I RETURN TO POINT OF POWER FAILURE. * 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 LIB 6 CHECK IF MX CPU SZB,RSS JMP NOMX1 * 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 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 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. * LDB EQT# zuSET 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 pSLA,ELA STO LDA SDMA1 STC 2 OTA 2 LDA SDMA2 STC 3 OTA 3 LIB 6 IF MX CPU SZB,RSS JMP NOMX2 * 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 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 WITHOUT STA EQ5 POWER FAIL BIT SET. SAVE EQT5 ADDRESS INCASE LDA EQT5,I WE GO DOWN WHILE PROCESSING ALR,RAL SET CONTROLLER DOWN ERA,RAR AND STA EQT5,I AND JMP $UPIO GO RESTART CONTROLLER AND ANY DOWN 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 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 'LPOINT 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 64006  92001-18005 1926 S C2822 &SYLB1 RTE SYSTEM LIB.             H0128 ASMB,L * NAME: $YSLB * SOURCE: 92001-18005 * RELOC: 92001-16005 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 92001-16005 REV.1926 790505 END 48ASMB,R,L,C ** $ALRN RN-LU COMMON SUBROUTINES *** HED $ALRN - RN-LU COMMON SUBROUTINES * NAME: $ALRN * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 $ALRN,6 92001-16005 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,d 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 -KASMB,R,L,C ** RNRQ RESOURCE NUMBER MODULE ** HED ** REAL-TIME EXECUTIVE RNRQ RESOURCE NUMBER MODULE ** * NAME: RNRQ * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 RNRQ,6 92001-16005 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 ALLOCATED RN MAY B E 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 SZA SKINP 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 TH6{E 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 NASMB,R,L,C ** LURQ LU LOCK REQUEST MODULE ** HED ** REAL-TIME EXECUTIVE LURQ LU LOCK REQUEST MODULE ** * NAME: LURQ * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 LURQ,6 92001-16005 770509 * 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 * 100000B 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 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 RAL,CLE,ELA BIT14 TO E RAR,RAR RESTORE OPTION, LESS NO-ABORT BIT. STA RQOP SAVE CALLER'S OPTIONS. 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 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 V) 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 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 STB 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 STA 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 * * * 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 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 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 TEMP3 LU STA 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 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 * 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 LDB B,I TO B SSB,RSS IF NOT IN BATCH MODE JMP SWEX GO GET THE WORD FROM DRT. * LDA DLUSW GET ADDRESS OF JSB $DRAD THE LU SWITCH TABLE STA B SET IN B LDA A,I GET THE LENGTH CMA,INA SET NEGATIVE FOR COUNTER STA COUNT SET COUNTER * SWNXT INB START THE LOOP LDA 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 LDA 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 D2 DEC 2 D3 DEC 3 D7 DEC 7 D20 DEC 20 DLUSW DEF $LUSW 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 T*ASMB,L ** PRTN TO RETURN PARAMETERS TO SCHEDULING PROG ** HED PRTN TO RETURN PRAMETERS TO THE SCHEDULING PROGRAM * NAME: PRTN * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 PRTN,6 92001-16005 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 ADDRE SS 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 AND DO THE JOB Q SPC 2 A EQU 0 B EQU A+1 KEYWD EQU 1657B XEQT EQU 1717B END qASMB,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: 92001-18005 * RELOC: 92001-16005 * 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 EQLU,6 92001-16005 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 O77 MASK OFj   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 L ASMB,L HED .DRCT ROUTINE * NAME: .DRCT * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 .DRCT,7 92001-16005 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 ASMB,L,C ** REIO ** * NAME: REIO * SOURCE: 92001-18005 * RELOC: 92001-16005 * PGMR: G.A.A.,D.L.S. * DATE: OCT. 2,1974 * * *************************************************************** * * (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 REIO,7 92001-16005 780212 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 FENCE. * 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 RQ+2 GET THE BUFFER ADDRESS ADA N3 LESS THREE AND STA TDBA SET UP THE LIBR/LIBX STA TDBA2 CALLS ADA N2 NOW DECREMENT BY TWO FOR SAVE X/Y REG CMA SAVE f  WORDS, NEGATE AND TEST ADA FENCE AGAINST THE FENCE 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 N2 DEC -2 FENCE EQU 1775B A EQU 0 ORG * END D ASMB,R,L,C ** IFBRK ** HED R/T IFBRK MODULE * NAME: IFBRK * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 IFBRK,7 92001-16005 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 _ASMB,L ** COR.A ** HED COR.A ROUTINE * NAME: COR.A * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 COR.A,7 92001-16005 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 jZASMB,R,L ** KCVT ** HED CONVERT ROUTINE * NAME: KCVT * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 KCVT,6 92001-16005 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 ;ASMB,R,L,C HED MESSS * NAME: MESSS * SOURCE: 92001-18005 * RELOC: 92001-16005 * PGMR: G.A.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 MESSS,7 92001-16005 770813 ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN EXT $PARS,EXEC * A EQU 0 B EQU 1 * BUFFR NOP LNGTH NOP PP1 NOP MESSS NOP JSB $LIBR GO PRIVILEGED. CNTR NOP JSB .ENTP GET PARAMETERS. DEF BUFFR LDA MESSS LDB HERE IF BEEN HERE SZB BEFORE, THEN JMP EXIT2 EXIT. * STA RTN STA HERE LDA DEFEF STA MESSS * LDA BUFFR,I IF 'EQ', 'TO' CPA =ALU OR 'LU' COMMANDS, JMP DP5 THEN GO CPA =AEQ SCHEDULE JMP DP5 PROGRAM $$CMD CPA =ATO TO PROCESS. JMP DP5 * STB $PVCN B-REG = 0 FROM ABOVE. CLEAR PRIV. LDA BUFFR COUNTER SINCE WE MAY NOT COME BACK. LDB LNGTH,I JSB $MESS PASS MESSAGE TO SYSTEM. ISZ $PVCN RESET PRIVILEGED COUNTER SINCE WE CAME BACK. SZA,RSS IF NO RETURNED MESSAGE FROM SYSTEM, THEN JMP CHECK CHECK FOR SPECIAL PATCHING OF 'RU' OR 'ON'. * LDB A,I OTHERWIZE, PROCESS MESSAGE. STB LNGTH SAVE NEGATIVE CHARACTER LENGTH BRS STB CNTR LOOP INA LDB A,I STB BUFFR,I ISZ BUFFR ISZ CNTR JMP LOOP * LDA LNGTH SET A-REG TO NEG.CHAR.LENGTH. EXIT1 JSB $LIBX EVERYTHING OK SO DEF *+1 SO RETURN SYSTEM / DEF *+1 MESSAGE. JMP EXIT * DEF DEF RTN DO NOT RTN NOP CHANGE HERE NOP THESE FOUR DEFEF DEF DEF WORDS. * CHECK LDB $WORK GET PROGRAM'S ID SEGMENT ADDRESS. LDA BUFFR,I TEST FOR ON,RUN CPA =AON COMMANDS JMP DP1 TEST 1ST PRAM CPA =ARU JMP DP1 JMP EXIT2 * DP1 EQU * FOUND A 'RU' OR 'GO' COMMAND. INB GO SET LDA B,I LU# IN FIRST SZA,RSS PARAMETER LDA PP1,I IF FIRST IS NOT GIVEN STA B,I AND LU IS GIVEN. * EXIT2 CLA SET A=0 FOR NO JMP EXIT1 MESSAGE TO USER. * DP5 LDA BUFFR USING BUFFER ADDRESS LDB LNGTH,I AND LENGTH GO JSB $PARS PARSE INPUT DEF PRAM BUFFER. * CCA IF ONLY ONE PARAMETER, LDB CP2 THEN SET SECOND SZB,RSS PARAMETER TO STA P2 -1 FOR $$CMD. * JSB $LIBX GO UNPRIVILEGED. DEF *+1 DEF *+1 * JSB EXEC GO RECOVER ANY STRING DEF *+5 LEFT OVER FOR THIS DEF D14S PROGRAM AND THROUGH DEF D1 AWAY SINCE $$CMD DEF BUFFR,I MAY NOT RETURN A DEF D1 MESSAGE TO THIS PROG. JMP EX ABORT RETURN. * JSB EXEC SCHEDULE DEF *+8 COMMAND DEF D23S PROGRAM. DEF $$CMD DEF OP =COMMAND DEF P1 =PARAMETER ONE. DEF P2 =PARAMETER TWO. DEF P3 =PARAMETER THREE. DEF OP =NONZERO SO $$CMD WILL RETURN MESSAGES. JMP EX ABORT RETURN. * JSB EXEC NO ABORT RETURN. TRY AND DEF *+5 RECOVER STRING. DEF D14S DEF D1 DEF BUFFR,I DEF DM20 EX CLB,RSS ABORT RETURN. CMB,INB NO-ABORT RETURN. SET LOG NEGATIVE. * LDA B RETURN A=-e CHARACTER LENGTH. EXIT CLB CLEAR OUT STB HERE BEEN HERE STB P1 FLAGS AND JMP RTN,I RETURN. * PRAM BSS 1 OP BSS 3 CP1 BSS 1 P1 BSS 3 CP2 BSS 1 P2 BSS 3 CP3 BSS 1 P3 BSS 3 CP4 BSS 1 P4 BSS 3 CP5 BSS 1 P5 BSS 3 CP6 BSS 1 P6 BSS 3 CP7 BSS 1 P7 BSS 3 PRMCT BSS 1 * D1 OCT 1 D14S OCT 100016 D23S OCT 100027 DM20 DEC -20 $$CMD ASC 3,$$CMD * END pASMB,R,L ** PARSE ** HED PARSE ROUTINE * NAME: PARSE * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 PARSE,6 92001-16005 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 ASMB,L ROUTINE TO CONVERT TIME HED TMVAL * NAME: TMVAL * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 TMVAL,6 92001-16005 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 ASMB,L,R ** CNUMD ** HED CNUMD...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMD * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 CNUMD,6 92001-16005 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 ÎASMB,L,R ** CNUMO ** HED CNUMO...ROUTINE TO CONVERT BINARY TO ASC * NAME: CNUMO * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 CNUMO,6 92001-16005 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 ASMB,R,L,C ** INPRS ** HED INPRS - PREAMBLE * NAME: INPRS * SOURCE: 91001-18005 * RELOC: 91001-16005 * 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 INPRS,6 92001-16005 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) *  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!W 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 zASMB,L ** .MVW - MOVE WORD ROUTINE ** * NAME: .MVW * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 92001-16005 751021 MICROCODE = 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 MASMB,R,L,C HED SUBROUTINE GETST * * * NAME: GETST * SOURCE: 92001-18005 * RELOC: 92001-16005 * PGMR: 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 GETST,7 92001-16005 770208 ENT GETST EXT EXEC,.ENTR 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 .ENTR 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. INB STA SBADD LDA IBUFL,I GET REQUwEST 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 JMP GETST,I AND RETURN. * 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 ASMB,R,L,C ** IFTTY - SEE IF SPECIFIED LU IS INTERACTIVE. HED -IFTTY - DETERMINES IF SPECIFIED LU IS INTERACTIVE. * NAME: IFTTY * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 92001-16005 780212 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 JMP 0  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 !h ASMB,R,L,C ** LOGLU - RETURNS LU FROM PROGRAM ID SEGMENT HED -LOGLU - FIND LU THAT THIS PROGRAM ORIGINATED FROM. * NAME: LOGLU * SOURCE: 92001-18005 * RELOC: 92001-16005 * 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 LOGLU,7 92001-16005 780212 ENT LOGLU * * ROUTINE TO FIND THE LOGICAL UNIT NUMBER THAT THIS * PROGRAM ORIGINATED FROM. * * THIS IS A DUMMY ROUTINE FOR RTE-II AND III WHICH IF * CALLED, WILL ALWAYS RETURN LU 1 IN THE A REGISTER. * * CALLED AS FOLLOWS: * * LU = LOGLU(IDUMY) JSB LOGLU * DEF *+2 * DEF IDUMY * * * LU = A REG = LU # = 1. * 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 ASC01 B-REG = ASCII 01S CCA STA DUMMY,I INDICATE NOT IN SESSION(WHATEVER THAT IS). * CLA,INA A-REG = 1. JMP LOGLU,I RETURN * DUMMY NOP ASC01 ASC 1,01 A EQU 0 B EQU 1 END PASMB,R,L HED XLUEX - DUMMY ROUTINE FOR EXTENDED EXEC CALLS * NAME: XLUEX * SOURCE: 92001-18005 * RELOC: PART OF 92001-16005 * PGMR: R.S. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 XLUEX,7 92001-16005 REV.1913 790119 EXT .MVW,EXEC,.ENTR ENT XLUEX * * NOTE: * DO NOT CHANGE THE ORDER OF XLUEX,RTN1,FRTN * XLUEX NOP LDA XLUEX .FETCH ADDRESS OF 'DEF RTN' LDB A,I .FETCH 'RTN' ADDRESS STA YLUEX .SET UP FOR PRAM ADDRESS TRANSFER CMA .CALCULATE PARAMETER COUNT ADA B STA CNT STB XLUEX .SET RETURN ADDRESS JMP MVPRM .DO THE PRAMETER FETCH * TOP LDB .PRAM .SET RETURN ADDRESS ADB CNT STB RTN1 .IN THE FAKED CALL LDA .FRTN .PUT IN RETURN CODE JSB .MVW DEF .3 NOP * * THE FOLLOWING CODE WILL FILTER OUT THE IO REQUESTS * ONLY THOSE REQUESTS WILL HAVE THE SECOND PARAMETER * CHANGED TO A SINGLE WORD QUANITY * LDB TABLE STB TEMP .SET TABLE LENGTH LDB .TABL .SET TABLE ADDRESS LDA PRAM,I AND M77 .FETCH ICODE WORD TOP2 CPA B,I .IF A MATCH - PATCH ICNWD JMP DOIT ISZ TEMP .DONE ? INB,RSS .NO LOOK MORE JMP NODO .YES FINISHED NOT AN IO REQUEST JMP TOP2 * DOIT DLD ICNWD,I .FETCH THE DOUBLE WORD LU/FUNCTION CODE AND M77 .ELIMINATE ANY BITS ABOVE 5 IOR B .BLEND IN FUNCTION CODE STA TEMP .SET UP TEMP WITH PROPER VALUE LDA .TEMP .CHANGE PARAMETER AD@,  DRESS STA ICNWD * NODO JSB EXEC .DO THE EXEC CALL RTN1 NOP PRAM NOP ICNWD NOP REP 12 NOP YLUEX NOP MVPRM JSB .ENTR .PRAM DEF PRAM JMP TOP * FRTN JMP XLUEX,I .P+1 RETURN POINT ISZ XLUEX JMP XLUEX,I .P+2 RETURN POINT .3 DEC 3 TEMP NOP .TEMP DEF TEMP M77 OCT 77 CNT NOP .FRTN DEF FRTN .TABL DEF TABLE TABLE DEC -8 DEC 1,2,3,13,17,18,19,20 A EQU 0 B EQU 1 END \ ASMB,R,L HED LUTRU - DUMMY ROUTINE TO FIND TRUE LU * NAME: LUTRU * SOURCE: 92001-18005 * RELOC: PART OF 92001-16005 * PGMR: R.S. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 LUTRU,7 92001-16005 REV.1913 790119 EXT .ENTR ENT LUTRU SESLU NOP SYSLU NOP LUTRU NOP JSB .ENTR DEF SESLU LDA SESLU,I .FETCH LU STA SYSLU,I .GIVE IT BACK NO CHANGE JMP LUTRU,I END 0PASMB,R,L HED ENSES - ENTRY POINTS FOR SESSION SYSTEM COMPATIBILITY * NAME: ENSES * SOURCE: 92001-18005 * RELOC: PART OF 92001-16005 * PGMR: R.S. * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 ENSES,7 92001-16005 REV.1913 790119 ENT $CL1,$CL2 $CL1 NOP $CL2 EQU $CL1 END }ASMB,R,L,C HED LIMEM - MEMORY LIMITS * NAME: LIMEM * SOURCE: 92001-18005 * RELOC: 92001-16005 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 92001-16005 REV.1913 790202 * ENT LIMEM * EXT .ENTR * A EQU 0 XEQT EQU 1717B AVMEM EQU 1751B BGLWA EQU 1777B * IWHCH NOP IFWAS NOP IWRDS NOP * LIMEM NOP JSB .ENTR GET PARMS DEF IWHCH LDA IWHCH,I FIND MEM LIMITS? SSA JMP LIMEM,I NO, THEN RETURN * LDA XEQT GET ID SEGMENT ADDRESS OF THIS PROG ADA .23 INDEX INTO THE HIGH MAIN + 1 ADDRESS LDA A,I GET THE WORD STA IFWAS,I SET IN RETURN PARM * LDA XEQT GET ID SEG ADDRESS ADA .14 LDA A,I GET THE TYPE WORD AND B17 CPA .3 BACKGROUND PROGRAM? RSS YES JMP FG NO * LDA BGLWA LWA MEMORY OF BACKGROUND PARTITION JMP FLEN FIND LENGTH OF FREE AV MEM * FG LDA AVMEM LWA +1 OF REAL TIME PARTITION ADA N1 FLEN LDB IFWAS,I GET THE FWA OF FREE MEM CMB,INB ADB A INB LWA - FWA +1 STB IWRDS,I SET RETURN PARM WITH # WORDS JMP LIMEM,I RETURN * .3 DEC 3 .14 DEC 14 .23 DEC 23 B17 OCT 17 N1 DEC -1 END 2ASMB,R,L,C HED "IDGET" FTN/SPL FUNCTION TO FIND IDSEG ADDRESS OF PROG * SOURCE: 92001-18005 * RELOC: 92001-16005 * PGMR: D.L.B.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 92001-16005 REV.1913 790307 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 LDB 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 N4  AME AREA LDA B,I GET CHARS 1 & 2 CPA NAME,I EQUAL ? INB,RSS YES, CHECK NEXT 2 JMP LOOP NO, TRY NEXT PROGRAM LDA B,I GET CHARS 3,4 CPA NAME+1,I EQUAL? INB,RSS YES, BUMP AGAIN JMP LOOP NO, TRY NEXT PROGRAM LDA B,I GET LAST CHAR AND OM400 MASK TO 5TH CHAR CPA NAME+2 CLB,CLE,RSS FOUND!!!! JMP LOOP TRY NEXT PROG ENDTA LDA 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  ASMB,R,L,C ** SEGLD ** HED SEGLD - ROUTINE TO LOAD A SEGMENT * NAME: SEGLD * SOURCE: 92001-18005 * RELOC: PART OF 92001-16005 * PGMR: S.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * SEGLD CALLS EXEC TO LOAD SEGMENT. IF SEGMENT NOT FOUND, SEGLD * SCHEDULES T5IDM PROGRAM TO BUILD THE ID SEGMENT FOR THE SEGMENT * AND THEN CALLS EXEC TO LOAD SEGMENT. * * CALLING SEQUENCE: * CALL SEGLD(ISGNM,IERR,IP1,IP2,IP3,IP4,IP5) * WHERE: ISGNM = NAME OF SEGMENT * IERR = ERROR RETURNED BY SEGLD * IP1 - IP5 = OPTIONAL PARAMETERS TO BE PASSED * TO THE SEGMENT * * RETURN: * IERR = 5 IF SEGMENT NOT FOUND * = 0 IF SEGMENT LOADED * * NAM SEGLD,7 92001-16005 REV.1926 790202 ENT SEGLD * EXT .ENTP,EXEC,.DFER,$OPSY * SGNAM NOP IERR NOP PARM1 NOP PARM2 NOP PARM3 NOP PARM4 NOP PARM5 NOP * SEGLD NOP JMP CLRPM POINT THE 5 OPTIONAL .ZERO DEF ZERO PARAMETERS TO ZERO GTPRM JSB .ENTP GET THE PARAMETERS PASSED DEF SGNAM * TRY JSB EXEC LOAD SEGMENT DEF *+8 DEF .S8 =100010B -- NO ABORT BIT SET DEF SGNAM,I NAME OF SEGMENT DEF PARM1,I FIVE DEF PARM2,I DEF PARM3,I OPTIONAL DEF PARM4,I DEF PARM5,I PARAMETERS NOP * * SCHEDULE T5IDM TO SET UP ID SEGMENT FOR SEGMENT * JSB .DFER GET SEGMENT NAME DEF SGNM1 DEF SGNAM,I JSB EXEC DEF *+7 DEF .S23 =100027B SCHEDULE WITH NO ABORT DEF T5IDM \   DEF SGNM1 SEGMENT DEF SGNM2 NAME DEF SGNM3 DEF .1 ONE SEGMENT TO LOAD JMP SC05 T5IDM PROGRAM NOT FOUND * LDA $OPSY HOW TO GET THE RETURN PARAMETER ERA,SLA TEST THE DMS BIT JMP DMS IF DMS INSTALLED JMP * LDA B,I ELSE JUST LOAD THE DATA JMP TS GO TEST THE RESULT * DMS XLA B,I DMS DO THE DM CROSS LOAD TS SZA,RSS IF ZER THEN THE SEGMENT WAS SET UP JMP TRY GO TRY AGAIN * SC05 LDA .5 SEND ERROR 5 TO INDICATE SCO5 STA IERR,I JMP SEGLD,I RETURN * * ZERO DEC 0 .S23 OCT 100027 .1 DEC 1 .5 DEC 5 SGNM1 NOP SGNM2 NOP SGNM3 NOP T5IDM ASC 3,T5IDM * .S8 OCT 100010 * * CLRPM LDA .ZERO STA PARM1 STA PARM2 STA PARM3 STA PARM4 STA PARM5 JMP GTPRM DONE * * * A EQU 0 B EQU 1 END ASMB,R,Q,C HED TIME FORMAT SUBROUTINE * NAME: FTIME * SOURCE: 92001-18005 * RELPC: 92001-16005 * PGMR: G.A.A.,C.M.M. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 92001-16005 REV.1926 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  X1 92001-18012 1926 S 2222 RTE-II CORE RES. OP. SYSTEM             H0122 ASMB,Q * * NAME: $CRSY * SOURCE: * RELOC: * 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 $CRSY,0 92001-16012 REV.1926 790506 END ASMB,R,Q,C ** RT DISPATCHER MODULE ** HED REAL TIME DISPATCHER * NAME: DISPA * SOURCE: 92001-18012 * RELOC: 92001:16012 * 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 DISPA,0 92001-16012 780810 * SUP ******************************************************************** * * ***** AMD ***** JUL,73 * * ******************************************************************** * * DISPATCHER ENTRY POINT NAMES * ENT $RENT,$BRED,$ZZZZ,$XEQ * * DISPATCHER EXTERNAL REFERENCE NAMES * EXT $RSRE,$ABRT,$XSIO,$DREQ EXT $WATR,$TIME,$DREL,$TRRN EXT $IOCL,$IRT EXT $ABRE,$LIST,$RTST * ******************************************************************** * * 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 * SKP ABORT LDA B,I GET POSSIBLE 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 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 GET THE CURRENT FLAG WORD STA TEMP,I (CLEAR THE OLD FLAG WORD) SLB IF LEAST BIT SET THEN JMP $XEQ HE IS SERIALLY REUSABLE SO LEAVE IN CORE * LDB TMP RESIDENT CPB RDISK IN FORGROUND JMP X0253 GO CLEAR IT OUT CPB BKRES IF BACKGROUND AND RESIDENT JMP X0153 GO CLEAR IT HED REAL TIME DISPATCHER - LIST PROCESSING SECTION- * CALLING SEQUENCE * JMP $XEQ * $XEQ LDB $ZZZZ CHECK IF PROGRAM TO BE ABORTED SZB JMP ABORT YES GO HANDLE IT * STB FSWP CLEAR THE BEEN HERE FLAGS STB BSWP FOR FORGROUND AND BACKGROUND 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 SET $LIST TO ZERO TO PREVENT STB $LIST RESCAN 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 PRO=lGRAM * * 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 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 X0029 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 A,B,E,O REGS. SHARE THE SAME LOC. IN IDL NOP STORAGE FOR OPTIONAL Y REGISTER. 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 * * 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 REAL TIME RESIDENT JMP X0040 YES CPA D2 CHECK IF REAL TIME DISK RESIDENT JMP X0200 YES CPA D4 CHECK IF BACKGROUND RESIDENT JMP X0040 YES CPA M3 CHECK IF BACKGROUND DISK RESIDENT PROGRAM JMP X0100 YES JMP X0035 NOT LEGAL TYPE, IGNOR * DM8 DEC -8 DM12 DEC -12 M40 OCT 40 DM2 DEC -2 MI EQU DM2 HED LOAD PROGRAM ID SEGMENT ADDRESSES INTO XEQT AREA X0040 LDA ZWORK SET CORE RES X,Y SAVE ADD ADA MI IN A STA XI SET X,Y FOR RESIDENT PROG. X0D40 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 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 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 * * SET MEMORY PROTECT ACCORDING TO PROG TYPE * X0028 LDA XEQT COMPUTE PROGRAM TYPE ADDRESS ADA D14 CCB BY SUBTRACTING ONE FROM ADB A,I ITS TYPE LDA RTORG ASSUME FORGROUND RBR,SLB GOOD ASSUMPTION? LDA BKORG NO USE BACKGROUND FENCE X0029 STA FENCE SET THE FENCE ADDRESS OTA 5B * * RESTORE REGISTERS, MEMORY PROTECT, AND TURN ON INTERRUPT SYSTEM * JMP $IRT GO EXECUTE THE PROGRAM HED XEQ PROCESSOR--BUFFERS, CONSTANTS, POINTERS, ETC * RDISK NOP RT DISK PROG RESIDENT SWITCH BKRES NOP BACKGROUND PROG RESIDENT SWITCH BKREF NOP READ COMPL FLAG-BACKGROUND DISC RDISF NOP READ IN COMPL FLAG-RT DISC * 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 * HED XEQ PROCESSOR--BACKGROUND DISK PROGRAM LOADING * * BACKGROUND DISK RESIDENT PROGRAM SCHEDULED * * * IF PROGRAM IS NOT RESIDENT OR BEING LOADED, GO TO * * R 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 ISZ BSWP SET BEEN HERE FLAG LDB BKRES CHECK IF PROGRAM RESIDENT SZB,RSS YES, SO CHECK IF READ IN COMPLETE JMP X0120 NO, SO GO READ IT IN LDA BKREF GET READ COMPLETION FLAG CPB ZWORK IF DESIRED PROGRAM JMP X0130 GO CHECK FOR READ COMPLETE CCA ADA BSWP CHECK BEEN HERE FLAG CCE,SZA BEEN HERE BEFORE? JMP X0035 YES SO RETURN, STILL CAN'T DO ANYTHING. * * SET UP TO CALL SWPCK * LDA BKDRA GET THE LOW MEMORY BOUND STA LOADD AND SET IT LDA BKLWA NOW SET THE HIGH INA STA HIADD ADDRESS(SEE SWPCK) LDA BKREF GET THE READ IN FLAG TO A JSB SWPCK CHECK SWAPABILITY JMP X0152 GO CLEAR CURRENT LOAD JMP X101 GO SWAP OUT CURRENT PGM. * * LOAD RETURN FROM SWPCK * X0120 LDB ZWORK GET THE ID-SEG. ADDRESS AND STB BKRES SET PGM RESIDENT JSB $BRED GO READ IN THE PGM. JMP X0005 RESCAN THE SCHEDULED LIST SPC 2 X0130 CLB,INB CHECK IF STILL IN CORE CPA M3 AFTER A SWAP STB BKREF RESET TO SHOW IN CORE LDB BKDRA GET X,Y SAVE ADDRESS JMP X0240 GO FINISH IN FG PROCESSOR SKP * * BACKGROUND READ IN COMPLETIOKN 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 BKREF STEP THE BACKGROUND LDB BKRES GET THE BACKGROUND RES. ID ADDRESS LDA BKRQ STATE FLAG, IF SWAP X0125 ISZ $LIST SET LIST FLAG TO FOURCE SCAN SLA,RSS THEN JMP $XEQ GO SCAN THE LIST CLA,INA SET READ IN COMPLETE FLAG CPB BKRES TO ONE IF STA BKREF BACKGROUND READ COMPLETE 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.* * L 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 BKRES ID SEGMENT ADDRESS LDA ZPRIO,I SET A TO PRIORITY JSB BKRED GO SET UP AND START SWAP ISZ BKREF SET THE SWAP OUT FLAG JMP X0035 SPC 2 X0152 LDB BKRES RESCHEDULE THE JSB $LIST PROGRAM OCT 401 X0153 STA BKRES CLEAR THE RESIDENT FLAG LDB BKREF GET THE BACKGROUND STATE FLAG LDA DX166 GET THE ABORT LINK ADDRESS X0154 SLB,RSS IF NOT DOING AN XFER. SKIP JMP $IOCL ELSE GO CANCEL THE LOAD JMP $XEQ GO TRY AGAIN SPC 1 DX166 DEF X0166 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 ISZ FSWP SET BEEN HERE FLAG LDB RDISK CHECK IF PROGRAM RESIDENT SZB,RSS YES, SO CHECK IF READ IN COMPLETE JMP X0220 NO, SO GIO READ IT IN LDA RDISF GET READ COMPLETION FLAG CPB ZWORK IF DESIRED PROGRAM JMP X0230 GO CHECK FOR READ COMPLETE CCA ADA FSWP CHECK BEEN HERE FLAG CLE,SZA BEEN HERE BEFORE? JMP X0035 YES SO RETURN, STILL CAN'T DO ANYTHING. * * SET UP TO CALL SWPCK * LDA RTDRA GET THE LOW MEMORY BOUND STA LOADD AND SET IT LDA AVMEM NOW SET THE HIGH STA HIADD ADDRESS. LDA RDISF GET THE READ IN FLAG TO A 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. * * * X0220 LDB ZWORK CHECK IF PREVIOUSLY SWAPPED STB RDISK STORE ID SEGMENT ADDRESS JSB $LIST I/O SUSPEND THE PROGRAM OCT 402 UNTIL READ COMPLETED CCA,CCE SET FOR PREST STA RDISF SET READ IN WAIT FLAG 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 RDISK 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 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 ISZ RDISF SET THE STATUS FLAG JMP X0035 IF SWAP GO CONTINUE SEARCH JMP X0005 ELSE RESCAN THE LIST 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 RDISF STEP THE STATE FLAG LDB RDISK GET THE RESIDENT ID ADDRESS LDA FGRQ GET THE REQUEST CODE JMP X0125 GO FINISH CHECKS ETC. SPC 2 X0252 LDB (B@ * *** 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-DR>IVEN * 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 EXEC@xUTED. * 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 VAL5nUE 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 (ENAB'LED). * 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 z * 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 * 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 P 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 JMP NMX1 CXA IF MX CPU CYB IF MX SAVE THE X/Y REGS DST XI,I 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. * LDA INTCD (A) = INTERRUPT SOURCE CODE * CIC.6 EQU * 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* * 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 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 BAVSE PAGE FOR THE PROGRAM * * JMP $IRT * $IRT LDA XSUSP,I GET THE EXECUTE ADDRESS * STA INTCD SAVE THE RETURN ADDRESS MX2 EQU * ADDRESS OF JMP MX2 JMP NMX2 (DLD IF MX CPU) DEF XI,I ADDRESS FOR DLD IF MX 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 JMP INTCD,I -RETURN- 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 D$LUT DEF $LUSW ADDRESS OF BATCH LU TABLE $OPSY DEC -3 EXTERNAL FLAG INDICATING RTE-II SYSTEM. $DATC DEC 1926 DATE CODE OF OPERATING SYSTEM MODULE. * $BLLO DEC -100 LOW BUFFER LIMITS *1926DLS* $BLUP DEC -300 UPPER BUFFER LIMITS *1926DLS* 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 ITDENTIFIED 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#: 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 OPvERATION * =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 #) * 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 SETBNLH 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 * * 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 CvN* 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 REQ>hUEST 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 1) * DEF OPT2 (OPTIONAL PARAMETER 2) * 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. * OPT1 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! * ------------------------------------------------------ * 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 LIST (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 AN.D 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 IMMEADIATE 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 TRANSUFER 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. LDA RQP1 GET THE RQ CODE. *1926DLS* * * 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. CPA B21 IF CLASS READ, THEN *1926DLS* JMP L.01 SKIP BUFFER CHECK. *1926DLS* 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,ALF 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 A 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)S 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 STB 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 qPROGRAM 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 AVAIABLE. * 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'S 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 UêNLHSE 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 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 N 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 LDA 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 SECOND 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. JMP $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 STA B,I AND SET IN WORD 2 OF BLOCK. INB LDA TEMP6 SET REQUESTING PROGRAM PRIORITY STA B,I IN WORD 3. INB LDA L.04 SET BLOCK LENGTH IN STA B,I WORD 4. INB LDA TEMPW,I GET THE CONWORD SSA,RSS IF STANDARD REQUEST JMP L.061 SKIP * LDA CLASS ELSE SET THE CLASS STA 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 STA 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 STA 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 STA 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 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 MOXVE. JSB .MVW USE WORD MOVE SUBROUTINE DEF TEMP3 (RP'ED IF MX (WE HOPE)) NOP 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 * STB 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 STA 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) * 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. * ISZ SECCD,I INCREMENT CLASS QUEUE COUNT BY 1 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 JMP 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 LDA B,I AND AND .3 ISOLATE THE REQUEST CODE STA RQP7,I RETURN IT TO USER'S IRC'LS INB STEP TO STATUS WORD LDA B,I GET COMPLETION STATUS. STA XA,I AND SET IT IN THE A REG. INB GET THE BUFFER LENGTH LDA B,I AND SET IT STA CLTMP FOR RETURN INB STEP TO USER CLASS WORD LDA B,I GET IT AND B174C KEEP SECURITY CODE CPA SECCD MATCHES CALLER'S? RSS JMP ERR00 NO, ERROR IO00 * INB INDEX TO THE LDA B,I TLOG AND STA XB,I SET IT IN THE 'B' REG INB INDEX TO THE LDA B,I FIRST OPTIONAL WORD AND STA RQP5,I SET IT IN THE USERS BUFFER INB NOW DO THE SECOND OPTIONAL WORD LDA 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 STB TEMP3 SET THE COUNT LDB RQP3 GET DESTINATION ADDRESS JSB .MVW MOVE WORDS DEF TEMP3 COUNT ADDRESS NOP * G.05 LDA RQP2,I IF SAVE RAL,RAL QUEUE OPTION SLA,ELA THEN JMP L.16 THEN EXIT * LDA 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 SCNHEDULE 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 k * 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 STB TEMP1 SET LIMIT LDA EQT1,I START AT 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 kfGET 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 JMP QCHK,I RETURN * 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 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. * 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 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 (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 NLHTEMP5,I SET THE POINTER TO THE NEW REQUEST JMP LINK,I IN NEW - EXIT TO CALLER. * SPC 1 .1 DEC 1 .2 DEC 2 .4 DEC 4 .6 DEC 6 .7 DEC 7 .15 DEC 15 SKP 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 qN* (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. * * * 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. 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. * * CALL DRIVER -INITIATION- SECTION * LDA EQT14,I SET DEVICE LDB EQT15,I TIME OUT CLOCK ONLY SZB,RSS IF NOT CURRENTLY RUNNIjNG 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* RBL,CLE,ERB *1926DLS* 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 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 > * 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 OC"kT < 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 .3 SET B TO THE RETURN ADDRESS STB $XSIO AND SAVE IT ADB N1 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 EXIT. * LDA $CKLO ELSE, IF DEVICE IS JSB STADV DOWN, THEN RETURN RSS TO CALLER. * JSB DRIVR CALL DRIVER TO INITIATE OPERATIONtG 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 OFF 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 > * 2 < LOGICAL UNIT # > * 3 * 4 < LINKAGE WORD > * 5 * 6 * 7 * * 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. * 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 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 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 SHOULDS * 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. * 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. JNLH * * 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 N 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 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). Q 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 > * * 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 DIAGNOSpTIC 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 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 * d 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 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 = THEb 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 STB 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 AoND 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 FIRS#T 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 LJSTA 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 * ************************************************************************ SKP $UNLK NOP STA UNLK8 SET UP POINTER TO THIS I/O REQUEST QUEUE. LDA $UNLK,I GET LDA A,I 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. 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. 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 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 JMP $UNLK,I INITIATE THE I/O REQUEST. * 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)
    * * $DONLHEVT 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 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 > N* ***************************************************************** * * 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 SZB,RSS IF MX SKIP 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 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 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. * 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 GENERAL 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 fEQT# 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 CPEQT GET EQT # STA TMP1 FROM EQT1. LDA .4 RESCHEDULE ALL WAITING PGMS. JSB $SCD3 (RETURN B=0). * LDA EQT5,I IF EQT IS BUSY OR WAITING FOR *1926DLS* SSA,RSS DMA, THEN SKIP DMA RELEASE. *1926DLS* JSB CLDMA OTHERWIZE,IF AV OR DOWN,RELEASE DMA. * JSB XUPIO SET ANY ASSOCIATED 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 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 * ***************************************************************** * $XXUP NOP STA TEMP4 SAVE OLD DEVICE EQT1. 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. * XXUP2 CLB SET B=0. LDA XXUP7 GET INITIATION FLAG JMP $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 * kMAINTAINS 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 JSB .MVW MOVE DEF .10 THE NOP 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> 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 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 * 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 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. 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,I 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 SֻO 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 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 LATE,R) 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 gNLH 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 TMP1 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?? N 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 FbASMB,R,L,C ** RT EXEC CENTRAL CONTROL MODULE ** HED ** REAL-TIME EXECUTIVE CENTRAL CONTROL MODULE ** * NAME: EXEC * SOURCE: 92001-18012 * RELOC: 92001-16012 * 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 EXEC,0 92001-16012 770131 * ***** AMD-DAS ***** FEB,72 ***** REV.LWH ***** * ENT EXEC,$ERMG,$RQST,$OTRL ENT $LIBR,$LIBX,$DREQ,$DREL,$SDRL,$SDSK ENT $ERAB,$PVCN,$REIO,$CREL,$RSRE,$ABRE ENT $PDSK ENT $PWR5 * EXT $CVT3,$SYMG,$LIST,$XEQ EXT $RENT,$CVEQ,$ABRT EXT $CGRN,$SCLK,$ALC,$RTN EXT .MVW SUP $PDSK EQU 0 DEFINE DEFAULT FOR DISC PROTECT * ***** < 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 * AR 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 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 AMS POINT OF SUSPENSION. STB $LIBR SAVE (P+1) OF ISZ $LIBR CALL. 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 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 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 RTORG 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 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 ADDREUcSS 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 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) * j - 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 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 MEMORY NOW, SUSPEND. CCE ALLOC DONE. * CPB TEMP4 DID WE GET THE REQUESTED NUMBER? B40 CLE YES CLEAR E AS A FLAG * LDB TEMP2,I GET OLD POINTER STA TEMP2,I SET NEW BLOCK ADDRESS STB 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 STB 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 STB A,I INA CLEAR CLB WORD STB 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 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 JLDA 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 THE ADDR AS THE SUSP.POINT. JMP LB5 * * * INITIATE PRIVILEGED EXECUTION OF USER PROGRAM * PVEXC EQU * RESTORE REGISTERS. JMP NOTMX (OR DLD IF MX CPU) * DEF XI,I DEF FOR DLD 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 * TEMP6 COUNTER * TEMP7 ID-EXTENSION ADDRESS(CONTENTS OF TEMP1,Ià) * MTDB NOP 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 * MTDB2 STA AHLD SET UP DESTINATION POINTER LDA TEMP1,I SAVE THE ID-EXTENSION ADDRESS STA TEMP7 LDA TEMP1 GET THE TDB ADDRESS DST AHLD,I AND SET IT IN THE SAVE AREA. AHLD EQU *-1 ADB DM2 ADJUST COUNT FOR MOVE STB TEMP6 AND SET FOR MVW ADA D2 ADJUST THE FROM ADDRESS LDB AHLD GET THE TO ADRESS ADB D2 ADJUST THE TO ADDRESS JSB .MVW MOVE WORDS DEF TEMP6 TO SAM NOP * CLA STA TEMP1,I SET THE TDB "FREE" LDB 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 IOR SIGN SET THE MOVED FLAG STA TEMP7,I AND SET IN THE EXTENSION. JMP MTDB,I RETURN * MTDB0 CLA NEVER ANY MEMORY CLB RETURN (A)=0, (B)=0 JMP MTDB,I 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 LDB B,I GET THE ADDRESS OF THE EXTENSION SZB,RSS END OF LIST? JMP <:6FINDL,I YES- MAKE NOT FOUND RETURN LDA B ADDRESS TO A INA STEP TO THE ID-ADDRESS LDA 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 LDB 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 * $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 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 LDA B,I TDB ADDRESS TO A RAL,CLE,SLA,ERA CLEAR MOVED FLAG, SKIP IF NOT LDA A,I IF MOVED GET THE TRUE TDB ADDRESS 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 LDB 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 LDA 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 LDB A,I OLD TDB ADDRESS TO B CMA,INA NEG. OF NEW ADDRESS TO A 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 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 RSRE1 LDB XEQT GET THE ID-SEGMENT EXTENSION JSB FINDL JMP RSRE3 NOT FOUND GO EXIT * RSRE2 ADB D2 INDEX TO THE TDB ADDRESS LDA 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 LDB 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 JMP $RSRE,I RETURN * RSRE4 RAL,CLE,ERA CLEAR THE SIGN BIT AND STA TEMP5 SAVE THE ADDRESS STB TEMP3 SET THE FORM ADDRESS DLD A,I GET THE TDB ADDRESS & # OF WORDS STA TEMP1 SET THE TDB ADDRESS STB TEMP9 AND THE RETURN COUNT DLD A,I GET CURRENT OWNER AND ACTUAL COUNT STB TEMP6 SET COUNT FOR ALLOCATION ADB DM2 SET UP THE MOVE COUNT ST B TEMP4 SAVE IT CCE,SZA SKIP IF SUBROUTINE IS FREE JSB MTDB MOVE THE OTHER USER TO SYS. MEM. * 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 STB TEMP3,I LDA TEMP5 GET ADDRESS OF MEMORY ADA D2 ADJUST FOR MOVE ADB D2 ADJUST TO ADDRESS ALSO JSB .MVW MOVE THE WORDS DEF TEMP4 NOP JSB $RTN RETURN THE MEMORY TEMP5 NOP TEMP9 NOP JMP RSRE1 GO TRY AGAIN 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 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 $ABRE,I NO EXIT * LDA B,I YES UNLINK FROM LIST STA 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 LDA A,I AND SAVE STA TEMP4 IT * ADB D2 INDEX TO THE TDB ADDRESS LDA 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 ABRE3 IN DISC RESIDENT PGM. * ABRE2 STA TEMP7 SET UP TO RETURN IT INA STEP TO THE LENGTH LDA 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 ABRE4 JSB RTN4 RETURN THE 4 WORD EXTENSION LDB TEMP4 GET ADDRESS OF NEXT CCE,SZB EXTENSION JMP ABRE1 GO DO IT IF IT EXISTS JMP $ABRE,I DONE - RETURN HED $LIBX EXIT PROCESSOR FOR RENT/PRIV LIB ROUTINES SKP * < $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 SAVXY JMP $RENT (CXA IF MX CPU) 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 LDB 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 LDB B,I RELINK THE BLOCKS STB 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 * L  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 * 9 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). THESE DISCS * MAY BE DIFFERENT MODELS OF A FIXED-HEAD * DISC AND WITH DIFFERING NUMBER OF SECTORS * PER TRACK. FOR THIS REASON THE WORDS * 'SECT2' ANDK 'SECT3' IN THE BASE PAGE * COMMUNICATION AREA CONTAIN THE NUMBER OF * SECTORS PER TRACK FOR LOGICAL UNITS 2 AND 3. * * SKP * 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. CPA 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 b<:6 * = -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 a<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 A 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 * 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 * * SUBROUTINE: <$ERMG> * * PURPOSE: THIS ROUTINE FORMATS A DIAGNOSTIC * MESSAGE WHICH CONTAINS A FOUR * CHARACTER MNEMONIC DESCRIBING THE * ERROR WITH THE PROGRAM NAME AND * LOCATIONT 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 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 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, LIB 6 SZB,RSS IF NOT AN MX CPU JMP NOXY DON'T ENABLE X,Y SAVE,RESTORE * LDB $DREL ELSE SET A CXA STB SAVXY IN SAVE REG. ROUTINE LDB DLD AND A DLD IN STB PVEXC IN THE RESORE REG. ROUTINE NOXY LDB $SDSK,I RESTORE B FOR $CGRN 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 * 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 * * * * 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 H8 24/2{95 (SCHEDULE NO WAIT/WAIT) 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 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, 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 BAB@ * * 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 \RGO 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 MUST 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 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 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 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 JMP NPG1 * NPRG CCA RESTORE ADA RETRN $LIST FOR STA $LIST RETURN. NPG1 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 SUSPENDED L0103 ALF,SLA,RAL SET DORMANT BIT JMP L0350 ELSE GO CHECK RESOURCE BIT * IOR WSTAT,I IF I-O SUSP,MERGE CURRENT STATUS AND SEE IF AND CL.NP (CLEAR NO PARMS BIT) *1926DLS* JMP L0375 NP BIT OF 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 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 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/Op 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 OTHERWIZE, GO 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 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 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 IOR WSTAT,I NLH *1926DLS* JMP L0375 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 N* 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 * 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 6A 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 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 * 18. SWAP STATUS * SW[,N] * 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 * 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 O P 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. ******************************************************************* * 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 COMPAR}E NEXT OP CODE * OPER LDA $OPER ILLEGAL OPERATION CODE REQUEST JMP $MESS,I  * * LDOPC DEF *+1 OPERATION CODE TABLE ADDRESS ASC 8,RTONOFSSGOSTPRIT $ASTM ASC 9,TMDNUPLUEQLSLGTOTI ASC 5,SWBRABRUBL 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 M0625 SW 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) * 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, 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--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 IF SUSPENSION POINT IS ZERO, LDA B,I THEN PROGRAM IS DORMANT. SZA OTHERWIZE, SEND ILLEGAL JMP M0405 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 NOG 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 $MESS,I 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 GO TO TIME MODULE TO COMPLETE 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 * * CLEAR NO-PRAMS BIT IN CASE PROG IS IN TIME LIST * ADB D15 ADVANCE TO ID16 LDA B,I FETCH IT AND CL.NP REMOVE THE NO-PRAMS BIT STA B,I RESTORE THE WORD LDB WORK FETCH ID ADDR AGAIN * 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 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 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 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 NLHZAPR 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 sN 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 $MESS,I 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 * ***************************************************************** * * 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 $MESS,I * M0405 LDA $ILST ILLEGAL STATUS MESSAGE ADDRESS JMP $MESS,I 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 * 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 CMA,INA,SZA,RSS GO DO JMP M0550 CURRENT PGM * LDB DRDIS,I SET UP FOR FOREGROUND INA,SZA,RSS IF ONE JMP M0550 GO PRINT IT'S NAME * LDB DBDIS,I GET BASKGROUND DR ID-SEG ADDRESS INA,SZA,RSS IF 2 THEN JMP M0550 GO PRINT IT'S NAME. * 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 ADB D20 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 S8TORE 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 $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 $MESS,I 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 SPC 1 M0550 CCA SET A FOR ZERO PRINT SZB SKIP IF NO PROGRAM LDA DM5 ELSE RESET A FOR PGM PRINT 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 M0555 LDA B,I STA BUFF1 SET NAM12 INB STEP TO NEXT NAME WORD DLD B,I GET THE NEXT WORDS DST BUFF2 AND SET IN THE BUFFER JMP M0520 GO EXIT SPC 2 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 BUFF_3 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 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 STB DRDIS SET FG RESIDENT FLAG ADDRESS INB AND STB DBDIS BACKGROUND DISC RESIDENT FLAG ADDRESS 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 TO 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 TES EQU ENDT-* ERROR HERE MEANS OUT OF BUFFER 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 ORR EXIT BUFFER 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--SW,X COMMAND * * SW[,N] * * IF N IS NOT PRESENT PRINT THE BASE PAGE SWAP FLAG * IF -1=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 - EXIT 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 $MESS,I 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 $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 **************c***************************************************** * 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 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 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. JSB .MVW GO MOVE WORDS. DEF TYPCO NOP * JSB $XSIO CALL TO OUTPUT ERR MESSAGE OCT 1 DEF TYP30 % COMPLETION ADDRESS TYPCO NOP OCT 2 DEF INBUF TYP26 NOP 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 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 ****l*************************************************************** * 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 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 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 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 tWAITING. 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 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 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 MUyST 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. * 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 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 ESC03 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 * 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 NEGQTIVE. 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 SURE IT IS NOT LDA B,I A SEGMENT AND D7 CPA D5 IF SEGMENT JMP ESC03 TAKE GAS! * LDB XEQT COMPUTE THE ID NUMBER TNLH 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 N 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 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 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 ADB BFCNT TO 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. JSB .MVW GO MOVE WORDS. DEF XB,I NOP 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 NOW 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 * * *-------------------* * * * * *-------------------* * * 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 BUFFERx CHAR 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 AND TEMP4 ARE USED. * CALLS $RTST WHICH USES TEMP2 AND TEMP3. * * 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 REGISTER * 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 CALLS FROM SON TO FATHER). * *************************************************************** * ALCST NOP STB TEMP1 SAVE ID ADDRESS. LDA XTEMP SAVE ADDRESS OF STA TEMP4 CURRENT PROGRAM'S ID WORD 2. 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. 0 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. JSB .MVW GO MOVE WORDS FROM USER MAP. DEF RTSTW NOP ISZ ALCST SUCCESSFUL RETURN. ALST8 ISZ ALCST NO MEMORY NOW RETURN. ALST9 LDB TEMP4 RESTORE THE CURRENT STB XTEMP PROGRAM'S 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 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 FOR TEMPORARY STORAGE. * 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 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 Y STORE TOTAL 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 JMP $RTST,I RETURN. SKP ********************************************************************** * * SUBROUTINE $STSH CHASES DOWN A STRING BLOCK IN THE STACK * HEADED AT $STRG GIVEN THE ID-SEGMENT ADDRESS. * * 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-WORDS) XPRIO EQU .+46 'PRIORIrTY' 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 OPFLG * A EQU 0B LOCATIO<:6ON OF A REGISTER B EQU 1B LOCATION OF B REGISTER ORG * PROGRAM LENGTH END $LIST <ASMB,R HED * REAL-TIME EXECUTIVE MEMORY ALLOCATION * * NAME: $ALC * SOURCE: 92001-18012 * RELOC: 92001-16012 * 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 $ALC,0 92001-16012 741120 * ENT $ALC,$RTN 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 * 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 SET BUFFER LENOGTH 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 t<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 V  92001-18014 1631 S 0122 &AUTOR AUTO RESTART (AUTOR)             H0101 FTN,L C NAME: AUTOR C SOURCE: 92001-18014 C RELOC: 92001-16014 C PGMR: G.A.A. C D.L.S.,760622 C C PROGRAM AUTOR(2,1) 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(2)) C ***************************** C G 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 HERE. 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$ G  92001-18015 1631 S C1222 RTE II SYSTEM GEN PART I             H0112 *ASMB,R,L,Z USE 'Z' FOR RTE-III GENERATOR *ASMB,R,L,N USE 'N' FOR RTE-II GENERATOR HED REAL TIME SYSTEM GENERATOR * NAME: RTGEN * SOURCE: 92001-18015 (RTE-II AND RTE-III) * RELOC: 92001-16015 (RTE-II) 92060-16030 (RTE-III) * PGMR: GAA/RHB * * *************************************************************** * * THIS PROGRAM CONTAINS INFORMATION WHICH IS PROPRIETARY TO * * * THE HEWLETT-PACKARD COMPANY. IT IS NOT TO BE DISCLOSED TO * * * ANY THIRD PARTIES OR REPRODUCED EXCEPT FOR ARCHIVE PURPOSES * * *************************************************************** * IFN *** BEGIN NON-MEU CODE *** NAM RTEGN 92001-16015 REV.1631 760630 **** END NON-MEU CODE **** XIF IFZ ***** BEGIN MEU CODE ***** NAM RTEGN 92060-16030 REV.1631 760630 ****** END MEU CODE ****** XIF SPC 1 ENT N1,N2,N3,N4,N5,N6,N8,N9,N10,N16,N27 ENT N64,P2,P3,P4,P5,P6,P7,P8,P9,P11,P12,P13,P14 ENT P15,P16,P17,P18,P19,P20,P21,P22,P23,P24,P25 ENT P28,P29,P31,P33,P60,P64,P99,P202,P6K,L60,L2000 ENT M60,M77,M120,M177,M377,M777,M400,D128,M200,M0760 ENT M1740,M1600,M1777,M2000,M1377,M7400,M7000,M7600 ENT M7700,M7777,M0300,M1177 ENT DPWRS,P0100,P1000,P100,P10,P1 ENT OPWRS,M0100,M1000,M100,M10 ENT PPREL,LWASM,BLANK,UBLNK,MSIGN,RPARB ENT ADBP,DSKA,MOVW * * ENTRY POINTS FOR THIS MODULE * * VARIABLES ... * EXT DSKAB * * UTILITY SUBROUTINES * ENT DOCON,SPACE,READ,GETNA,GINIT,GETOC,GETAL ENT INERR,YE/NO,LSTS,ERROR,LSTE,LABDO,IRERR ENT OUTID,CONVD * ORB A EQU 0 B EQU 1 SPC 2 * THE FOLLOWING LABELS ARE TO BE SATISFIED BY THE DRIVER MODULE * OF THE GENERATOR. THAT MODULE TAKES CARE OF ALL THINGS WHICH * DEPEND ON THE DETAILS OF THE DISC AND ITS CONTROLER. * EXT SYSCH SYSTEM SUBCHANNEL EXT AUXCH AUX DISC SUBCHANNEL EXT DSIZE SY'STEM DISC SIZE (TRACKS) EXT DAUXN AUX DISC SIZE (TRACKS) EXT DSETU INITILIZE SUBROUTINE EXT DSKSC SCRATCH DISC ADDRESS EXT LSSYS,LSAUX LAST SEEK FLAGS EXT DISKA INCREMENT DISC ADDRESS SUBROUTINE EXT DISKO DISC OUTPUT ROUTINE EXT DISKI DISC INPUT ROUTINE EXT DSTBL GENERATE DISC TABLE SUBROUTINE EXT TRTST TEST CURRENT TRACK SUBROUTINE EXT DTSET SET UP TAT SUBROUTNE EXT SDS# SYSTEM DISC SECTORS/TRACK EXT ADS# AUX DISC SECTORS/TRACK EXT FSECT FLUSH FINAL SECTOR FROM CORE EXT DERCN DISC ERROR COUNT EXT DBPO ORG OF DUMMY BASE PAGE EXT DSKAB INITIAL ABS DISC ADDRESS EXT PTBOT CONFIGURE DISC/ PUNCH BOOT SKP * GENERATOR ORGANIZATION * ORDER * OF EXECUTION SPC 3 ***************** - HIGH CORE - ****************** * * * SIO DRIVERS (TTY,LP,PT,HSP,MT) * * * ************************************************** * - IDENTS - * * ---------- * * * * - FIX UP TABLE - * * ------- * * - LST - * ************************************************** * * * DISC MODULE USUALLY HERE * * * ************************************************** * * * LOAD, LINKAGE SUBROUTINES * * * ************************************************** * * {* FINAL CLEAN UP, LIBRARY MOVE * 8 * DIRECTORY CREATION ECT. * * * * IFZ - (DMS SYSTEM) PARTITION DEFINITION, * * PROG SIZE OVERRIDE, ETC. * * * * PROGRAM LOADING CONTROL * 4,6 * * ************************************************** * * * I/O TABLE GENERATION * 5 * * * PARAMETER INPUT * 3 * * ************************************************** * * * * * RELOCATABLE PROGRAM INPUT * 2 * * * INITIALIZATION * 1 * * * * ****************** - 2000 - ********************** * * * * * DATA AREAS, SOME GENERAL SUBS. * * * * * ************************************************** 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: ID5 - CURRENT DISK ADDRESS * WORD 6 (15): ID6 - M/S * WORD 6 (08-14): ID6 - NOT USED * WORD 6 (00-06): ID6 - TYPE * WORD 7: ID7 - LOWEST DBL ADDRESS * WORD 8: ID8 - DISK LENGTH FOR UTILITY RELOCATABLES * OR.. MAIN IDENT ADDR FOR SEGMENTS * OR.. (DMS SYSTEMS) PG REQMTS (8 BI4TS) * THEN KEYWD INDEX (LOW 8 BITS). * * 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 ADDRESS OR 2 IF COMMON, 3 IF ABS, 4 IF REPLACE * WORD 5: LST5 - SYMBOL VALUE * * * PROGRAM TYPES (NON-DMS) * * 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: (DMS SYSTEM SSGA MODULE) CONVERTED TO TYPE 7. * 16-29,31 (DMS MODULES USING SSGA) TYPE SET TO TYPE-16. * 15,32-99:UNUSED (TYPE + 80 IS USED TO DESIGNATE AUTO SPC 1 * PROGRAM TYPES (DMS 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.) * * * FIX UP TABLE FORMAT * * FIX1: CORE ADDRESS * FIX2: INSTRUCTION CODE * FIX3: OFFSET * FIX4: ADDRESS OF LST ENTRY REFERENCED OR ZERO IF NONE. SKP * * ERROR CODES * * 1: INVALID TTY REPLY TO INITIALIZATION PARAMETERS * 2: CHECKSUM ERROR * 3: RECORD OUT OF SEQUENCE * 4: INVALID RECORD TYPE * 5: DUPLICATE ENTRY POINTS * 6: NOT USED * 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: DISK OVERFLOW (NEXT DISK ADDR EXCEEDS LAST AVAIL DISK ADDR) * 18: MEMORY OVERFLOW * 19: ATTEMPT TO RESTART AFTER CLEAN-UP BEGUN * 20: NOT USED * 21: '$CIC' NOT FOUND IN LOADER SYMBOL TABLE * 22: DISK READ PARITY/DECODE 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: ABSOLUTE SYSTEM HAS OVERLAYED A RELOCATABLE PROGRAM * 39: ILLEGAL SYSTEM CALL OF TYPE 6 PROGRAM * 40: MH RTEGN ATTEMPTED TO USE A DEFECTIVE CYLINDER * 41: MORE THAN 10 BAD TRACKS IN A MOVING HEAD SYSTEM * 42: ABSOLUTE SYSTEM INCLUDES A BAD TRACK * 43: DISC SPECIFICATIONS DO NOT CONFORM +TO SYSTEM DISC 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 TO 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 * USER RESPONSE: CHANGE TYPE OR DELETE SSGA REFERENCE * 54: SUBROUTINE OR SEGMENT DECLARED MORE COMMON THAN MAIN * USER RESPONSE: RECOMPILE MAIN SPECIFYING MAX COMMON NEEDED HED RTE GENERATOR - CONSTANTS AND ADDRESSES * DRPTR EQU 101B PT READER DRIVER ADDRESS DRKEY EQU 102B KEYBOARD OUPUT DRIVER ADDRESS DRHSP EQU 103B HS PUNCH DRIVER ADDRESS DRTTY EQU 104B TELETYPE INPUT DRIVER ADDRESS FWAM EQU 105B LWAM EQU 106B END AVAIL. MEM - SET BY DRIVERS DRMAG EQU 107B (TEMP MAG TAPE DRIVER ADDR) . EQU 1650B ORIGIN OF SYS COMM AREA SPZC 1 TRANS DEF RTEGN TRANSFER ADDR TO RTEGN AINPT DEF INPUT ADDRESS OF PROGRAM INPUT CODE APARS DEF PARAM ADDRESS OF PARAMETER INPUT CODE IFZ ***** BEGIN DMS CODE ***** APART DEF PARTS ADDRESS OF PARTITION DEF PHASE ****** END DMS CODE ****** XIF NRST DEF E19 ADDRESS OF RESTART ERROR CODE ADBP DEF DBPO STARTING ADDRESS OF DUMMY BASE PAGE NADBP BSS 1 THE NEG OF RTEGN START SKP * * PROGRAM CONSTANT FACTORS ZERO OCT 0 N1 DEC -1 N2 DEC -2 N3 DEC -3 N4 DEC -4 N5 DEC -5 N6 DEC -6 N7 DEC -7 N8 DEC -8 N9 DEC -9 N10 DEC -10 N11 DEC -11 N16 DEC -16 N27 DEC -27 N32 DEC -32 N64 DEC -64 N65 DEC -65 N80 DEC -80 N2048 DEC -2048 NDAY OCT 177574,025000 P2 DEC 2 P3 DEC 3 P4 DEC 4 P5 DEC 5 P6 DEC 6 P7 DEC 7 P8 DEC 8 P9 DEC 9 P11 DEC 11 P12 DEC 12 P13 DEC 13 P14 DEC 14 P15 DEC 15 P16 DEC 16 P17 DEC 17 P18 DEC 18 P19 DEC 19 P20 DEC 20 P21 DEC 21 P22 DEC 22 P23 DEC 23 P24 DEC 24 P25 DEC 25 P26 DEC 26 P28 DEC 28 P29 DEC 29 P30 DEC 30 P31 DEC 31 P32 DEC 32 P33 DEC 33 P60 DEC 60 P64 DEC 64 P99 DEC 99 P202 DEC 202 P6K DEC 6000 L6 EQU N6 L10 EQU N8 L12 EQU N10 L60 OCT -60 L2000 OCT -2000 M4 EQU P4 M7 EQU P7 M13 EQU P11 M17 EQU P15 M20 EQU P16 M37 EQU P31 M60 OCT 60 M77 OCT 77 M120 OCT 120 M177 OCT 177 M377 OCT 377 M777 OCT 777 M400 OCT 400 D128 DEC 128 M200 EQU D128 M0760 OCT 076000 M1740 OCT 174000 M1760 OCT 176000 M1600 OCT 160000 M1777 OCT 1777 M2000 OCT 2000 M2002 OCT 2002 M1377 OCT 100377 M4000 OCT 4000 M7400 OCT 177400 M7000 OCT 177000 M7600 OCT 177600 M7700 OCT 177700 M7777 OCT 77777 M0300 OCT 030000 M0400 OCT 040000 M1177 OCT 101777 SKP DPWRS DEF *+1 P0100 DEC 10000 P1000 DEC 1000 P100 DEC 100 P10 DEC 10 P1 DEC 1 OP,CWRS DEF *+1 M0100 OCT 10000 M1000 OCT 1000 M100 OCT 100 M10 OCT 10 OCT 1 * SUP BLANK OCT 040 BLANK UBLNK OCT 20000 UPPER CHAR BLANK MSIGN OCT 100000 NEGATIVE SIGN RPARB OCT 24440 RIGHT PAREN, BLANK SPC 3 * DBLNK DEF UBLNK DEF OF BLANK FOR SPACE ROUTINE TTYIN NOP ADDRESS OF THE TTY INPUT DRIVER (ACTUAL) LSTD NOP ADDRESS OF THE ACTUAL LIST DEVICE DRIVER DAOUT DEF ASOUT ADDRESS OF DUMMY LIST OUTPUT DRIVER DASIN DEF ASIN ADDRESS OF DUMMY INPUT DRIVER. SPC 2 IFN *** BEGIN NON-DMS CODE *** FWSCA EQU .-1 FIRST WORD OF SYS COMM AREA LWSBP ABS FWSCA LAST WORD OF BP LINK AREA +1 EOBP ABS -FWSCA #IREG EQU P2 NUMBER OF INDEX REGS (AMOUNT OF * SPACE ALLOWED FOR SAVING THEM) **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** FWSCA EQU .-1 EXTEND COMM AREA FOR I-REG PTR LWSBP ABS FWSCA LWA BP LINK AREA +1 #IREG EQU P2 SAVE 2 I-REGS ****** END DMS CODE ****** XIF SPC 2 * ALL STARTS AND RESTARTS COME TO HERE. * BEGIN LDA DAOUT GET THE DUMMY DRIVER ADDRESS CPA DRKEY ALREADY SET UP? JMP TRANS,I YES GO RESTART THE CODE * LDB DRKEY GET THE ACTUAL ADDRESS STB LSTD AND SET FOR DUMMY ROUTINES LDB DRTTY GET THE ACTUAL INPUT DRIVER ADDRESS STB TTYIN AND SET FOR DUMMY ROUTINES STA DRKEY SET THE DUMMY ADDRESSES LDA DASIN GET THE DUMMY INPUT ROUTINE ADDRESS STA DRTTY AND SET IT. JMP TRANS,I GO DO THE RT GENERATION!! HED RTE GENERATOR BASE PAGE ROUTINES * THE INIDX,IDXS AND IDX SUBROUTINES ARE USED TO SET THE CURRENT * ADDRESSES FOR THE ENTRY IN THE PROGRAM IDENTIFICATION * BLOCK TABLE (IDENT). THE ADDRESS OF THE NEXT ENTRY * IN THE IDENT TABLE IS CONTAINED IN TIDNT. ON RETURN FROM * IDX, TIDNT CONTAINS THE ADDRESS OF THE NEXT AVAILABLE * ENTRY IA N IDENT. THE ADDRESS OF THE FIRST ENTRY IS CONTAINED * IN BIDNT AND THE ADDRESS OF THE END OF IDENT IS CONTAINED * IN PIDNT. * * 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 ADDRESS OF THE FIRST ENTRY IN THE IDENT * TABLE AS THE CURRENT ADDRESS. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INIDX * * RETURN: CONTENTS OF A DESTROYED, B PRESERVED * INIDX NOP LDA BIDNT BIDNT = INITIAL IDENT ADDRESS STA TIDNT SET CURRENT IDENT ADDRESS 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 ADDR STB INIDX SAVE PTR TO ASCII NAME * ** OTHER SUBS MAY WANT NAME PTR IN INIDX ** LDB TIDNT B WILL KEEP ADDR IN IDENT JMP IDXS7 JUMP TO END TO ENTER LOOP SPC 1 IDXS2 ADB N8 POINT TO NEXT IDENT IDXS3 CPB PIDNT IF AT END OF IDENTS JMP IDXS4 THEN LEAVE... CPA B,I ELSE IF 1ST 2 CHARS RSS DON'T MATCH JMP IDXS2 TRY NEXT IDENT SPC 1 ISZ IDXST 1ST 2 MATCH, GET LDA IDXST,I NEXT 2 FROM INPUT INB AND FROM IDENT. CPA B,I IF NOT A MATCH RSS THEN JUMP TO UPDATE JMP IDXS5 IDENT PTR AND CONTINUE. SPC 1 ISZ IDXST 1ST 4 CHARS MATCH, LDA IDXST,I GET NEXT FROM INPUT INB i AND IDENT XOR B,I AND M7400 COMPARE UPPER BYTE ONLY SZA AND IF NO MATCH JMP IDXS6 GO GET NEXT IDENT SPC 1 * MATCH OCCURRED - BACKUP POINTER TO BEGINNING OF IDENT SPC 1 ADB N2 POINT TO START OF IDENT SPC 1 * MATCH OR NOT..... SET UP IDENT POINTERS USING 'IDX' SPC 1 IDXS4 STB TIDNT POINT TIDNT AT CURRENT IDENT JSB IDX GO SET IDENT POINTERS JMP IDXS,I NO MATCH - RETURN AT N+1 ISZ IDXS JMP IDXS,I MATCH - RETURN AT N+2 SPC 1 IDXS5 ADB P1 JUGGLE A LITTLE IDXS6 ADB N10 TO GET NEXT IDENT ADDR IDXS7 LDA INIDX RESET POINTER TO STA IDXST START OF NAME. LDA A,I PUT 1ST CHARS IN A. JMP IDXS3 GO CHECK NEXT IDENT IDXST BSS 1 TEMPORARY SPC 3 * * SET IDENT ADDRESSES FROM TIDNT * * IDX SETS THE ADDRESSES OF THE CURRENT 10-WORD ENTRY IN THE * IDENT TABLE FROM THE ADDRESS OF THE CURRENT ENTRY (TIDNT). * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB IDX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (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 LDA TIDNT TIDNT = CURRENT IDENT ADDRESS CPA PIDNT END OF IDENT LIST? RSS YES - RETURN TO NEXT INSTRUCTION ISZ IDX SET RETURN ADDRESS FOR N+2 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 CURRENT DISK ADDR INA STA ID6 SET ADDRESS OF M/S,PRIOR/DISK,TY INA STA -bID7 SET ADDRESS OF EXEC INTERV(1) INA STA ID8 SET MAIN IDENT ADDR FOR BS LDA TIDNT TIDNT = CURRENT IDENT ADDR CMA,INA ADA PLST PLST = CURRENT END LST ADDR SSA,RSS SKIP IF NO OVERLAP JMP LSERR PRINT OVERFLOW MESSAGE * LDA TIDNT GET CURRENT ADDRESS AND ADA N8 SET FOR NEXT IDENT ADDRESS STA TIDNT SET NEXT IDENT ADDRESS JMP IDX,I RETURN SKP * THE INLST, LSTS, LSTE AND LSTX SUBROUTINES ARE USED TO SET THE * CURRENT LOADER SYMBOL TABLE (LST) ADDRESSES. THE ADDR OF THE * NEXT ENTRY IN LST IS CONTAINED IN TLST. ON RETURN FROM IDX, * TLST CONTAINS THE ADDRESS OF THE NEXT AVAILABLE ENTRY IN LST, OR * THE ADDRESS OF THE END OF LST. THE ADDRESS OF THE FIRST ENTRY * IN LST IS AT BLST AND THE ADDRESS OF THE NEXT AVAILABLE ENTRY * IS AT PLST. * * IF THE NEXT ENTRY IN LST OVERFLOWS INTO THE CURRENT * IDENT ENTRY, LSTX PRINTS A DIAGNOSTIC AND EXITS * TO THE IRRECOVERABLE ERROR SUBROUTINE. * * SET INITIAL LST ADDRESS * * INLST SETS THE ADDRESS OF THE FIRST ENTRY IN LST. * INLST NOP LDA BLST BLST = FIRST LST ADDRESS STA TLST SET CURRENT LST ADDRESS JMP INLST,I RETURN SKP * LSTS SEARCHED 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 ADDRDDR STB INLST SAVE PTR TO ASCII NAME * ** SOME SUBS EXPECT LSTS TO STORE THIS ** * ** POINTER IN INLST'S ENTRY POINT ** LDB TLST B WILL KEEP ADDR IN LST Hm JMP LSTS7 ENTER LOOP AT END. SPC 1 LSTS2 ADB P5 POINT TO NEXT LST LSTS3 CPB PLST IF AT END OF LSTS JMP LSTS4 THEN LEAVE... CPA B,I ELSE IF 1ST 2 CHARS RSS DON'T MATCH JMP LSTS2 TRY NEXT LST SPC 1 ISZ LSTST 1ST 2 MATCH, GET LDA LSTST,I NEXT 2 FROM INPUT INB AND FROM LST. CPA B,I IF NOT A MATCH RSS THEN JUMP TO UPDATE JMP LSTS6 LST PTR AND CONTINUE. SPC 1 ISZ LSTST 1ST 4 CHARS MATCH, LDA LSTST,I GET NEXT FROM INPUT INB AND LST XOR B,I AND M7400 COMPARE UPPER BYTE ONLY SZA AND IF NO MATCH JMP LSTS5 GO GET NEXT LST SPC 1 * MATCH OCCURRED - BACKUP POINTER TO BEGINNING OF LST SPC 1 ADB N2 POINT TO START OF LST SPC 1 * MATCH OR NOT..... SET UP LST POINTERS USING 'LSTX' SPC 1 LSTS4 STB TLST POINT TLST AT CURRENT LST JSB LSTX GO SET LST POINTERS JMP LSTS,I NO MATCH - RETURN AT N+1 ISZ LSTS JMP LSTS,I MATCH - RETURN AT N+2 SPC 1 LSTS5 ADB N1 JUGGLE A LITTLE LSTS6 ADB P4 TO GET NEXT LST ADDR LSTS7 LDA INLST RESET PTR TO STA LSTST ASCII NAME. LDA A,I PUT 1ST 2 CHARS IN A. JMP LSTS3 GO CHECK NEXT IDENT.... LSTST BSS 1 TEMPORARY SKP * * SET LST ADDRESSES FROM TLST * * LSTX SETS THE CURRENT LST ADDRESSES FROM TLST. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LSTX * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * (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 LDA TLST GET CURRENT LST ADDRESS qj CPA PLST END OF LST TABLE? RSS ISZ LSTX INCR RETURN ADDRESS 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 ADDRESS CMA,INA ADA PIDNT PIDNT = ADDR CURRENT IDENT SSA,RSS SKIP - INVALID LST ENTRY JMP LSTX,I RETURN * * LSERR LDA ERR07 JSB IRERR IRRECOVERABLE ERROR EXIT * ERR07 ASC 1,07 IDENT/LST OVERFLOW SKP * ENTRY 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 LDA LST5 ADVANCE THE END OF THE LST INA BY STA PLST ONE ENTRY JMP LSTE,I EXIT BACK TO THE USER HED RTE GENERATOR BASE PAGE WORKING LOCATIONS AND BUFFERS * RELOCATION BASE TABLE MRTAD DEF TPREL DEF FOR MR FIELD RBTAD DEF *+1 OCT 0 ABSOLUTE PROGRAM BASE TPREL OCT 0 CURRENT PROG BASE ADDRESS TPBRE OCT 0 BP RELOCATION ADDRESS COMAD OCT 0 CURRENT COMMON RELOCATION BASE NOP ABS PROGRAM BASE FOR MR CODE * ALBUF DEF LBUF ADBUF DEF DBUF ATBUF DEF TBUF AMLST DEF MLIST AMEM5 DEF MLIST+5 AMEM8 DEF MLIST+8 AILST DEF ILIST * WDCNT OCT 0 TEMPORARY WORD COUNTER * BLST NOP ADDR OF FIRST LST ENTRY TLST BSS 1 CURRENT LST ADDR PLST NOP ADDR OF NEXT AVAILABLE ENTRY * BIDNT BSS 1 ADDR OF FIRST IDENT TIDNT BSS 1 CURRENT IDENT PIDNT OCT 36000 NEXT AVAILABLE IDENT * BFIX NOP TFIX NOP PFIX NOP * * THE LST POINTERS BELOW CANNOT BE MOVED WITHOUT CHANGING * THE DRIVER (RTGEN PART 2)....THEY ARE EQUATED THERE ALSO. * LST1 EQU 07B WORD 1 ADDR (LST) LST2 EQU 10B WORD 2 ADDR (LST) LST3 EQU 11B WORD 3 ADDR (LST) LST4 EQU 12B WORD 4 ADDR (LST) LST5 EQU 13B WORD 5 ADDR (LST) * MAXC EQU 14B MAX CHAR COUNT TCHAR EQU 15B TEMPORARY CHAR SAVE AREA OCTNO EQU 16B OCTAL DIGIT * DSKSY EQU 17B INITIAL ID SEGMENT DISK ADDRESS PIOC EQU 20B ADDR. OF PRIVILEGED I/O CARD IDSP EQU 21B POSITION OF 1ST ID SEG. IN SECT TBCHN EQU 22B TIME BASE GENERATOR CHNL SWAPF EQU 23B SWAPPING FLAG = 0/1 = NO/YES LWASM EQU 24B LAST WORD SYS AVAIL MEM PARAD EQU 25B PARAMETER INPUT DRIVER ADDRESS TTYCH EQU 26B SYSTEM TTY CHANNEL NO. * DSKAD EQU 27B CURRENT DISK ADDRESS PLFLG EQU 30B PROGRAM LOAD. FLAG = -1/0 = L/NL DSCNT EQU 31B DISK SEGMENT SECTOR COUNT * ID1 EQU 32B IDENT 1 ADDR: NAME 1,2 ID2 EQU 33B IDENT 2 ADDR: NAME 3,4 ID3 EQU 34B IDENT 3 ADDR: NAME 5, USAGE FLAG ID4 EQU 35B IDENT 4 ADDR: COMMON LENGTH ZXTTZID5 EQU 36B IDENT 5 ADDR: CURRENT DISK ADDR ID6 EQU 37B IDENT 6 ADDR: M/S,PRIORITY,TYPE ID7 EQU 40B IDENT 7 ADDR: EXEC INTERV (1) ID8 EQU 41B IDENT 8 ADDR: LIB LGTH/BS MAIN * /ID SEG ADR FOR DMS MAINS * NXFLG EQU 42B ENT/EXT FLAG = -1/0 EXCNT EQU 43B SYMBOL COUNTER * CURAL EQU 44B CURRENT LBUF ADDRESS LCNT EQU 45B CURRENT LBUF COUNT * CURAD EQU 46B CURRENT DBUF ADDRESS DCNT EQU 47B CURRENT DBUF COUNT * CURAI EQU 50B CURRENT IBUF COUNT * CPLS EQU 51B ADDRESS OF TOP OF FIXED CP LINK IMAGE CPL2 EQU 52B ADDRESS OF HIGH CURRENT PAGE LINK SPECS. CPL1 EQU 53B ADDRESS OF LOW CURRENT PAGE LINK SPECS. CPL1H EQU 54B NUMBER OF CURRENT PAGE LINKS ASSIGNED CPL2H EQU 55B IN LOW AND HIGH AREA RESPECTIVELY URBP1 EQU 56B LWA R/T DISC RES BP LINK AREA BPMAX EQU 57B MAX USED BASE PAGE LINKAGE +1 CURAK EQU 60B CURRENT KBUF ADDRESS * CURAT EQU 61B CURRENT TBUF ADDRESS TCNT EQU 62B CURRENT TBUF COUNT * CURAP EQU 63B CURRENT PLIST ADDRESS * AMAD EQU 64B CURRENT MLIST ADDRESS * LICNT EQU 65B LONG ID SEGMENT COUNT SICNT EQU 66B SHORT ID SEGMENT COUNT COMRT EQU 67B MAXIMUM RT COM LENGTH COMBG EQU 70B MAX BG COM LENGTH * DSKEY EQU 71B CURRENT KEYWORD DISK ADDRESS DSKID EQU 72B DISK ID SEGMENT ADDRESS KEYCN EQU 73B TOTAL KEYWORD COUNT KEYCT EQU 74B CURRENT KEYWORD COUNT PTYPE EQU 75B PROGRAM TYPE * ******* LOCATION 76B BEGINS RESERVED AREA (SIO'S, ETC) ****** * FIX1 NOP FIX2 NOP FIX3 NOP FIX4 NOP * LNK1 NOP LNK2 NOP LNK3 NOP * LBUF BSS 64 LOAD BUFFER * CUBPA DEF CUBP ADDR OF CURRENT B.P. SPECS TBUF BSS 4 TEMP BUFFER MLIST BSS 11 MEMORY MAP BUFFER * TEMP1 NOP TEMP2 NOP LWH1 NOP LWH2 NOP LWH3 NOP LWH4 NOP L01 NOP * 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 PPREL BSS 1 INITIAL PROG 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 ADDR HDFLG BSS 1 HEADING FORMAT FLAG CIDNT BSS 1 CURRENT MAIN IDENT ADDRESS DSKRD BSS 1 DISK INPUT ADDRESS * 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 * DSKRX BSS 1 CURRENT TRACK ADDR. FOR "DBIN" IDSAV BSS 1 POINTER TO CURRENT IDENT ABCNT BSS 1 CURRENT ABSOLUTE DISPLACEMENT 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 RANAD BSS 1 CURRENT POWER RANGE ADDRESS DSKA NOP TOP DISK ADDRESS WRITTEN ON DRT2 BSS 1 DISK DRT ENTRY ( SYSTEM) DRT3 BSS 1 AUX DISK DRT ENTRY LIBFG BSS 1 LDTYP BSS 1 SCH1 BSS 1 ADDRESS OF IDENT OF PGM TO BE SCHEDULED SCH3 BSS 1 ADDRESS OF CURRENT ID SEGMENT SCH4 BSS 1 AD['DRESS OF THE SCHEDULED PGM ID SEG FGBGC NOP BACKGROUND USING FG COMMON FLAG $LIBR NOP ADDRESS OF $LIBR ENT $LIBX NOP ADDRESS OF $LIBX ENT $RENT NOP ADDRESS OF $RENT ENT $PRIV NOP ADDRESS OF $PRIV ENT CUPRI NOP * MEM1 DEC 0 MEM2 DEC 0 MEM3 DEC 0 MEM4 DEC 0 MEM5 DEC 0 MEM6 DEC 0 MEM7 DEC 0 MEM8 DEC 0 MEM9 DEC 0 MEM10 DEC 0 MEM11 DEC 0 MEM12 DEC 0 * IFZ ***** BEGIN DMS CODE ***** COMSZ BSS 1 #WORDS COMMON DECLARED FOR * CURRENT MAIN MAPFG BSS 1 FLAG SAYS COMMON MAPPED BY SYS LPCOM BSS 1 LAST PAGE CONTAINING 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 NUMPG BSS 1 NUM PAGES OF MAIN MEM 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 DMS RES MAP MPFT. BSS 1 PTR TO MPFT ****** END DMS CODE ****** XIF ERR09 ASC 1,09 PARAMETER NAME ERROR ERR10 ASC 1,10 PARAMETER TYPE ERROR ERR11 ASC 1,11 PARAMETER PRIORITY ERROR ERR12 ASC 1,12 PARAMETER INTERVAL ERROR 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 ERR37 ASC 1,37 INVALID COMMON IN SYS. LIB, OR UT PGM ERR39 ASC 1,39 ILLEGAL SYSTEM USE OF TYPE 6 PROGRAM ERR38 ASC 1,38 SYSTEM OVERFLOW INTO SCRATCH MESSAGE "/E" ASC 1,/E COMMA OCT 54 COMMA 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 MES22 DEF *+1 ASC 3,(NONE) MES24 DEF MS24 MES28 DEF MS28 MES29 DEF MS29 * HED ** SYSTEM BASE PAGE COMMUNICATION AREA ** *** SYSTEM BASE PAGE COMMUNICATION AREA *** * * * SYSTEM TABLE DEFINITION * * XI EQU .-1 ADDR OF I-REG SAVE AREA * FOR RUNNING PROG (DMS) 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 9 PARAMETERS) RQP9 EQU .+32 * * 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 0RES. 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 RTE GENERATOR INITIALIZATION (** OVERLAYED **) ORR * * INITIAL TRANSFER IS MADE TO RTEGN BY SETTING 100(8) * IN THE SWITCH REGISTER AND PRESSING RUN. IF ANY ERRORS ARE * DETECTED DURING THE INITIALIZATION PHASE, THE INITIALIZATION * SECTION CAN BE REPEATED. * * 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 * * PRGM INPT? * LIBR INPT? ENTER PT, MT, DF, OR TY * PRAM INPT? * * FOLLOWING SUCCESSFUL COMPLETION OF THIS SECTION, * THE TRANSFER ADDRESS IS MOVED TO THE INITIALIZATION SECTION * OF THE LOADING PHASE. *  SKP RTEGN CLC 0,C TURN OFF ALL I/O,INTERRUPTS DBUF EQU RTEGN JSB SPACE GET A NEW JSB SPACE LINE LDA ADBP GET ADDRSS OF DUMMY BASE PAGE CMA,INA MAKE NEG STA NADBP SAVE LDA FWAM CLEAR THE STA PLST LST STA BLST AND SET UP STA TLST ITS POINTERS LDA CPLIM SET UP THE HIGH END LIMIT CMA,SSA,INA OF THE CP LINK IMAGE STA CPLIM AREA (IF NOT RESTARTING) LDB D$REN ENTER $RENT IN THE LST JSB LSTE LDA RSS SET IT UP AS STA LST5,I A REPLACE WITH RSS LDA P4 STA LST4,I ENT LDA LST1 SET FLAG STA $RENT FOR LOAD PHASE * LDB D$PRV DO SAME FOR $PRIV JSB LSTE LDA P4 STA LST4,I LDA RSS STA LST5,I LDA LST1 STA $PRIV SET FLAG FOR LOAD PHASE CLA SET THE INTERACTIVE INPUT FLAG STA ERROR * 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 * JSB DSETU SET UP THE DISC SPECIFICATIONS. * * 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-DMS 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-DMS CODE **** XIF IFZ ***** BEGIN DMS 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 LDB MSMP. COMMON, IF SO, SET FLAG FOR JSB YE?NO SYSTEM TO MAP COMMON JMP MAPC? ASK AGAIN IF BAD ANSWER STA MAPFG SAVE 1 IF YES, 0 IF NO ****** END DMS 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-DMS 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-DMS CODE **** XIF * IFZ ***** BEGIN DMS 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 DMS CODE ****** XIF * SET PROGRAM INPUT UNIT JSB SPACE NEW LINE PGMIN LDA P10 LDB MESS4 MESS4 = ADDR: PRGM INPT? JSB READ PRINT MESSAGE, GET REPLY JSB SINIT GET CODE, ANALYSE JMP PGMIN REPEAT UNIT ENTRY STA PGMAD SET PROGRAM INPUT DRIVER ADDR * * SET LIBRARY INPUT UNIT JSB SPACE NEW LINE LIBIN LDA P10 LDB MESS5 MESS5 = ADDR: LIBR INPT? JSB READ PRINT MESSAGE, GET REPLY JSB SINIT GET CODE, ANALYSE JMP LIBIN REPEAT ENTRY STA LIBAD SET LIB INPUT DRIVER ADDRESS * * SET PARAMETER INPUT UNIT JSB SPACE NEW LINE PARIN LDA P10 LDB MESS6 MESS6 = ADDR: PRAM INPT? JSB READ PRINT MESSAGE, GET REPLY JSB SINIT GET CODE, ANALYSE JMP PARIN REPEAT PARAMETER INPUT STA PARAD PARAD = PRAM INPUT DRIVER ADDR JSB PTBOT FINISH THE DISC SET UP. LDA AINPT SET TRANSFER STA TRANS FOR INIT CODE LDA PLST  SET BOTTOM OF PROGRAM STA SLST DEFINED LST. SPC 2 * THE FOLLOWING EQUATES SET UP THE CURRENT PAGE LINKAGE IMAGE * AREA WHICH FOLLOWS DBUF. THESE TWO AREAS OVERLAY THE * INITIAL GENERATOR CODE BUT ARE NOT USED UNTIL PRAM AND LOAD * TIME. * LRBP EQU DBUF+64+3 LEAVE 64 WORDS FOR DBUF TBLNK EQU LRBP-3 SET STARTER POINTER URBP EQU LRBP+1 IRBP EQU LRBP+2 LBBP EQU LRBP+3 UBBP EQU LRBP+4 IBBP EQU LRBP+5 CUBP EQU LRBP+6 UCUBP EQU LRBP+7 ICUBP EQU LRBP+8 HED RTE GENERATOR INITIALIZE AND LOAD (** OVERLAYED**) * * INITIALIZE LOADING * INPUT CLA STA DERCN SET DISK ERROR COUNT TO ZERO JSB SPACE NEW LINE JSB SPACE NEW LINE IMAGT JMP *+9 IF MAGTAPE NOT DEFINED SKIP JSB DRMAG,I ELSE REWIND OCT 3 MT UNIT CLA,INA AND SPACE CLB TO FILE JSB DRMAG,I NUMBER OCT 4 TWO HLT 1 ERROR HLT 1 HALTS LDA LWAM GET LAST WORD AVAIL MEMORY ADA N9 ADJUST FOR FIRST IDENT LENGTH STA BIDNT BIDNT = ADDR OF FIRST IDENT STA PIDNT PIDNT = ADDRESS OF NEXT IDENT LDA SLST SLST = ADDR OF FIRST PGM LST ENTRY STA PLST PLST = ADDRESS OF END OF LST LDA DSKSC GET DISK ADDRESS OF SCRATCH AREA STA DSKAD SET CURRENT DISK ADDRESS LDB ADBUF GET ADDRESS OF DBUF STB CURAD INITIALIZE CURRENT DBUF ADDRESS JSB BUFCL CLEAR DBUF LDA N64 STA DCNT INITIALIZE CURRENT DBUF COUNT CCA SET A = -1 STA PLFLG PLFLG = LOADING FLAG = -1 * * TEST FOR PROG, LIB, END OF LOAD * SWR = 00 - LOAD NEXT SOURCE PROG * SWR = 01 - TERMINATE LOADING * SWR = 10 - LOAD LIBRARY PROGRAM * TSTIN JSB HL-IT77 GET SWR, SET INPUT UNIT LIA 1 GET SWR SLA SKIP IF MORE RECS TO READ JMP LSTEX PROCESS END OF LOAD CONDITION TSTN4 LDB PGMAD GET PROG INPUT DRIVER ADDR ARS,SLA SKIP - LOAD PROGRAM TAPE LDB LIBAD GET LIBR INPUT DRIVER ADDR STB PINAD SET INPUT UNIT DRIVER ADDR CCA STA ETFLG SET EOT FLAG = IGNORE 10 FF * READ BINARY RECORD LDRIN LDB ALBUF ALBUF = ADDR OF LBUF JSB BUFCL CLEAR LBUF LDA DRMAG CPA PINAD CCA,RSS JMP PTDV. STA LSSYS SET LAST SEEK FLAGS STA LSAUX TO -1 IN CASE INPUT FROM SAME DISC LDA N64 LDB ALBUF JSB PINAD,I OCT 000000 JMP MTEOT JMP PAR.E JMP TESTR PTDV. LDA N64 LDB ALBUF ALBUF = ADDRESS OF LBUF JSB PINAD,I GET BINARY RECORD FROM INPT UNIT SZA TEST FOR FEED FRAMES INPUT JMP TESTR NO - PROCESS RECORD LDA ETFLG GET EOT FLAG SZA SKIP IF MAX 10 FF PERMITTED JMP LDRIN IGNORE 10 FEED FRAMES MTEOT LDA P4 LDB MESS7 MESS7 = ADDR: *EOT JSB DRKEY,I PRINT: *EOT JMP TSTIN TEST SWR, SET INPUT UNUT * * PROCESS INPUT RECORD TESTR CLA STA ETFLG SET EOT FLAG = MAX 10 FF LDA LBUF+1 GET RECORD IDENTIFIER ALF,RAR ROTATE RIC TO LOW A AND M7 ISOLATE RIC STA RIC RIC = RECORD IDENT CODE SZA SKIP IF ABSOLUTE RECORD ADA L6 ADD -6B SSA,RSS TEST FOR RIC = (1,5) JMP RCERR INVALID RECORD TYPE * * TEST CHECK SUM LDB LBUF GET RECORD LENGTH BLF,BLF ROTATE TO LOW B CMB,INB SET TO NEG ADB P3 ADD 3 FOR WORD COUNT IN CHECKSUM SSB,RSS TEST FOR SHORT (1,3) RECORD JMP RCERR  SHORT (1-3) WORD RECORD JSB CKSUM FIGURE CHECK SUM CPA LBUF+2 TEST WITH GIVEN CHECKSUM JMP LDRC PROCESS VALID RECORD * * INVALID CHECKSUM PAR.E LDA ERR02 ERCOV LDB BULST IF PROCESSING A SKIP SSB JMP LDRIN THEN JUST CONTINUE * JSB ERROR SEND ERROR MESSAGE LDA PLFLG 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 P5 PRINT 5 CHARACTERS JSB DRKEY,I OF PROGRAM NAME ON TTY HLT 04B WAIT FOR OPERATOR * LIA 1 GET THE SWITCH REGISTER LDB PLFLG GET THE LOADING FLAG SSA IF FLUSH NOT CHOSEN OR SZB IF NO CURRENT PROGRAM JMP NOFL FORGET ABOUT FLUSHING * LDA BUID ELSE BACK UP THE IDENT LST STA PIDNT LDA BULST AND THE ENT LIST STA PLST CCA SET THE FLUSHING STA BULST FLAG STA PLFLG AND THE NAM EXPECTED FLAG JSB DDOUT RESET THE BUFFER POINTERS LDA ID5,I TO THE ORGION STA DSKAD JMP LDRIN GO GET THE NEXT RECORD * NOFL LDA DRMAG IF ERROR ON CPA PINAD MASS STORAGE CLA,RSS THEN SKIP JMP LDRIN ELSE REREAD THE RECORD CCB MASS STORAGE SO JSB DRMAG,I BACKSPACE OCT 4 ONE HLT 1 RECORD HLT 1 AND JMP LDRIN REREAD RECORD * RCERR LDA ERR04 JMP ERCOV GO TEST AND PRINT MESSAGE * * CLASSIFY RECORDS BY TYPE * LDRC LDA RIC GET REC IDENT CODE LDB PLFLG PLFLG = PROGRAM LOADING FLAG CPA P1 RIC = 1? (NAM) JMP NAMR PROCESS NAM REC SZB SKIP IF NOT LOADING JMP NMERR RECORD OUT OF SEQUENCE CPA P2 RIC = 2? (pENT) JMP ENTR PROCESS ENT REC CPA P3 RIC = 3? (DBL) JMP DBLR PROCESS DBL REC CPA P4 RIC = 4? (EXT) JMP EXTR PROCESS EXT REC SKP * * PROCESS END RECORD CLA,INA SET MASK = 1 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 * CCA STA PLFLG SET PROG LOAD FLAG = LOADING STA CNFLG SET FLAG FOR LB, UT END COUNT JSB DWRIT PACK, PUT OUT TO DISK * LDA ID5,I GET NAM DISK ADDRESS LDB ALBUF INPUT NAM RECORD JSB DISKI LDA LWH1 COMPILED? SZA,RSS YES,SKIP JMP CKSM1 NO,JUST FIGURE CHECKSUM LDA LWH2 STORE LENGTH IOR MSIGN INTO IT STA LBUF+6 CKSM1 JSB CKSUM GO FIGURE THE CHECKSUM STA LBUF+2 NEW CHECKSUM LDA ID5,I OUTPUT NAM LDB ALBUF RECORD AGAIN JSB DISKO JMP LDRIN NOW GO * NMERR LDA ERR03 NOT EXPECTING CURRENT RECORD TYPE JMP ERCOV TEST FOR ACTION AND ECT. SPC 2 D$PRV DEF A$PRV "BG" ASC 1,BG IFN *** BEGIN NON-DMS CODE *** "FG" ASC 1,FG **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** N193 DEC -193 (-(64+128+1) ROM+DR BOOT+1 "FG" ASC 1,RT ****** END DMS CODE ****** XIF 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 TRN**** END NON-DMS CODE **** XIF * * * 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 SPC 2 * YE?NO ROUTINE SENDS A QUESTION TO THE TTY * AND READS AND ANALIZES THE RESPONCE * * 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 JMP YE?NO,I RETURN TO CALLER. SKP * * NAM RECORD PROCESSOR NAM12 EQU LBUF+3 NAM34 EQU LBUF+4 NAM5 EQU LBUF+5 NPROG EQU LBUF+6 NCOM EQU LBUF+8 NTYP EQU LBUF+9 NPRIO EQU LBUF+10 NINT1 EQU LBUF+11 NINT2 EQU LBUF+12 NINT3 EQU LBUF+13 NINT4 EQU LBUF+14 NINT5 EQU LBUF+15 NINT6 EQU LBUF+16 DNAM DEF NAM12 * NAMR SZB,RSS SKIP IF LOADING JMP NMERR RECORD OUT OF SEQUENCE * LDA PIDNT SAVE CURRENT IDENT AND STA BUID LST LDA PLST ADDRESS STA BULST FOR POSSIBLE MODULE PURGE LDA LBUF GET RECORD LENGTH ALF,ALF ROTATE TO LOW A T CPA P9 TEST FOR NAM REC = 9 WORDS LDA P17 GET NEW NAM REC LENGTH CODE ALF,ALF ROTATE TO HIGH A STA LBUF SET NAM REC LENGTH IN WORD 1 CLB STB DSCNT CLEAR DISK SEGMENT COUNT STB CNFLG CLEAR DISK SEGMENT COUNT FLAG STB PLFLG SET PLFLG = NOT LOADING LDB DNAM GET NAME ADDRESS JSB IDXS SEARCH FOR THE ENTRY JMP ENTNA YES - ENTER NAME * LDA ERR08 GET ERROR CODE - DUPLICATE NAMES JSB ERROR PRINT DIAGNOSTIC LDA P5 LDB ID1 GET ADDRESS OF NAME IN IDENT JSB DRKEY,I PRINT DUPLICATE PROG. NAME JMP REPNA REPLACE REST OF IDENT * ENTNA LDA NAM12 GET NAME 1,2 STA ID1,I SET NAME 1,2 IN IDENT LDA NAM34 GET NAME 3,4 STA ID2,I SET NAME 3,4 IN IDENT LDA NAM5 GET NAME 5 AND M7400 SAVE UPPER CHAR STA ID3,I SET NAME 5 IN IDENT LDA TIDNT GET ADDRESS OF NEXT IDENT STA PIDNT SAVE NEXT IDENT ADDRESS * REPNA LDA NTYP GET PROGRAM TYPE AND M177 ISOLATE TYPE JSB FILTR CHANGE IF NECESSARY *RTE 2 & 3* STA ID6,I SET TYPE IN IDENT LDB NCOM GET COMMON LENGTH STB ID4,I SAVE COMMON LENGTH * LDA DSKAD DSKAD = CURRENT DISK ADDR STA ID5,I SET CURRENT DISK ADDR IN IDENT LDB NPROG 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 CLA STA ID8,I CLEAR BS IDENT MAIN ADDRESS XLDRN JSB DWRIT PACK RECORD, OUTPUT TO DISK 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 XLDRN GO WRITE THE RECORD TO THE DISC 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 LST4 IF THIS IS A FOURCED CMA,INA SYMBOL ADA SLST THEN SSA,RSS 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 JSB ERROR PRINT ERROR MESSAGE LDA P5 LDB LST1 LST1 = ADDR OF SYMBOL JSB DRKEY,I 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 JSB IRERR IRRECOVERABLE ERROR ENTX2 LDA ID1 GET MAIN IDENT ADDRESS STA LST4,I ENTER IDENT ADDR 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 LDB ID1 GET MAIN IDENT ADDRESS CPA P5 TYPE = BS? CMB,RSS YES - SET LST4 = BS REF, SKIP CLB NO - SET LST4 = UNDEFINED STB LST4,I YES - SET ADDRESS 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 * LDA ID1 GET CURRENT IDENT ADDRESS STA IMAIN SAVE IDENT ADDRESS LDA LST4,I GET IDENT ADDRESS SZA SKIP IF UNDEFINED SSA SKIP IF IDENT ADDRESS JMP ENTX5 IGNORE UNDEFINED EXT * CPA P2 IF SPECIAL SYMBOL RSS RSS FOR GET CPA P3 THE BS RSS BIT CPA P4 JMP ENTX5 * STA TIDNT SET IDENT ADDRESS FOR IDX JSB IDX SET IDENT ADDRESSES HLT 0 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 IMAI N GET CURRENT IDENT ADDRESS STA TIDNT SET FOR NEXT IDENT ADDRESSES JSB IDX SET CURRENT IDENT ADDRESSES HLT 0 ADDRESS 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 ADDRESS STA ID8,I SET MAIN IDENT ADDR 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 TO A 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 XLDRN PACK RECORD, OUTPUT TO DISK SKP * * WRITE RELOC REC ON DISK * * DWRIT PACKS THE CURRENT CONTENTS OF LBUF INTO DBUF AND DUMPS * DBUF WHEN IT CONTAINS 64 WORDS OF RELOCATABLE INPUT. * IF THE END RECORD IS BEING PROCESSED, DWRIT TESTS FOR * PROCESSING LIBRARY PROGRAMS AND SETS THE NO. OF PACKED * RELOCATABLE LIBRARY RECORDS IN WORD 10 OF IDENT FOR * USE IN MOVING THE RELOCATABLE LIBRARY TO THE PROTECTED * AREA OF THE DISK AFTER THE LOADING PHASE IS COMPLETE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DWRIT * * RETURN: CONTENTS OF A AND B DESTROYED * DWRIT NOP LDB ALBUF GET ADDRESS OF LBUF STB CURAL SAVE CURRENT LBUF ADDRESS LDA LBUF GET RECORD LENGTH ;, ALF,ALF ROTATE TO LOW A CMA,INA STA LCNT SAVE RECORD LENGTH COUNT LTOD LDA CURAL,I GET WORD FROM LBUF STA CURAD,I SET WORD INTO DBUF ISZ DCNT SKIP IF DBUF FULL JMP GETL TEST FOR END OF LBUF * JSB DDOUT OUTPUT DBUF TO DISK RSS OMIT CURRENT DBUF ADDR INCREMENT GETL ISZ CURAD INCR CURRENT DBUF ADDRESS ISZ CURAL INCR CURRENT LBUF ADDRESS ISZ LCNT SKIP IF LBUF MOVED TO DBUF JMP LTOD MOVE NEXT WORD TO DBUF LDA CNFLG GET END FLAG SZA,RSS SKIP IF END RECORD READ JMP DWRIT,I RETURN * LDA DCNT CPA N64 BUFFER EMPTY? RSS JSB DDOUT OUTPUT TO DISK * LDA ID6,I GET TYPE AND M7 ISOLATE TYPE CPA P5 TYPE = BG SEGMENT? JMP DWRIT,I RETURN LDA DSCNT GET TOTAL LIBR DISK SECTR COUNT STA ID8,I SET TOTAL SECTOR COUNT IN IDENT JMP DWRIT,I RETURN SKP * * OUTPUT DBUF TO DISK * * THE DDOUT SUBROUTINE WRITES THE CONTENTS OF DBUF IN THE * CURRENT DISK SECTOR. FOLLOWING THIS DBUF IS CLEARED, * THE CURRENT ADDRESS AND COUNT FOR DBUF ARE SET, * AND THE NEXT DISK ADDRESS IS SET INTO DSKAD. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DDOUT * * RETURN: CONTENTS OF A AND B ARE DESTROYED * DDOUT NOP LDA DSKAD GET CURRENT DISK ADDRESS LDB ADBUF GET BUFFER ADDRESS JSB DISKO OUTPUT RECORD TO DISK LDB ADBUF GET ADDRESS OF DBUF STB CURAD INITIALIZE DBUF CURRENT ADDRESS JSB BUFCL CLEAR DBUF LDA N64 STA DCNT INITIALIZE CURRENT DBUF COUNT ISZ DSCNT COUNT RECORD LDA DSKAD GET CURRENT DISK ADDRESS JSB DISKA INCR CURRENT DISK ADDRESS STA DSKAD SET NEW DISK ADDRESS JMP DDOUT,I RETURN SKP * * ߱ ALPHABETIC INPUT CONTROL * * THE SINIT SUBROUTINE ANALYZES THE RESPONSE FOR THE PROGRAM, * LIBRARY, AND PARAMETER INPUT. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB SINIT * * RETURN: * (N+1): AN INVALID SET OF CHARACTERS (NOT PT, MT, TY) * OR NO. OF CHARACTERS HAS BEEN DETECTED. * AFTER PRINTING THE DIAGNOSTIC, A RETURN IS MADE TO * PERMIT THE MESSAGE TO BE REPEATED. THE CONTENTS * OF A AND B ARE DESTROYED. * (N+2): A = ADDRESS OF DESIGNATED INPUT DRIVER * B = DESTROYED * SINIT NOP LDA N2 SET MAX NO. DIGITS FOR GETNA JSB GETNA MOVE LBUF TO TBUF JSB GETAL GET NEXT CHAR FROM LBUF CPA ZERO CHAR = ZERO? (END OF BUFFER) JMP *+3 YES - CONTINUE CODIN JSB INERR INVALID TTY RESPONSE JMP SINIT,I RETURN - ERROR LDA TBUF GET 2-CHARACTER CODE CPA "TY" TYPE = TTY? JMP TYUN YES - UNIT IS TELETYPE CPA "PT" TYPE = PT READER? JMP PTUN SET UNIT = PT READER CPA "MT" TYPE = MAG TAPE? JMP MTUN SET UNIT = MAG TAPE CPA "DF" TYPE = DISC FILE? JMP MTUN -PROCESS AS MAG TAPE. JMP CODIN INVALID PT, MT OR TY TYUN LDA DRTTY DRTTY = TTY INPUT DRIVER ADDRESS RSS PTUN LDA DRPTR DRPTR = PT READER DRIVER ADDR JMP PT.DV MTUN CLA MT OR DF CPA DRMAG DRIVER LOADED? JMP CODIN NO - ERROR STA IMAGT YES - CLEAR FLAG TO PERMIT REWIND LDA DRMAG DRMAG = MAG TAPE DRIVER ADDR PT.DV ISZ SINIT INCR RETURN ADDRESS JMP SINIT,I RETURN HED RTE GENERATOR LIST UNDEFINED EXTERNALS (** OVERLAYED **) * * LIST UNDEFINED EXTS * * THE UNDEFINED EXTERNAL REFERENCES CAN BE LISTED AFTER * EACH END-OF-TAPE CONDITION IS DETECTED. * * FOLLOWING COMPLETION OF THE EXT LISTING, THE COMPUTER * HALTS TO PERMcIT THE OPERATOR TO RETURN FOR ADDITIONAL * PROGRAM INPUT, OR CONTINUE WITH THE PROCESSING OF PARAMETERS. * LSTEX JSB SPACE NEW LINE JSB SPACE NEW LINE CCA STA NXCNT SET SYMBOL COUNT = -1 LDA SLST SET BOTTOM OF PGM LST STA TLST FOR SCAN OUTNX JSB LSTX SET LST1 - LST5 JMP EXOUT END OF LIST LDA LST4,I GET WORD 4 OF LST CMA,SSA,INA,SZA SKIP IF UNDEFINED OR BS REF JMP OUTNX TRY NEXT LST SYMBOL ISZ NXCNT TEST FOR FIRST UNDEF EXT JMP OUTEX NO - PUT OUT SYMBOL NAME LDA P10 LDB MESS8 MESS8 = ADDR: UNDEF EXTS JSB DRKEY,I PRINT: UNDEF EXTS JSB SPACE NEW LINE OUTEX LDA P5 LDB LST1 LST1 = A(SYMBOL) JSB DRKEY,I PRINT SYMBOL JMP OUTNX TRY NEXT SYMBOL * EXOUT ISZ NXCNT TEST FOR NO UNDEF EXTS JMP ENDEX NO - OMIT MESSAGE LDA P14 LDB MESS9 MESS9 = ADDR: NO UNDEF EXTS JSB DRKEY,I PRINT MESSAGE ENDEX JSB SPACE NEW LINE JSB HLT77 WAIT FOR OPERATOR INTERVENTION LIA 1 GET SWITCH REGISTER SLA,RSS SKIP IF SWITCH 0 UP JMP TSTN4 TEST FOR PROGRAM OR LIBR LOAD * CLA SET TOP DISK ADDRESS TO STA DSKA ZERO STA ERROR CLEAR THE ERROR FLAG FOR PRAM INPUT STA SCH1 STA SCH4 CLEAR SCHED ID SEG FLAG LDA IMAGT IF MT OR DF USED SZA FOR INPUT SKIP TO REWIND JMP IPARS NO, INITIATE PARAMETER INPUT. JSB DRMAG,I REWIND/STANDBY OCT 5 MT OR DF. JMP IPARS INITIATE PARAMETER INPUT SECTION HED RTE GENERATOR LOCAL STORAGE (** OVERLAYED **) * ERR02 ASC 1,02 CHECKSUM ERROR ERR03 ASC 1,03 RECORD OUT OF SEQUENCE ERR04 ASC 1,04 INVALID RECORD ERR05 ASC 1,05 DUPLICATE ENTRY POINTS ERR08 ASC 1,08 DUPLICATE PROGRAM NAMES ERR13 ASC 1,13 BG SEGMENT PRECEDES BG MAIN * F "TY" ASC 1,TY "PT" ASC 1,PT "MT" ASC 1,MT "DF" ASC 1,DF * D$REN DEF *+1 ASC 3,.ZRNT A$PRV ASC 3,.ZPRV MESS3 DEF *+1 IFN ASC 5,LWA MEM? XIF IFZ ASC 5,MEM SIZE? XIF MESS4 DEF *+1 ASC 5,PRGM INPT? MESS5 DEF *+1 ASC 5,LIBR INPT? MESS6 DEF *+1 ASC 5,PRAM INPT? MESS7 DEF *+1 ASC 2,*EOT MESS8 DEF *+4 MESS9 DEF *+1 ASC 7, NO UNDEF EXTS MES30 DEF *+1 ASC 5,TBG CHNL? 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? IFZ ***** BEGIN DMS CODE ***** MSMP. DEF *+1 ASC 14,PRIV. DRIVERS ACCESS COMMON? MLMP EQU P28 ****** END DMS CODE ****** XIF SLST NOP BUID NOP BULST NOP SPC 1 PGMAD BSS 1 PROGRAM INPUT DRIVER ADDRESS LIBAD BSS 1 LIB INPUT DRIVER ADDR PINAD BSS 1 INPUT DRIVER ADDRESS ETFLG BSS 1 END TAPE FLAG = -1/0 = IGN/MAX CNFLG BSS 1 LB, UT END FLAG RIC BSS 1 RECORD IDENTIFICATION CODE SYM12 BSS 1 CHAR 1,2 ADDR NXCNT BSS 1 UNDEFINED SYMBOL COUNT * CPLIM DEF *-6 END OF CP LINK IMAGE AREA HED RTE GENERATOR PARAMETER PHASE * * * CHECKSUM ROUTINE * BUILD A CHECKSUM FOR THE RECORD IN LBUF * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB CKSUM * * * RETURN: * A = CHECKSUM OF RECORD * B = DESTROYED * CKSUM NOP LDB LBUF GET RECORD LENGTH BLF,BLF ROTATE TO LOW B CMB,INB SET TO NEG ADB P3 ADJUST COUNT TO SHOW SKIPPED WORDS STB WDCNT SET RECORD WORD COUNT LDA LBUF+1 GET WORD 2,INITIALIZE CHECKSUM LDB ALBUF ALBUF = A(LBUF) ADB P3 SET TO WORD 4 ADA B,I ADD WORD TO CHECKSUM INB INCREMENT ADDRESS IS$Z WDCNT SKIP IF END OF RECORD JMP *-3 CONTINUE JMP CKSUM,I RETURN SPC 1 * 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 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 SKP * * 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 ERROR PRINT ERROR MESSAGE JMP INERR,I RETURN SPC 1 ERR01 ASC 1,01 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 = 2 DECIMAL DIGITS (0-99) * 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 DSKA SAVE UPPER DISC ADDRESS STA TODIS SO WE CAN MODIFY PROGS ON THE DISC LDA P10 LDB MES24 MES24 = ADDR: PARAMETERS JSB DRKEY,I PRINT: PARAMETERS JSB SPACE NEW LINE LDB PARAD GET PARAM INPUT DRIVER ADDRESS CPB DRTTY INPUT UNIT = TTY? RSS YES - CONTINUE JSB HLT77 WAIT FOR INSERTION OF PARAMETERS * * PARST LDA P64 LDB ALBUF GET ADDRESS OF LBUF JSB PARAD,I GET ASCII PARAMETER RECORD SZA,RSS SKIP IF CHARS INPUT JMP PARST REPEAT PARAMETER INPUT * STA PARNO SAVE PARAMETER RECORD LENGTH INA ZAP WORD CLE,ERA FOLLOWING ADA ALBUF THE INPUT STRING CLB AS A STB A,I SCANNER STOP JSB GINIT INITIALIZE BUFFER SCAN LDA N5 JSB GETNA MOVE CHARS FROM LBUF TO TBUF CPA "/E" CHARS = /E? JMP SETLB YES - SET LIBRARY TYPE IN IDENT * CPA DBLK BLANK LINE OR COMMENT? JMP PARST YES TRY ANOTHER * JSB GETAL GET NEXT CHAR FROM LBUF CPA BLANK 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 BLANK 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 LDA ID1 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 MSIGN WITH TYPE. IOR B LDB ID1 B POINTS TO IDENT. 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 J* 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 BLANK CHAR = BLANK?(DELIMITER = COMMA) JMP SETNR SET PRIORITY * PAPER LDA ERR11 PARAMETER PRIORITY ERROR JMP PARER * SETNR LDA ID5,I GET THE NAM RECORD TO LDB ADBUF TO DBUF JSB DISKI FROM THE DISC 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 DBUF+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 DBUF+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 DBUF+12 SET IN THE NAM RECORD * * GET HOURS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA DBUF+13 SET IN THE NAM RECORD * * GET MINUTES * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA DBUF+14 SET IN THE NAM RECORD * *  GET SECONDS * LDA N2 SET FOR 2 DECIMAL DIGITS JSB EXINT GET DIGITS FROM LBUF STA DBUF+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 DBUF+16 SET IN THE NAM RECORD PARWR LDB ALBUF MOVE THE RECORD TO LDA ADBUF LBUF FOR CHECKSUM JSB MOVW DEC -64 JSB CKSUM DO A CHECKSUM STA LBUF+2 SET IN THE RECORD LDA ID5,I GET THE DISC ADDRESS LDB ALBUF AND WRITE THE NAM RECORD JSB DISKO BACK OUT TO THE DISC JMP PARST GET NEXT PARAMETER RECORD * * 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 ERR12 PARAMETER INTERVAL ERROR PARER JSB PNERR SEND ERROR MESSAGE JMP PARST TRY AGAIN * PNERR NOP SUBROUTINE TO TEST FOR ECHO AND PRINT ERROR STA TEMPE SAVE ERROR CODE JSB ERPNT TEST FOR PRINTING LBUF LDA TEMPE GET ERROR CODE JSB ERROR PRINT ERROR MESSAGE JSB SPACE NEW LINE JMP PNERR,I RETURN * * PRINT LBUF UNLESS FROM TTY ERPNT NOP PRINT CONTENTS OF LBUF LDB PARAD GET ADDRESS OF PARAMETER UNIT CPB DRTTY DEVICE = TTY? JMP ERPNT,I YES - OMIT PRINTCTRNING ON TTY LDA PARNO PARNO = PARAMETER RECORD LENGTH LDB ALBUF ALBUF = BUFFER ADDRESS JSB DRKEY,I PRINT PARAMETER RECORD JMP ERPNT,I RETURN * SETLB JSB ERPNT TEST FOR PRINTING /E JSB SPACE NEW LINE * * CHANGE ENTS SECTION * LDA P12 GET MESSAGE LENGTH LDB MES21 SEND MESSAGE JSB DRKEY,I 'CHANGE ENTS?' JSB SPACE SKIP A LINE * PENT LDA P64 READ THE LDB ALBUF ENT RECORD JSB PARAD,I FROM THE PRAMETER INPUT DEVICE SZA,RSS IF ZERO JMP PENT TRY AGAIN * STA PARNO SAVE COUNT INA COMPUTE THE CLE,ERA LAST WORD ADDRESS ADA ALBUF AND CLB STB A,I CLEAR THE NEXT WORD JSB GINIT GET THE ENT NAME LDA N5 TO JSB GETNA TBUF CPA "/E" IF '/E' JMP EXENT DONE GO TO NEXT SECTION * CPA DBLK IF '*' OR BLANK LINE JMP PENT TRY THE NEXT LINE * JSB GETAL GET THE NEXT CHAR CPA BLANK IF COMMA JMP ENTOK OK * 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 0TT JSB GETAL CHECK FOR COMMA CPA BLANK AS NEXT CHARACTER RSS IF NOT JMP EATER BITCH * LDA CURAL SAVE CURRENT STA ID1 POSITION LDA BUFUL FOR BACKING STA ID2 UP LDA P7 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 ERPNT PRINT /E IF REQUIRED JSB SPACE SEND A SPACE LDA TODIS RESTORE THE TOP OF DISC STA DSKA FLAG 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 JSB INIDX INITIALIZE IDX SETIX JSB IDX m_ 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 P2 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 OK, GO SEE IF ID SEG NEEDED * LDA ERR37 SET CODE = INVALID COMMON JSB ERROR PRINT DIAGNOSTIC LDA P5 LDB ID1 GET IDENT ADDRESS JSB DRKEY,I 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 TYPE * 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 CPA P1 TYPE = RT RESIDENT? IFN *** BEGIN NON-DMS CODE *** RSS CPA P4 OR TYPE = BG RESIDENT? **** END NON-DMS CODE **** XIF ISZ SICNT YES, COUNT SHORT ID SEGMENT CPA P2 IF FORGROUND DISC RESIDENT RSS OR CPA P3 BACKGROUND DISC RESIDENT ISZ LICNT COUNT A LONG ID SEGMENT 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 N2 GET 2 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. STA LICNT JSB SPACE SEND TRM4 LDA P31 MESSAGE LDB MES43 '# OF BLANK SEGMENT ID'S?' JSB READ AND GET ANSWER LDA N2 CONVERT JSB GETOC THE ANSWER JMP TRM4 ERROR TRY AGAIN SPC 1 ADA SSCNT ADD TO THE SHORT ID SEG COUNT STA SSCNT AND RESTORE ADA LICNT SUM THE TOTAL COUNT ADA SICNT INA ADD ONE FOR STOP WORD STA KEYCN IFZ ***** 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 N2 CHECK FOR 2 DECIMAL JSB GETOC DIGITS IN RESPONSE JMP GNP TRY AGAIN ON ERROR SPC 1 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 FWENT GO LOAD THE SYSTEM * TRM2 LDA TRM3 PRINT JSB ERROR "ERR 01" JMP TRMCN+1 * DBLK ASC 1, TRM3 ASC 1,01 SSCNT NOP "RP" ASC 1,RP TODIS NOP MES21 DEF *+1 ASC 6,CHANGE ENTS? MESSAGE SPC 1 MES41 DEF *+1 ASC 11,PRIV. INT. CARD ADDR? SPC 1 MES42 DEF *+1 ASC 12,# OF BLANK ID SEGMENTS? SPC 1 MES43 DEF *+1 ASC 16,# OF BLANK BG SEG. ID SEGMENTS? **** BEGIN DMS CODE **** IFZ MS30. DEF *+1 MS30 ASC 13,MAX NUMBER OF PARTITIONS? MS30L EQU P25 XIF ***** END DMS CODE ***** SKP * * CLEAR UNDEFINED EXTS * IPARS 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 ADDRESS 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 ADDRESS JMP CLST3 TRY NEXT LST ENTRY SPC 2 * THIS ROUTINE IS CALLED AFTER THE SYSTEM IS LOADED BUT BEFORE THE * LIBRARY. SPC 1 * 7 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 ERROR ERROR 39 LDA P5 NOW SEND THE NAME LDB ID1 OF THE CALLED PGM JSB DRKEY,I SPC 1 JSB INLST INITIALIZE LSTX SETUX JSB LSTX SET CURRENT LST ADDRESSES JMP SETLX END - CONTINUE ID SCAN LDA LST4,I GET IDENT ADDRESS CPA ID1 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 DEMTL NOP DEMOTE UNCALLED TYPE 6 TO TYPE 7 LDA BIDNT 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 * ENDLB LDB D$LIR FIND THE LIBRARY JSB LSTS ENTRY POINTS $LIBR CLA,RSS USE ZERO IF NOT FOUND LDA LST1 STA $LIBR SAVE FOR THE LOADER * LDB D$LIX DO SAME THING FOR $LIBX JSB LSTS CLA,RSS LDA LST1 STA $LIBX * LDA APARS GET ADDR OF PARAMETER INPUT CODE STA TRANS RESET INITIAL TRANSFER ADDRESS JMP PARAM GET PARAMETERS * D$LIR DEF *+1 ASC 3,$LIBR D$LIX DEF *+1 ASC 3,$LIBX HED RTE GENERATOR GENERATE I/O TABLES * * 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> * * 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 TOu 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) * * * ROUTINE TO INPUT TO BUFFER FROM TTY * * READ NOP JSB DRKEY,I SEND QUESTION JSB READ2 GO READ ANSWER JMP READ,I THEN RETURN TO CALLER READ2 NOP READ3 LDA P64 LDB ALBUF GET ADDRESS OF LBUF JSB DRTTY,I ENTRY FROM TTY SZA,RSS SKIP - DATA INPUT JMP READ3 REPEAT INPUT INA BUMP TO NEXT CHAR CLE,ERA CLEAR LAST ENTRY ADA ALBUF IN INPUT BUFFER CLB PLUS ONE STB A,I FOR BUFFER TERMINATE JSB GINIT INITIALIZE LBUF SCAN CLA,INA IF FIRST CHARACTER JSB GETNA IS A CPA BLANK BLANK (OR A "*") JMP READ3 THEN SKIP THE RECORD * JSB GINIT RESET THE SCANNER JMP READ2,I RETURN * * * GENIO NOP CLA SET FLAG STA LST1 TO DETERMIN IF A TABLE GENERATED STA SPLCO CLEAR THE SPOOL EQT COUNT. STA ERROR CLEAR THE ERROR FLAG JSB DSTBL GO GENERATE A DISC MAP TABLE LDA LST1 IF A SZA TABLE GENERATED JSB DAFIX FIX UP THE REFERENCES * * GENERATE THE CLASS I/O TABLE * JSB RED2 SEND MESSAGE AND GET ANSWER DEC 18 18 CHARACTERS DEF MES04 '*# OF I/O CLASSES?' D$CLS 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?' D$LUS 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?' D$RNT 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 IMPOSSIBLE NUMBERS LDA P23 LDB MES25 MES25 = ADDR: * EQT TABLE ENTRY JSB DRKEY,I 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 C"HNL IN EQT JSB ERROR 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 ERROR 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 ERROR 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 * LDA 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 * 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 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 STCXCsX I.XX ADDRESS 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 2 * 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 * * 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 Q STA OCTNO AND RESET ISZ RED2 STEP ISZ RED2 TO THE SYMBOL ADDRESS LDB RED2,I FIND JSB LSTS THE SYMBOL IN THE LST HLT 0 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 HLT 0 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 RTRNEFERENCE 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,I 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 tT 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 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 ERROR PRINT DIAGNOSTIC JMP DEVRE REPEAT INPUT * TEMPL NOP TEMPH NOP TEMPS 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 JSB LABDO OUT. * * 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,I 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 ADDRES{>S 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 DBLNK SEND ONE BLANK FOR SPACEING 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 ERROR 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"G` 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 ERROR 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 TCHAR 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 ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INT REC INPUT * TSTIQ LDB TCHAR 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 ID1 GET CURRENT IDENT ADDRESS CMA,INA SET NEGATIVE JMP COMIN SET INTERRUPT TABLE, LOCATION * PRERR LDA ERR32 SET CODE = INVALID PROGRAM NAME JSB ERROR 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 ADDR SZA,RSS SKIP - ENT IS DEFINED JMP ENERR INVALID ENTRY POINT STA TIDNT SET IDENT ADDRESS OF PROGRAM JSB IDX SET IDENT ADDRESSES HLT 0B 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 ERROR 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 ERROR 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 ERROR 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 ERROR PRINT DIAGNOSTIC JSB SPACE NEW LINE JMP FWENT GET FWA BP LINKAGE * ABERR LDA ERR34 SET CODE = INVALID ABS DIGIT JSB ERROR PRINT DIAGNOSTIC JMP SETIN REPEAT INTgD REC INPUT * NOBPO LDA TBUF GET INT TABLE CODE STA CURIL,I SET WORD IN INT IMAGE ISZ CURIL STEP IMAGE ADDRESS FOR 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 GENIO,I RETURN - CONTINUE LOADING HED RTE GENERATOR PAGE PARAMETERS AND CONSTANTS TEMPE BSS 1 PARAMETER ERROR CODE PARNO BSS 1 PARAMETER RECORD LENGTH * 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 * DRANG BSS 1 DIGIT RANGE DIFLG BSS 1 DATA-IN FLAG = -1/0 = NOT IN/IN CMFLG BSS 1 COMMA FLAG = -1/0 = NOT IN/IN BUFUL BSS 1 BUFFER U/L FLAG MS24 ASC 5,PARAMETERS MS28 ASC 6, = EQT #? MS29 ASC 9,* INTERRUPT TABLE ENT DEF *+1 X. ASC 1,I. .YY NOP ASC 1, D$STR DEF *+1 ASC 3,$STRT STAR OCT 52 SPC 1 MES25 DEF *+1 ASC 12,* EQUIPMENT TABLE ENTRY SPC 1 MES26 DEF *+1 ASC 12,* DEVICE REFERENCE TABLE HED RTE GENERATOR I/O TABLE GENERATION SUBROUTINES * * GET CHAR FROM LBUF, RETURN IN A * * THE FOLLOWING SUBROUTINE SUPPLIES THE CHARACTERS FOR * GETNA AND GETOC. * * CALLING SEQUENCE: * A = IGNORED * B = IGNOREDj * 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 TREAT AS END OF LINE 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 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 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 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 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. * * 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 L10 GET OCTAL RANGE SSA SKIP IF OCTAL REQUEST LDB L12 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? (C֥OMMA 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 L12 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 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 RETURN HED RTE GENERATOR LOAD ABSOLUTE SYSTEM * * LOAD ABSOLUTE SYSTEM * * THIS SECTION OF CODE 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) BIG 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 IS 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 * V 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 * * * =6 * * * ************************************************************ * 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 CPA ZERO END OF BUFFER? JMP SETFB YES - SET FWA BP LINKAGE LNKER LDA ERR23 GET ERROR CODE FOR INVALID REPLY JSB ERROR 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 &ZXTUSAGE FLAGS CLA LDB LST4,I GET TYPE Z 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 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 *** LDA PLST INITILIZE THE STA BFIX THE FIX UP LIST STA PFIX FOR FIX AND FIXX CLA 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 ADDIaRESSES 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 RESIDENT 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 * LDA PLST INIT FIXUP LIST STA BFIX FOR FIX STA PFIX AND FIXX SPC 1 CLA 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 * 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 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 EMvPTY 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 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 LOAD INITIATE AND LOAD 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 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 SET ADR OF 1ST ID LDA SICNT SEGMENT, THEN BUMP PAST PREFIX IF SZA MEM RESIDENT (SHORT ID), ADB #IREG THEN GET ITS DISC ADDR CLA BY WRITING WORD TO DISC. JSB LABDO * * SET UP ID SEGMENT AREA * LDA B BACK UP TO ID-SEG START (AFTER ADA N1 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 BANSE LEN OF ID SEG ADA #IREG PLUS OFFSET FOR IREG STORAGE 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 SIDSA 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 JSB CLID3 CLEAR LOAD FLAGS FOR AND TYPE 7'S 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 LOAD INITIATE AND LOAD 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 BIDNT RESET IDX STA CIDNT TO START OF LIST 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 ID1 SET FOR CALL LDA COMRT GET CURRENT COMMON SIZE JSB CHBND CHANGE COMMON SIZE? DEF MES53 MESSAGE ADDRESS DEF ID1 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 RELOC 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,I 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 LDA BFIX 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 LDA P1 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 BIDNT 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 TYPE 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 IOR P1 SET LOADED BIT STA ID3,I AND RESTORE JSB LOAD LOAD THE MODULE JSB INCAD UPDATE RELOC BASES JMP SSGA2 THEN GO FIND NEXT MODULE SPC 1 MS31. DEF *+1 MS31 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 ID1 SAVE AS A LIMIT SPC 1 LDA COMRT ASK IF HE WANTS TO CMA JSB CHBND CHANGE DEF MES53 SIZE (DECIMAL) DEF ID1 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,I 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 ID1 COMMON SIZE SPC 1 LDA COMBG DISPLAY REQUIRED CMA JSB CHBND SIZE OF COMMON DEF MES57 AND ASK (IN DECIMAL) DEF ID1 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,I JSB SPACE SPC 1 * NOW ASK ABOUT ALIGNING LWA OF BG COMMON SPC 1 LDA BGBND ADA COMBG ADA N1 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 ADDRESS IN MEM RES STB FWMRP PROGRAM AREA. LSR 10 THEN SHIFT TO GET LAST PAGE AND M37 CONTAINING COMMON AND SAVE STA LPCOM 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 CO@MEX 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 LDA BFIX 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 LOAD INITIATE AND LOAD MAIN PROGRAM CLA JSB GENID GENERATE ID SEGMENT, KEYWORD IFZ ***** BEGIN DMS CODE ***** CLA NO PARTITION REQMT LDB ID1 POINT TO IDENT 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 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 HLT 0B 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 LOLNВK 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 P64 ADD BOOT SIZE ADA D128 INCLUDE DR BOOT TOO! 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 LDA BFIX 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. LDA ID1 SAVE IDENT PNTR STA IDSAV JSB SETRB SET RELOC BASE ****** END DMS CODE ****** XIF JSB USERS SET UP TO OUTPUT USER CODE JSB LOAD INITIATE AND LOAD MAIN PROGRAM LDA CPLS BACK UP THE CP LINK STA CPL2 BOTTOM JSB SYS RESET TO OUTPUT SYSTEM CODE CCA JSB GENID GENERATE ID SEGMENT, KEYWORD IFN *** BEGIN NON-DMS CODE *** HTRNLDA 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 ***** * PRINT PAGE REQUIREMENTS FOR RTE-III PROGRAMS * 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 POINT TO IDENT TOO 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 = 1647 STA SYBAD SET NEW BP ADDRESS T STA BPMAX AND NEW UPPER LIMIT ADA N1 SET THE LAST LINK ADDRESS STA URBP1 FOR FORGROUND * LDB FGBGC CHECK IF WE ALREADY LDA BGBND HAVE THE BACKGROUND BOUNDRY SZB,RSS LDA LWASM NO THE SKY IS THE LIMIT STA ID1 SET UPPER LIMIT OF SYS MEMORY * 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 ID1 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 ID1 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 ID1 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,I PRINT BACKGROUND COMMON LISTING JSB SPACE NEW LINE 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 LOAD INITIATE AND LOAD 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 WH#AT 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 PACK 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 LDA BFIX 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 LDA ID1 GET CURRENT MAIN IDENT ADDRESS STA IDSAV SAVE MAIN IDENT ADDR 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 LOAD INITIATE AND LOAD 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 LDA ID1 GET CURRENT MAIN IDENT ADDRESS STA IMAIN SAVE MAIN BS IDENT ADDRESS 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 ADDRESS CPA IDSAV BS CALLS THIS BG MAIN? RSS YES - CONTINUE JMP BSLD NO - IGNORE BACKGROUND SEGMENT LDA TIDNT GET NEXT IDENT ADDRESS STA ABSID SAVE ADDR 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 STA ABCOR,I BASE CORE ADDRESSES FOR STA MXABC,I A SEGMENT LOAD JSB LOADS LOAD BG SEGMENT LDA CPLS RESET THE CP LINK STA CPL2 BOTTOM JSB SYS RESET TOF@ 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 SSA 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 ADDR STA TIDNT SET IDENT ADDRESS FOR IDX JMP BSLD LOAD NEXT BG SEGMENT * BSEND EQU * IFZ ***** BEGIN DMS CODE ***** * PRINT PAGE REQMT, 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 ADDR 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 CL\EAR PROGS-LOADED FLAGS LDA IDSAV GET MAIN IDENT ADDRESS STA TIDNT SET CURRENT IDENT ADDRESS 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 IFN *** BEGIN NON-DMS CODE *** SKP **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** HED RTE-III GENERATOR - DEFINE PARTITIONS SPC 1 ******************************************************************** * RTE-III - FINISH UP AFTER LOADING ALL PROGRAMS * ******************************************************************** SPC 1 * HALT TO GIVE OPERATOR A CHANCE TO CHANGE INPUT DEVICE (SWR) SPC 1 JSB HLT77 SPC 1 * SET SO RESTARTS COME HERE SPC 1 LDA APART STUFF ADDR OF PARTS STA TRANS IN RESTART VECTOR SPC 1 PARTS EQU * CLA CLEAR THE ERROR FLAG STA ERROR SPC 1 * * 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,I MESSAGE. SPC 1 CLA SET FLAG FOR NO PROGRAMS STA PQFLG OF TYPE FOUND. LDA BIDNT 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) 4 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,I 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,I 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 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,I PRINT MESSAGE JMP PQADD,I SPC 1 PQEND EQU * * * LIST LARGEST ADDRESSABLE PART SIZES * SPC 1 LDA MSQ3L LDB MSQ3. PRINT HEADER JSB DRKEY,I 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 SIqZE 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,I 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,I SEND INSTRUCTIONS SPC 1 * READ PARTITION DEFINITION AND PARSE SPC 1 DPRD JSB READ2 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 CM8A,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 COPRE 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 DPLP1 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 ERROR 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 IT 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,RSLS 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 ENTRY 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 * 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 TRNLDA ERR47 DPERR JSB ERROR 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 1 * 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,I 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 SPC 1 * 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 SPC 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 \T* 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 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 DPPRV 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,I 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 DESTRUCTIVELY 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,I 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 JSB READ2 GET RESPONSED. 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 LDB ID1 POINT TO IDENT 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 LjINK 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 ERROR JMP APRD2 MESSAGE APER2 LDA ERR49 JMP APERR APER3 LDA ERR50 APERR JSB ERROR JMP APLOP ERR48 ASC 1,48 ERR49 ASC 1,49 ERR50 ASC 1,50 MPER1 LDA ERR51 JSB ERROR 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). * 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 PAGUE 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 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 HLT 0B HALT 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 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 AND STORE IN MEM2. ****** END DMS CODE ****** XIF HED RTE GENERATOR COMPLETE ABSOLUTE LOAD * BEGIN CLEAN-UP....DO NOT ALLOW RESTARTS BEYOND THIS POINT SPC 1 LDA NRST PUT ERROR ROUTINE ADDRESS IN STA TRANS RESTART VECTOR. SPC 1 * CLEAR SYSTEM COMMUNICATION AREA * LDA LWSBP 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 * * MOVE UTILITY PROGS TO LOW DISK 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 LDA ID8,I GET DISK SECTOR COUNT CMA,INA 4JSTA DSCNT SET SECTOR COUNT LDA ID5,I GET INITIAL DISK ADDR LDB DSKAD SET CURRENT DISC STB ID5,I IN IDENT FOR LIB. DICT. SSA IF SCRATCH NOT ON SAME UNIT JMP MOVEL SKIP TEST LDB DSKA SAME UNIT CHECK TO SEE IF ABSOLUTE HAS COVERED CMB THIS RELOCATABLE PGM ADB A SUBTRACT CURRENT ABS ADDRESS SSB,RSS OVERFLOW? JMP MOVEL NO GO MOVE THE PGM * LDA ERR38 YES ERROR JSB IRERR NOT RECOVERABLE GO TELL HIM * MOVEL STA DSKRD SET CURRENT UTILITY DISK ADDRESS LDB ALBUF GET ADDRESS OF LBUF JSB DISKI READ UTILITY PROGRAM RECORD LDA DSKAD GET CURRENT ABSOLUTE DISK ADDR LDB ALBUF GET ADDRESS OF LBUF JSB DISKO WRITE UTILITY RECORD ON DISK LDA DSKAD GET CURRENT ABSOLUTE DISK ADDR JSB DISKA INCR DISK ADDRESS STA DSKAD SET NEW CURRENT DISK ADDRESS LDA DSKRD GET CURRENT UTILITY DISK ADDR JSB DISKA INCR DISK ADDRESS ISZ DSCNT SKIP - UTILITY PROGRAM MOVED JMP MOVEL MOVE NEXT UTILITY PROGRAM ISZ UTCNT INCR UTILITY PROGRAM COUNT JMP GETLB SCAN IDENTS FOR NEXT UTILITY PRG * * 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 STA ABCOR,I CORE BASE ADA N1 AND MAX STA MXABC,I JSB INLST INITIALIZE LST SCAN LBLST JSB LSTX SET CURRENT LST ADDRESSES JMP ENDSX END OF LIST * LDA LST4,I GET IDENT ADDR FOR ENTRY POINT * STA TIDNT SET IDENT ADDRESS 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 HLT 0 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 *** CPA P1 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 ONLY LIBR AND SYS ENTS SAVED ****** 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,I GET THE CORE RELATIVE LOCATION 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 GcFO WRAP UP * LDA LST4,I GET THE IDENT ADDRESS STA TIDNT SET FOR IDX ADA N5 IF UNDEFINED OR SELF SSA DEFINING JMP SXEND SKIP THE SYMBOL * JSB IDX GET THE IDENT ADDRESSES HLT 0 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 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 RSS MORE TO DO CONTINUE JMP USRTR DONE - JUMP ISZ TBUF STEP CURRENT TRACK LDA TBUF GET CURRENT TRACK JSB TRTST IS IT FLAGGED? CPB TBUF ?? JMP SYSTR YES - SET IT * LDA ERR42 NO - BOMB JSB IRERR WE CAN NOT RECOVER * USRTR LDA CURAT SET A = NO. OF USED TRACKS JSB DTSET SET DISK TRACK TABLE JSB REMDO FLUSH FINAL SECTOR FROM DBUF * LDA AEQT GET ADDRESS OF EQT STA EQTA GET 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 IFN *** BEGIN NON-DMS CODE *** 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 **** END NON-DMS CODE **** XIF * LD%pA BGBND SET BG BOUNDARY STA BKORG SET BG BOUNDARY * LDA COMBG SET BACKGROUND STA BKCOM COMMON LENGTH. * IFN *** BEGIN NON-DMS CODE *** LDA MEM12 GET BG DISK RESIDENT ORIGIN STA BKDRA SET BG DISK RESIDENT ORIGIN **** END NON-DMS CODE **** XIF * 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 LDA LOLNK SAVE LOWEST SYS LINK ADA N1 LESS ONE, 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 DIbTRNSC TABLE LENGTH ADA DAUXN CMA,INA STA TATLG SET TOTAL DISK TABLE LENGTH * * IFZ ***** BEGIN DMS CODE ***** CLA STA MEM12 CLEAR JUNK OUT OF MEM12 ****** END DMS CODE ****** XIF LDA DMEM1 SET UP THE MEMORY TABLE STA TBUF TO BE FIRST ADDRESS LDB N6 FOLLOWED BY NUMBER MADJ LDA TBUF,I OF WORDS CMA,INA CACULATE THE NUMBER ISZ TBUF STEP TO THE HIGH WORD ADA TBUF,I COMPUTE SIZE STA TBUF,I SET IT ISZ TBUF STEP TO THE NEXT WORD INB,SZB IF DONE EXIT JMP MADJ ELSE LOOP * STA EQT12 SET THE LAST WORD * LDA DMEM1 MOVE THE FREE MEMORY LDB DEQT1 TABLE INTO JSB MOVW THE EQT AREA DEC -11 * LDA LWSBP MOVE THE SYS COM LDB ADBP AREA ADB A TO THE JSB MOVW THE DUMMY BASE PAGE NLCOM ABS FWSCA-2000B * * 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 IFZ ***** BEGIN DMS CODE ***** SPC 1 * WRITE UPPER PART OF SYSTEM BASE PAGE TO DISK. * * THE PORTION OF THE BASE PAGE CONTAINING MEMORY * RESIDENT PROGRAM LINKS WAS ALREADY WRITTEN OUT. \T* 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. 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 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,I 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,I TRK XX SEC XXX(10)" JSB SPACE * LDA DSKAV GET NEXT AVAILABLE DISK ADDR LDB DERCN GET DISK ERROR COUNT JSB HLT77 JMP *-1 END OF JOB * * (TURN ON DISK PROTECT) * CPLSB NOP DMEM1 DEF MEM1 DEQT1 DEF EQT1 ASKEY NOP ADDRESS OF FIRST SHORT ID'S KEY WORD SKP 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= ADDR 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 N1 PAGE IN SIZE. STA IDTM1 SAVE PAGE REQMT STB IDTM2 SAVE IDENT POINTER ADB P5 B=ADDR OF IDENT WORD 6 SPC 1 * CHECK USE OF SSGA SPC 1 LDA B,6YI 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 B,I GET TYPE AGAIN AND SAVE BITS AND M13 0,1, AND REVERSE COMMON BIT. ADB N2 PICK UP COMMON SIZE LDB B,I IN IDENT. SZB IF ANY, THEN SET BIT 2 IN A. IOR M4 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 RRR 3 PUT MPFT INDEX AND IOR IDTM1 PAGE REQMT IN PROPER RRL 10 POSITIONS IN A-REG SPC 1 STA IDTM3 SAVE NEW ID WORD LDB IDTM2 THEN PICK UP IDENT ADDR, JSB IDFND AND CONVERT TO ID-SEG PTR 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 LDB IDTM2 INTO UPPER BYTE ADB P7 OF IDENT WORD 8. IOR B,I STA B,I SPC 1 * RETURN TO CALLER JMP IDFIX,I SPC 1 * CONSTANTS, ETC. SPC 1 IDTM1 BSS 1 IDTM2 BSS 1 IDTM3 BSS 1 XSSGA EQU 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.  SPC 1 * 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 5 * * 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 * LDB IDENT-ADDR * JSB IDFND * SPC 1 IDFND NOP ADB P7 POINT TO IDENT WORD 8 LDA M377 PICKUP KEYWD# AND AND B,I 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. * DETERMINE PAGE REQxUIREMENTS 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,I PRINT HEADING JSB SPACE NEW LINE CCA STA LFLAG SET PROGRAMS-LOADED FLAG = -1 LDA BIDNT GET FIRST IDENT ADDRESS 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 INCADo 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. HED RTE GENERATOR PAGE PRAMETERS AND CONSTANTS * ERR14 ASC 1,14 BG BOUNDARY ERROR ERR23 ASC 1,23 INVALID FWA BP LINKAGE ADDRESS ERR42 ASC 1,42 * 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 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 * * SKP * 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 NOP MAIN BG LOWER ADDRESS UBMAN NOP MAIN BG UPPER ADDRESS DSKBG NOP  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 MS02 ASC 8,BP LINKAGE 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? TYPMS NOP 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 BASNsE 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 ****** END DMS CODE ****** XIF HED RTE GENERATOR SCAN IDENTS FOR PROGRAM TYPE * * 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 ADDRESS FOR IDX JSB IDX SET IDENT ADDRESSES JMP IDSCN,I RETURN - END OF IDENTS LDA ID1 GET CURRENT MAIN IDENT ADDRESS STA IMAIN SAVE CURRENT MAIN IDENT ADDRESS LDA TIDNT GET NEXT IDENT ADDRESS 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 HED RTE GENERATOR TEST FOR SOME PROGRAMS LOADED * * 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 OF2 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,I 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,I SEND MESSAGE JMP BPLNR,I RETURN HED RTE GENERATOR CLEAR LOCAL LIST ENTRIES * * 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 ****I** END DMS CODE ****** XIF SPC 2 * 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 HED RTE GENERATOR OUTPUT ABSOLUTE BASE PAGE CODE * * 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 ADDRESS 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 HED RTE GENERATOR CONVERT A TO ASCII AT B * * CONVERT A TO ASCII AT B * * THE CONVD SUBROUTINE CONVERTS THE CONTENTS OF A * INTO ASCII (DECIMAL OR OCTAL) AT TH&E 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 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 HED RTE GENERATOR GET DIGIT FOR CONVD * * 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 RAINAD,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 HED RTE GENERATOR CLEAR MEMORY MAP BUFFER * * 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 LBUF5 DEF NAM5 WORD 6 OF LBUF ADDESS HED RTE GENERATOR INITIATE MAIN PROGRAM LOADING * * INITIATE MAIN PROGRAM LOADING * * LOAD IS THE SUBROUTINE FOR ENTRY TO LOADS FOR THOSE * PROGRAMS WHICH REQUIRE USE OF A NEW BP AND PROGRAM BASE. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOAD * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * LOAD NOP IFZ **** BEGIN DMS 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 DMS 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 LOADS LOAD PROGRAM  LDA LIBFG IF NOT LIB LOAD SZA,RSS THEN JSB SPACE NEW LINE JMP LOAD,I RETURN IFZ **** BEGIN DMS CODE **** SSGAF BSS 1 ***** END DMS CODE ***** XIF HED RTE GENERATOR LOAD AND LINK MAIN PROGRAMS AND SUBROUTINES * * LOAD, LINK MAIN PROG & SUBS. * * LOADS 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 SCRATCH PORTION OF THE DISK, AND WRITES THE ABSOLUTE CODE * ON THE LOWER (PROTECTED) PORTION OF THE DISK. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB LOADS * * RETURN: CONTENTS OF A AND B ARE DESTOYED. * LOADS NOP 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 TRN(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 LDA ID5,I GET THE NAM RECORD STA DSKRD SAVE CURRENT DISC ADDRESS JSB DBIN GET THE NAM RECORD DBINT JSB ZLOAD LOADING? JMP LH7 NO * LDA L01 SZA 1ST PASS? JMP LH7 YES * ISZ TEMP2 NO - TEST TEMPORARY HDFLG JMP SUBHD * JMP LH8 * 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 DMS 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 DMS 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-DMS CODE *** RSS CPA P12 RSS CPA P13 NO TYPE 13'S IN RTE-III **** END NON-DMS 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 yT 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 NPRIO 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 NINT2 SET UP THE TIME PARAMETERS ASL 4 FIRST THE RESOLUTION LDB NINT1 AND MULTIPLE BLS ASR 4 COMBINE STA MULR SET FOR ID SEG GENERATOR LDA NINT5 GET THE SECONDS MPY P100 CONVERT TO 10'S OF MS. ADA NINT6 ADD 10'S OF MS. STA OCTNO SAVE TEMP * LDA NINT3 GET THE HOURS MPY P60 CONVERT TO MIN. ADA NINT4 ADD MIN. MPY P6K CONVERT TO 10'MS CLE PREPARE FOR ADD ADA OCTNO 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 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 ) O 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 HLT 0B 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-DMS CODE *** LDA TBREL GET THE CURRENT BP ADDRESS STA TPBRE AND SET FOR BP CODE 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-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** * * SET RELOCATION BASE FOR ORB STUFF SPC 1 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. ****** END DMS 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 * LDB LBUF5 THE SIXTH WORD IN LBUF ISZ LFLAG BUMP THE L FLAG NOP IN CASE OF LEAP 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 COMMENTS JSB DRKEY,I 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 NOMP EQU * IFZ ***** BEGIN DMS 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 ERROR ****** END DMS 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 tJSB GETCP SET UP A CURRENT PAGE LINK AREA STA CPL1 USE FOR BOTH CLA AREAS STA CPL1H CLEAR THE COUNT WORDS STA CPL2H LIB 1 DOES OPERATOR WANT CURRENT PAGE RBL LINKS IF POSSIBLE? SSB IF YES - JMP LH222 GO SET UP * LH2 CCA NO - SW REG BIT 14=0 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 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 SIGPN 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 LDA CURAL GET CURRENT LBUF ADDRESS ADA LBUF ADJUST FOR END OF NAM RECORD STA CURAL SET FOR END OF NAM RECORD LDA LCNT GET CURRENT LBUF COUNT ADA LBUF ADJUST FOR END OF NAM RECORD STA LCNT SET NEW CURRENT COUNT * * CLASSIFY ENT, EXT, DBL, END RECS * 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 HLT 0B 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 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 LIB 1 GET THE SWITCH LDA TBREL REG. AND THE CURRENT BP ADDRESS BLF,RBR IF BIT 13 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 JMP LOADN AND GO LOAD * CLFLG CCA FILL FINAL BSS ADA TPREL LDB A IF TPREL IS GREATER CMA,INA ADA MXABC,I THAN MXABC (LABDO HIGHWATERMARK) SSA,RSS JMP CLF2 CLA JSB LABDO CLF2 LDA TBREL UPDATE LDB A THE MAX BP CMB,INB ADDRESS IF ADB BPMAX NEEDED IFN *** BEGIN NON-DMS CODE *** ~T SSB STA BPMAX **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS 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 DMS CODE ****** XIF LDA PTYPE GET CURRENT PROGRAM TYPE CPA P3 TYPE = BG DISK RESIDENT? JMP LOADS,I YES - DO NOT CLEAR LOADED FLAGS * JSB CLID3 CLEAR PROG-LOADED FLAGS JMP LOADS,I RETURN - ALL FLAGS CLEARED * IFN *** BEGIN NON-DMS CODE *** E16RR LDA ERR16 GET BP OVERFLOW JSB ERROR MESSAGE ON THE TTY CCB ADB LWSBP USE MAX WE HAVE JMP CONLD AND CONTINUE LOAD **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS CODE ***** E16RR LDA ERR16 PRINT BP OVFLOW JSB ERROR 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 DMS CODE ****** XIF 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 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 5 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 HLT 0B 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 * LIA 1 GET SWITCH REGISTER SSA,RSS SKIP - SWITCH 15 UP (LIST ENTS) JMP MLENT SUPPRESS PRINTING OF MAP * 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 uAMEM5 GET ADDRESS OF MESSAGE JSB CONVD CONVERT TO DECIMAL/OCTAL LDA P16 LDB AMLST GET ADDRESS OF MEM MAP BUFFER JSB DRKEY,I 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 TBUF+2 GET ORDINAL STA LST3,I SET ORDINAL IN LST * LDA LST4,I GET IDENT ADDRESS 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 ADDR FOR IDX LDA ID1 GET CURRENT IDENT ADDRESS STA TBUF SAVE CURRENT IDENT ADDRESS JSB IDX SET IDENT ADDRESSES HLT 0B IDENT NOT FOUND IN LIST LDA ID6,I GET M/S, TYPE STA TBUF+1 SAVE M/S, TYPE LDA ID3 GET PROGRAM USAGE FLAG ADDRESS STA TBUF+2 SAVE USAGE FLAG ADDRESS LDA TBUF GET CURRENT IDENT ADDRESS STA TIDNT SET CURRENT IDENT ADDR JSB IDX SET IDENT ADDRESSES HLT 0B 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 DMS CODE ***** CPA P30 JUMP IF SSGA MODULE JMP CKSSC ****** END DMS 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,I GET PROGRAM USAGE FLAG SLA SKIP - PROGRAM NOT LOADED JMP EXEND OMIT PROGRAM LIST ENTRY * LDB PTYPE IF BACK GROUND SEGMENT CPB P5 THEN IOR P4 SET THE BS FLAG IOR P2 SET THE MUST LOAD FLAG STA TBUF+2,I RESTORE THE FLAG TO THE IDENT * 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 ERROR PRINT THE NO-NO JMP EXEND TEST FOR ANOTHER IFZ ***** BEGIN DMS 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 ERROR JMP EXEND ERR52 ASC 1,52 ****** END DMS CODE ****** XIF LIBTS LDA LIBFG LOADING CORE RES. LIB? CLE,SZA,RSS JMP EXEND NO SO SKIP * CLB YES SET UP LDA LST1 THE LIB REPLACEMENT CODE CPA $PRIV REFERENCE TO $PRIV? CLB,CCE,INB YES SET FLAGS CPA $RENT REFERENCE TO $RENT? CCB,CCE YES SET FLAGS SEZ,RSS IF NEITHER JMP EXEND TREAT NORMALLY * STB LIBTP ELSE SET THE TRAP FLAG STA TRPLB AND LST ADDRESS 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-DMS 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 DISK RESIDENT? RSS CPA P3 TYPE = BG DISK RESIDENT? RSS CPA P5 TYPE = BG SEGMENT? RSS JMP DBL0 SET PGMAD = 0 FOR RESIDENTS **** END NON-DMS CODE **** XIF IFZ ***** BEGIN DMS 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 DMS CODE ****** XIF STB BSSDP SAVE INITIAL PROG DISPLACEMENT ADB ABCOR,I DISC /CORE STB ABCOR,I BASE ADDRESS STB MXABC,I AND THE MAX ADDRESS DBL0 JSB DBSET GET ADDR OF NEXT WORD IN LBUF DBL1 LDB CURAL,I GET RELOCATION BYTIES 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 - 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 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 8 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 ORDINAL IN THE FIX UP TABLE 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 HLT 0 HALT IF NOT THERE * LDA LST1 SET THE LST ENTRY IN THE 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 $RENT OR $PRIV? RSS YES SKIP JMP DBL45 NO, CONTINUE * LDA $LIBR YES USE $LIBR INSTEAD STA TLST JSB LSTX HLT 0 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 LST1 GET NEW LST ENTRY AND CONTINUE DBL45 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 PTRNROPERLY 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 * CLA MUST BE P+1 TRAP STA FIX4,I SET LST FIX ADDRESS TO ZERO ISZ ADTPF SET FOR X ADDRESS NEXT TRAP LDB FIX3,I GET ADDRESS FROM FIX LST STB ADTRP SET FOR NEXT LDB FIX3 SAVE THE FIX ENTRY ADDRESS STB FIXTP SO WE CAN FIX IT STA FIX3,I SET TO NOP INCASE NOT RENT LDA LIBTP GET FLAG THAT TELLS INA,SZA,RSS IF RENT JMP DBL60 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 JSB LSTX SET IT UP HLT 0 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 XT LDB LIBTP GET TYPE FLAG INB,SZB IF $PRIV JMP DBL61 JUST SEND THE WORD * STA LST1 ELSE CLEAR THE LST ADDRESS LDA FIX3,I SET THIS DEF STA FIXTP,I IN THE OTHER FIX ENTRY JSB DAFIX GO SEND BOTH INSTRUCTIONS JMP DBL33 GET THE NEXT INSTRUCTION * * 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 1 TIME BSS 2 MULR NOP FIXTP NOP TRPLB NOP LIBTP NOP ADTRP NOP ADTPF NOP SPC 3 * * 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 SET TLST TO 1ST LST LDB TLST PICK UP LST POINTER RSS SKIP INCR FIRST TIME SPC 1 LSTO2 ADB P3 POINT TO NEXT LST CPB PLST IF AT END OF LST'S JMP LSTO4 THEN EXIT. ADB P2 ELSE POINT TO ORD. IN LST LDA FIX4,I AND COMPARE WITH FIXUP. XOR B,I AND M377 IF LOW BYTE DOESN'T SZA MATCH, THEN TRY NEXT JMP LSTO2 LST ENTRY. SPC 1 ADB N2 MATCH..SET ADDR OF LST SPC 1 LSTO4 STB TLST SET ADDR OF CURRENT LST JSB LSTX GO SET LST POINTERS JMP LSTOS,I NO MATCH - N+1 EXIT ISZ LSTOS JMP LSTOS,I MATCH - N+2 EXIT SPC 3 * DFIX DOES THE FIX UP POINTED TO BY THE CURRENT FIX UP * TABLE AND LST ENTRYS. DFIX IS USED FOR ALL * INSTRUCTIONS AN]D 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 ADDRESS 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 ADDRESS 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 SPC 3 * 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 LDA TFIX IF NEW ENTRY STA PFIX UPDATE THE END CCB OF THE LIST 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: * * 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 FIX4,I GET LST ENTRY CPA LST1 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 * * FIX ADDRESS ROUTINES * * FIX AND FIXX SET UP THE FIX1 - FIX4 ADDRESSES * * FIXX INITILIZES THE ADDRESS TO THE FIRST ENTRY * * FIX GET THE NEXT ENTRY * * CALLING SEQUENCE: * * JSB FIXX A,B IGNORED A LOST ON RETURN, B SAVED * FIXX NOP LDA BFIX SET TFIX TO FIRST STA TFIX ENTRY JMP FIXX,I RETURN * * * CALLING SEQUENCE: * * JSB FIX A,B IGNORED A LOST B SAVED ON RETURN * * RETURN TO P+2 IF OK, TO P+1 IF BEYOND END OF DEFINED FIX UPS * FIX NOP LDA TFIX GET CURRENT LOCATION CPA PFIX END OF LIST? RSS YES SKIP THE INDEX ISZ FIX STEP TO ALTERNATE RETURN ADDRESS STA FIX1 SET UP INA THE STA FIX2 ADDRESSES INA STA FIX3 INA STA FIX4 INA SET NEXT ADDRESS STA TFIX IN TFIX CMA,INA CHECK FOR MEMORY OVERFLOW ADA PIDNT SSA,RSS IF OUT OF MEMORY SKIP JMP FIX,I ELSE RETURN TO CALLER * JMP LSERR ELSE GO TO ERROR ROUTINE HED RTE GENERATOR LOAD UTILITY SUBROUTINES * 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 mCPA 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 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 * LDA LST4,I GET IDENT ADDRESS CPA ID1 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. 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+1: 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 GOV#OD 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 * * 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 THREE ENTRIES ARE FOR BASE PAGE AS FOLLOWS: * * AREA 1 THE CORE RESIDENT SYSTEM BASE PAGE AREA * AREA 1 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 STA LNK1 SET THE LINK POINTERS UP INA STA LNK2 INA STA LNK3 JMP LNKS,I AND RETURN SPC 3 TLNK DEF TBLNK 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-DMS 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-DMS CODE **** XIF IFZ ***** BEGIN DMS 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 DMS CODE ****** XIF ALLO1 STA TCHAR 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 TCHAR SET THE ADDRESS IN A JMP ALLOC,I AND RETURN * ER16 LDA ERR16 GET THE ERROR CODE JSB ERROR SEND IT CLA RETURN ZERO AS THE LINK JMP ALLOC,I * ALSAV 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 ANLD 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 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 ESTRABLISHES THE ADDRESS OF THE NEXT WORD OF THE RELOCATABLE * RECORD IN LBUF. IF LBUF HAS BEEN PROCESSED, IT ISSUES A CALL TO * DBIN TO READ ANOTHER PACKED 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 JSB DBIN READ NEXT RELOCATABLE REC JMP DBSET,I RETURN HED RTE GENERATOR READ RECORDS FROM DISK * * READ PACKED RELOCATABLE RECS * * THE DBIN SUBROUTINE READS THE PACKED RELOCATABLE RECORDS FROM * THE DISK AS SPECIFIED BY THE DISK ADDRESS AT DSKRD. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB DBIN * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * DBIN NOP LDA DSKRD GET CURRENT DISK ADDRESS LDB DBIN GET RETURN ADDRESS CPB DBINS IF NAM RECORD READ SSA AND SYSTEM SUBCHANNEL SKIP JMP DBIN1 ELSE GO READ LDB DSKA GET MAX ADDRESS WRITTEN ON CMB IF GREATER THAN OR EQUAL ADB A THIS READ ADDRESS, SSB,RSS IF POSITIVE - OK JMP DBIN1 SO CONTINUE * LDA ERR38 ELSE - WE LOST THE RECORD JSB IRERR SO BOMB * DBIN1 LDB ALBUF GET ADDRESS OF LBUF STB CURAL SET CURRENT LBUF ADDRESS JSB DISKI READ RECORD FROM DISK LDA DSKRD GET DISK ADDRESS STA DSKRX -SAVE CURRENT ADDRESS. JSB DISKA INCR DISK ADDRESS STA DSKRD SET NEXT DISK ADDRESS LDA N64 STA LCNT SET CURRENT LBUF COUNT JMP DBIN,I RETURN SPC 1 DBINS DEF DBINT ADDRESS OF NAM RECORD READ RETURN SPC 3 ERR15 ASC 1,15 ILLEGAL CALL BY TYPE 6 PGM ERR16 ASC 1,16 BP LINKAGE AREA FULL BLNKS ASC 1, BLANKS BLAST ASC 1, * BLANK,ASTERISK LPAR OCHYT 50 LEFT PAREN SPC 1 HED RTE GENERATOR GENERATE INT ENTRY, KEYWD,ID SEG * * 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 KEYWORD 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 ADDR? RSS YES - CONTINUE JMP NOTPN IGNORE REF IF NOT CURRENT MAIN * LDA SYSAD GET ID SԑEG ADDRESS CMA,INA GET 2'S COMPLEMENT FOR INT ENTRY LDB AILST COMPUTE THE INT CORE CMB,INB ADDRESS 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 ADDRESS STA TIDNT SET ADDRESS FOR IDX JSB IDX SET IDENT ADDRESSES HLT 0 NO IDENT FOUND SPC 1 LDB SYSAD POINT TO ID SEGMENT LDA ID1 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 ************************************************************** 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 SEGMEN9RZXTT LDA SCH3 GET ADDRESS OF CURRENT ID SEG uZ 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 LDB ID1 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 TIME+1 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 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 ERROR MEMORY OVERFLOW LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP GENI9 GO FINISH THE ID-SEGMENT 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 SIDSA ADDRESS AND ITS CONTENTS JSB LABDO SEND THE KEY WORD TO THE DISC STB SKEYA SET THE NEW KEYWORD ADDRESS LDB SIDSA GET THE ID- ADDRESS ADB P9 ADDJUST FOR NEXT TIME STB SIDSA 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 STA TIDNT TO CURRENT JSB IDX HLT 0 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 LABDkeO 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 INTO ID SEG JSB ERROR LDB SIDS2 RESTORE POINTER LDA LWASM USE LAST WORD OF MEMORY INSTEAD JMP BLSI0 GO FINISH THE ID-SEGMENT * SIDSA NOP SKEYA NOP 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 HED RTE GENERATOR OUTPUT ABSOLUTE PROGRAM WORD * * 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 CURREN T 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 HLT 66B 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 SNEGATIVE 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 g 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 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. * 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 SPECITICATION 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 SEG,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 DEF LRMAN 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 REMDO 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 REMDO RESTORE THE CODE WORD JMP TSTOU AND GO OUTPUT IT * ERR18 ASC 1,18 MEMORY OVERFLOW 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 8 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 YE/NO NOP ANALYZE YES/NO RESPONSES LDA N3 RETURN: P+1 ERROR JSB GETNA P+2 NO JSB GETAL &+3 YES SZA MORE THEN 3 CHAR JMP YE/ER ERROR LDB TBUF 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 SPC 1 * 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 (ONE'S COMPLEMENT) * 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 SAVE DECIMAL FLAG SSA SKIP IF OCTAL REQUEST INA ELSE MAKE DEC. RQST 2'S COMPLEMENT STA TMPX SAVE DEFAULT VALUE LDB CHBND,I GET THE MESSAGE ADDRESS AND STB TMPL SET UP TO MOVE LDA N5 FIVE WORDS STA ERROR TO FORM THE MESSAGE: LDB DMES " CHANGE XXXXXXXXXX YYYYY" CHNX LDA TMPL,I MOVE STA B,I 5 INB WORDS ISZ TMPL TO ISZ ERROR 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,I "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 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 ERROR 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 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,? SPC 2 * * * ASOUT IS CALLED FOR ALL TTY OUTPUT * IT SENDS THE REQUEST TO THE TTY LIST DEVICE AND * IF BIT 4 OF THE SWITCH REGISTER IS * IS SET IT ALSO SENDS IT TO THE PUNCH. * ASOUT NOP ENTRY POINT DST ASOA SAVE THE PRAMETERS LIA 1 IF BIT 6 SET AND P64 THEN PRINT ONLY LDB DERTN ERRORS SZA CPB ASOUT RSS SKIP IF TO BE PRINTED JMP NOLST ELSE GO TEST FOR PUNCH * DLD ASOA GET THE PRINT PRAMS JSB LSTD,I SEND TO THE LIST DEVICE NOLST LIA 1 GET THE SWITCH REGISTER AND P16 MASK BIT 4 SZA,RSS IF NOT SET JMP ASOUT,I EXIT * DLD ASOA GET THE PRAMETERS JSB DRHSP,I SEND REQUEST TO THE PUNCH JMP ASOUT,I RETURN * DERTN DEF ERTN ADDRESS FOR RETURN FROM ERRO ASOA BSS 1 REGISTER SAVE ASOB BSS 1 AREA * * ASIN IS THE INPUT ROUTINE. IT READS FROM THE TTY * UNLESS SWITCH REGISTER BIT 5 IS ON AND ERROR = 0 IN WHICH * CASE IT READS FROM THE PHOTO READER. * * IT THEN ECHOS THE READ ON THE LIST DEVICE IF SWITCH 3 IS ON, * AND ON THE PUNCH IF SWITCH 4 IS ON. * ASIN NOP ENTRY POINT STB ASOB SAVE BUFFER ADDRESS LIB 1 GET THE SWITCH REGISTER BLF,BLF ROTATE BIT BLF,RBR 6 TO LEST SLB t~ IF SET JMP ASIPR GO DO PR INPUT * ASITY LDB ASOB ELSE JSB TTYIN,I GET RECORD FROM THE TTY ASITS CLB CLEAR THE ERROR STB ERROR FLAG SZA,RSS IF ZERO LENGTH JMP ASIN,I DO NOT ECHO * STA ASOA SET THE COUNT LIA 1 GET THE SWITCH REG. AND P8 MASK TO BIT 3 SZA,RSS SET? JMP ASIPU NO TRY THE PUNCH * DLD ASOA GET THE PRAMETERS JSB LSTD,I SEND TO THE LIST DEVICE ASIPU LDA ASOA SET A INCASE WE EXIT LIB 1 GET THE SWR. RBR,RBR RBR,RBR CHECK FOR ECHO ON PUNCH SLB,RSS ? JMP ASIN,I NO RETURN * LDB ASOB YES GET THE ADDRESS JSB DRHSP,I SEND TO PUNCH LDA ASOA RESTORE A JMP ASIN,I AND RETURN * * ASIPR LDB ERROR IF ERROR FLAG SET SZB THEN JMP ASITY GO DO TTY INPUT ANY WAY * LDB ASOB GET THE BUFFER ADDRESS JSB DRPTR,I GO TO THE PHOTO READER JMP ASITS GO TEST FOR ECHO * * 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 IFZ ***** BEGIN DMS CODE ***** SPC 1 * WRITE HALT MESSAGE AND SPACE SPC 1 HLT77 NOP JSB SPACE LDB HLTM. LDA HLTML JSB DRKEY,I SEND MESSAGE * LDA N10 * STA HLTCN HLTLP JSB SPACE PUT OUT TEN BLANK LINES * ISZ HLTCN * JMP HLTLP HLT 77B HALT FOR SWR CHANGES JMP HLT77,I SPC 1 *HLTCN BSS 1 HLTM. DEF *+1 ASC 15,HALT 77 - SET SWR & PRESS RUN HLTML EQU P29 ****** END DMS CODE ****** XIF IFN *** BEGIN NON-DMS CODE *** HLT77 NOP HLT 77B JMP HLT77,I **** END NON-DMS CODE **** XIF * * * 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 CLEAR? JMP *-3 NO - CONTINUE CLEARING JMP BUFCL,I RETURN SKP * * 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,I OUTPUT CR, LF ON TTY JMP SPACE,I RETURN SPC 3 SPC 4 * * PRINT: ERR XX * * THE ERROR SUBROUTINE IS USED TO PRINT THE DIAGNOSTICS * FOR ALL ERROR MESSAGES. * * CALLING SEQUENCE: * A = 2-DIGIT ASCII ERROR CODE * B = IGNORED * JSB ERROR * * RETURN: CONTENTS OF A AND B ARE DESTROYED. * ERROR NOP PRINT ERROR MESSAGES STA AMERR+3 SET ERROR CODE INTO MESSAGE LDA P6 LDB AMERR AMERR = MESSAGE ADDRESS JSB DRKEY,I PRINT ERROR MESSAGE ERTN JMP ERROR,I RETURN * * IRRECOVERABLE ERROR EXIT * IRERR NOP JSB ERROR PRINT ERROR MESSAGE HLT0 HLT 0B WAIT - PROGRAM CAN NOT CONTINUE JMP *-1 IRRECOVERABLE ERROR * AMERR DEF *+1 ASC 3,ERR ERROR MESSAGE = ERR + CODE 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 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 LDB ALIGN,I POINT TO MESSAGE, LDA B,I GET LEN TO A, INB AND TEXT ADDR TO A, JSB DRKEY,I 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 DEHTRNF MSMR+14 SPC 1 MSBG DEC 20 ASC 10,LWA BG COMMON XXXXX MSBGX DEF MSBG+8 ***** END DMS CODE ***** XIF SPC 1 * COME HERE IF USER ATTEMPTS TO RESTART AFTER FINAL * CLEAN-UP HAS BEGUN. SPC 1 E19 LDA ERR19 SEND ERROR 19 CODE JSB IRERR TO IRRECOV. ERROR ROUTINE ERR19 ASC 1,19 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 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 ORG * END BEGIN DT  92001-18016 C S C0222 RTE SYSTEM GENERATOR PART 2 (7900 DISK)             H0102 ,ASMBҬ̬àMH-GNDVҠSN. HDMHGNDVҠSNPAPҠAPŠBSAP NAM:MHDV SU:900-06V.B :900-606V.B PGM:G.A.A. (éPYGHԠH-PAKADMPANY95.A̠GHS SVD.NϠPAԠƠHSPGAMMAYBŠPHPD PDUDҠANSADϠANHҠPGAMANGUAGŠHUԪ HŠPҠNNSNԠƠH-PAKADMPANY. NAMMHGN900-606V.à5050 SUP NSANSAŠNA̠NBASŠPAG ԠNNN3NN5N6NN9N0N6N ԠN6PP3PP5P6PPP9PPP3P ԠP5P6PPP9P0PPP3PP5 ԠPP9P3P33P60P6P99P0P6K60̲000 ԠM60MM0MM3MM00DM00M060 ԠM0M600MM000M3M00M000M600 ԠM00MM0300M ԠDPSP000P000P00P0P ԠPSM000M000M00M0 ԠASMPP̬PP̬BANKUBNKMSGNPAB ԠDSKAMV NYPNSҠHSMDU VAABS... NԠSYSHSYSMSUBHANN NԠAUHAUؠDSàSUBHANN NԠDSZŠSYSMDSàSZŠ(AKS NԠDAUNAUؠDSàSZŠ(AKS NԠDSUNZŠSUBUN NԠDSKSàSAHDSàADDSS NԠSSYSSAUؠASԠSKAGS NԠDSKANMNԠDSàADDSSSUBUN NԠDSKϠDSàUPUԠUN NԠDSKɠDSàNPUԠUN NԠDSB̠GNAŠDSàABŠSUBUN NԠSԠSԠUNԠAKSUBUN NԠDSԠSԠUPAԠSUBUN NԠSDSSYSMDSàSSAK NԠADSAUؠDSàSSAK NԠSԠUSHNA̠YSҠM NԠDNDSàҠUN NԠDBPϠGƠDUMMYBASŠPAG NԠDSKABNA̠ABSDSàADDSS NԠPBԠNGUŠDSïPUNHB UYSUBUNS ԠDNSPAŬADGNAGNԬGìGA ԠNҬYůNϬSSҬSŬABDϬ ԠUDNVD AU0 BU DKYU0BYADDSS SPà3 BGNUSAԠƠPG. SPà BUƠBSS5MPBU BHNBSSMP DHSPU03BPUNHADDSS DNŠSԠADDSSS SԠUSԠSDNBASŠPAG SԱUS SԲUS+ S3US+ SԴUS+3 S5US+ HDMHGN-NSANSANDADDSSS DSKABԠNA̠DSàADDSSҠSYSD ASBUƠDƠASPB+ADDSSƠ9-DBUҠNB ABԠDƠSAԠADDSSƠBSAPAD NŠDƠNҠҠDSK DSZŠBSSDSKSZŠ-N.ƠAKS DSKSàBSSADDSSƠDSKSAHAA DAUNBSSAUAYDSKSZ SDSBSSSSAKҠSYSMDS$ ADSԠ0SSAKҠAU.DS DNBSSDSKҠUN AB30DƠ+ BSS6 DSԱDƠSYS SYSԠBSS SYSSDƠSSYS SYSSBBSS SԠBSSSAHUNԠSԠAK SSDƠSAUؠSAHASԠSKADDSS SSBBSSSAHSUBHANN SSYSԠ-SYSMASԠSKAG SAUؠԠ-SAHASԠSKAG SSZBSSSZŠƠSAHUN SYSHBSSSUBHANN̠ƠSYSMUN AUHBSSSUBHANN̠ƠAUؠUN SHBSSSUBHANN̠ƠSAHUN GҠDƠ+ADDSSƠBADAKAB BSS0BADAKAB NԱNPNZANAGҠDV DBPUSAԠƠDUMMYBASŠPAG DBPϠUDBPDNŠNYPN MSDƠMS0 MS0AS"àSAHSUBHN? DAAABSɯB-ɯàN.ƠDAAɯϠNSUNS MNDABSɯ-ɯDN.ƠMMANDɯϠNSUNS NMPBSSMPҠNZANUNS MS3DƠ+SUBHANN̠NUMBҠMSAG ASà MSDƠ+ ASà5KSSԠKNSUBHN: MS50DƠ+ ASàSAԠSAH? MSDƠMS0 MS0ASà6PUNHB? MS05ASàSYSMSUBHN? MS0ASà9AUؠDSàSUBHN? MS0DƠ+ ASà3DSSAK? ""ASà "?0"ASà?0 MS5DƠMS05 MSDƠMS0 HDNAVŠDSàSԠUPSN HŠNGMSSAGSAŠPNDDUNGHŠNAZAN PHASŬHHŠSPANSҠAHVADSNS. MSSAGŠSPNS MHDSàHAN?NҠA̠DGS KSSԠKNSUBHN: 0? .NҠϠ3DGԠDMA̠NS. .SPADBYAMMA . . ? SYSMSUBHN?NҠA̠DG AUؠDSà(YSҠNϩ?NҠYSҠN AUؠDSàSUBHN?NҠA̠DG SAHSUBHN?NҠA̠DGԠ(MAYBŠANYDNDSUBHN̩ SAԠSAH?NҠ3DMA̠DGS DSSAK?NҠ3DMA̠DGS$$ SPà3 DSUNPNYPNԠҠUSNSSSN. DB$B3PUԠB3NHŠS SBS NPGNҠAADYHŠUN AAҠHŠAGDS HNDDAP3 DBMSSMSSADD:DSKHN? SBADPNԠMSSAGŬGԠPY DAPSԠҠA̠DGSNPU SBDNGԠDGSUNA MPHNDPAԠNPU SADHN̠SԠDSKHANN̠NUMB SBSPAŠSԠUPAKMAP SB30DAP9SNDMSSAG: DBMSKSSԠKNSUBHN: SBDKYɠPNԠMSSAG GDAAB30SԠADDSSS SASDSҠNPU SANMPANDAҠPS ADAPSԠAKSADDSS SABHNNBHNMP DBN6A AH B30.SANMPɠAK SZNMPMAP NBSZBSPUNԠ-DN? MPB30.NϠ-AҠNԠD SANԱAҠNԠAG SADSKSàSԠ0DNDSUBHANNS B30ASBNMPSAVŠUNԠUN ADB"?0"ADDNSANԠϠGԠ? BƬBƠANDAŠϠGԠ? SBMS3+SԠNMSSAG DBMS3GԠMSSAGŠADDSS DAPANDNGH SBADGϠGԠHŠANS DANGԠS SBGNAϠHAAS PA""? MPB30ؠYS-GϠHKUH SBGNԠNϠ-NAZŠBUƠSAN DAN3NVԠ3DGS SBGàDMA MPB30ŠҠ- SABHNɠSԠAKS SZASSƠZ MPB30BGϠUPDAŠPNS SBGA̠NԠZϠ-GԠNԠHAA PABANKMMAN? SSYS-SKP MPB30ŠNϠ- DAN3SԠ SBDN3DMA̠DGSANDNV MPB30+ SASDSɠSԠSԠAKƠHANN DABHNɠGԠHANN̠SZ SADSZŠSԠSYSM SASSZANDSAH DANMPϠHSSUBHANN SASYSHҠDAU SASHSNGŠSUBHANN̠SYSM SZDSKSàSPA̠SUBHANN̠UN B30BSZSDSSPAB SZBHNADDSSS SZNMPSPSUBHANN B30ƠDBNMPƠUNԠSUBHANN PBPSHN MPB30YDNŠSϠGϠ MPB30ANԠ-GϠASKҠNԠN SPà B30ŠSBNҠ̠HMHŠASAN AA SABHNɠUNԠAKS MPB30ƠGϠASKAGAN SPà B30ؠSBGA̠ŠND SZAANYHNGS? MPB30ŠYS- B30YDADSKSàNϠ-GԠNUMBҠƠHANNS MANASZADND-SԠZ? MPB30ZNϠ-SKP SBNҠYS-̠HM MPSB30ANDSA B30ZSBDSSZGԠHŠSYSMDSàS.K. SASDSANDSԠ. ANAƠNY PADSKSàNŠSUBHANN MPAUNSKPϠHŠAU.MSSAG SPà SBSPA SYSàDAP5SNDMSSAG: DBMS5SYSMSUBHN? SBADGԠANS ANANŠDGԠA SBDNGϠNV MPSYSàҠ-YAGAN SBSHSԠҠGA̠SUBHANN SBDSZŠSԠSYSMSZ SASYSHSԠSYSMSUBHANN SPà SBSPA SUNDAP6SNDMSSAG: DBMSSAHSUBHN? SBADGϠGԠANS ANANVԠNŠA SBDNDG MPSUNҠ-YAGAN SBSHSԠҠGA̠SUBHANN SASHSAVŠSAHSUBHANN SBSSZANDSZ AUNAPSԠϠSHנNϠAUؠDS SADAUNSԠHANN̠ϠZ AANDSUBHANN SAAUHϠ-. SBSPA AUDSDAP3SNDMSSAG DBMS6AUؠDSà(YSҠNϠҠKS? SBADGϠGԠANS DAN3SԠYҠADMA SBGàNUMB MPAU0NϠYҠYSҠN SABUƠSAVŠHŠNUMB SBGA̠NDƠNPU? SZA MPAU0NϠԠYůNϠSND DABUƠSŠHŠSZŠϠAAND SADAUNLSԠHŠAUؠDSàSZ SBDSSZGԠSSSAK MPAU3GϠSԠ AU0SBGNԠSԠHŠSANN SBYůNϠYҠYSҠN MPAUDSNϠMUSԠBŠBADANS MPSSҠNϠ-SKP ANAYS-ƠNYN PADSKSàDSàSUBHANN̠HN MPAUشHNNGANSҠYAGAN SBSPAŠYS-SԠUPAUؠUN AUUNDAPSNDUSN: DBMSAUؠDSàSUBHN? SBADGϠSNDANDGԠANS ANANVԠNŠDGԠA SBDN MPAUUNҠ-YAGAN SBSHSԠҠGA̠UN AUرSBDAUNSԠSZŠƠAUؠUN PASYSHSAMŠASSYSM? SSYS-ҠSKP MPAUزNϠ-GϠSԠUP AUشSBNҠSNDҠMSSAG MPAUNANDYAGAN SPà AUزSAAUHSԠAUؠHANN DASDSSԠAUؠKSZŠϠSAMŠASSYSDS AU3SAADSSԠAUؠDSàS.AK SPà SSҠSBSPAŠNנN S̠DAP DBMS50MS50ADD:SAԠSAH? SBADPNԠMSSAGŬGԠPY DAN3SԠҠ3DMA̠DGSNPU SBDNGԠDGSUNA MPS̠PAԠNPU DBSSZGԠSAHSZ MBNBƠNPUԠNԠGA ADBAHANDS SSBSZ MPSMSKP SBNҠSŠ MPS̠YAGAN SMDBSHGԠSAHSUBHANN PBSYSHƠSAMŠASSYSM SSSKP ADAM00SŠADD00ϠAGASNNSYSM SZAƠSYSMANDZϠSKP A̬SASŠMUPYBY DADSZŠZϠNSYSM-USŠUPPҠHAƠSYSM AƬAƠAŠ AҬAҠAKAN ANDM600MASKϠAK SADSKSàSԠSAԠSAH N:HŠAԠHAԠANYGVNDS ADDSSSNAUNԠHҠHAN HŠSYSMUNԠSAGGDBY SAKADDSSBNGGAҠHAN 00BYHŠAMUNԠƠHŠDSD AK. MPDSUɠUNϠMANNŠD SPà N3Dà-3 SPà GԠSSҠDS DSSZNP SBSPAŠNנN SñDAP5 DBMS0MS0ADD:DSSAK?$$ SBADPNԠMSSAGŬGԠPY DAN3SԠҠ3DMA̠DGSNPU SBDNGԠDGSUNA MPSñPAԠNPU ASDUBŠҠ6DSS MPDSSZɠUN SKP SPà3 SUBUNŠϠSԠGAY ASUBHANN.HŠSԠNSSS ƠKNGҠHŠDSD HANN̠NHŠAKMAP. ANGSUN P-ҠUN PSBSH P+NMA̠UNHANN̠NASZŠNB SPà ANNYSASSUMDϠBŠHŠSUBHANN̠ϠBŠHKD. ҠԠSP- ƠHŠSUBHANN̠SGA̠ԠSUNDNA ANDBSHŠNUMBҠƠAKSNHAԠHANN SPà SHNP DBAB30GԠABŠADDSS ADBAADDSUBHANN ADBPSPϠAKS DBBɠGԠAKSNB SZBƠZϠ-Ҡ-SKP MPSHɠSŠK-UNBAKS DANԱSŠGԠNԠAG SZASSƠNԠS SBNҠSNDҠMSSAG DASHGԠUNADDSS ADANADUSԠҠP- MPAɠANDUN SKP NSԠHN̠N.NNSUN HŠSDSKSUBUNŠSSHŠUNԠDSKHANN NS.NHŠɯϠNSUNS. ANGSUN: AN.DSϠBŠNGUD(NG. BADDSSƠNSUNADDҠS SBSDSK UN: ADSYD BNԠNSUNADDSS SDSKNP SABUƠSAVŠN.ƠNSUNS SDSDABɠGԠNSUN ANDM00SAŠNSUND ҠDHN̠NSԠHANN̠N. SABɠSԠNSUNND NBNҠNSUNADDSS SZBUƠSKP-A̠NSUNSNG. MPSDSNGUŠNԠNSUN MPSDSKɠUN SPà ADKDƠDK HDMHGNNGUŠANDMPŠNZAN PBԠNPNGUůPUNHBԠNYPN DADAAGԠHŠNUMBҠƠDAAHANN̠NSUNS DBHPDSKGԠHŠADDSSƠHŠDSKADDSSS SBSDSKGϠSԠDAAHANN̠ADDSSS SZDHN̠SPϠMMANDHANN DAMNDGԠNUMBҠƠMMANDHANN̠NSUNS SBSDSKSԠMMANDHANN̠ADDSSS SBNSNZŠHŠSYSMDS SPà DBABԠŠHŠDSàBԠN AŠH SBDSKDDSàAK0SԠ0ϠSԠADDSSS DBADKGԠHŠABŠADDSSNB DASDSS AƬA̠H A̠NUMBҠƠDS SABɠPҠAK NBSPBԠADDSS DAԣA0SԠHŠAKADDSSҠAK0 SABɠNHŠB NBSԠH DASKàSKMMAND SAB DASDSSԠH AҬAҠƠSSSUA NB eSAB NB MANASԠNGAVŠƠABV SAB NB DAHADSԠHŠHAD SABɠBS NB DAңDMSԠHŠADMMAND SAB NB DAUNԠANDHŠUN SAB NB DABɠGԠHŠABŠADDSS ANDMANDMASK SABU+ϠPAGŠS DAASMGԠAM ANDM060MASKϠPAG SABUƠSAV ҠBU+ADDHŠPAGŠS SABɠSԠHŠABŠADDSS DABADDGԠHŠBԠADDSS ANDMMASKϠPAGŠBSAND ҠBUƠADDPAGŠBSAND SABADDSԠҠHŠPAPҠB A̬ŬAAҠHŠSGNB SANԠSԠNHŠDҠB SASPADAUPŠƠMS DBABԠUPUԠHŠBSAP AŠϠHŠDS SBDSKDAKZϠSԠZ SKP B0SBSPAŠNנN DAPSNDMSSAG DBMSPUNHB? SBADGԠHŠD SBYůNϠANAZ MPB0Ҡ-YAGAN MPPBԬɠNϠUNϠMAN SPà SBADҠPUNHAD DANBàGԠBԠNGH SABUƠSԠҠHKSUMAUAN DASAPGԠADADDSS BSSNAZŠHKSUM BԱADBAɠMPUŠHKSUM NASPADDSS SZBUƠDN? MPBԱNϠ-GԠNԠD SBAɠYS-SԠHKSUM DAB̠GԠNGAVŠNGH+3 DBSAPGԠADDSSƠHŠB SBDHSPɠSNDϠHŠPUNH SBADҠPUNHA MPB0GϠASKƠHŠANSANH SPà ADҠNPUNŠϠPUNHAD DANGԠUN SABUƠSԠNUN ADDBDZϠGԠADDSSƠAZ ASԠҠDBNAY SBDHSPɠGϠPUNH SZBUƠSPUNԠ-DN? MPADNϠ-SNDԠAGAN MPADҬɠYS-UN SPà MSSDƠ+ ASàMHDSàHN? MS6DƠ+ ASà6AUؠDSà(YSҠNϠҠKS? HPDSKDƠɯBɠADDSSƠɯϠNSUNS DHN̠BSSDSKɯϠHANN̠N.(A̩ DZϠDƠZ ZϠNP HDMHGNNS-ϠNZŠHŠDS UNŠϠNZŠHŠSYSMDSKS.AHSUBHANN̠SSD ANDƠSYSMAUجҠSAHԠSNZDUNNDNAY. ƠԠSDNDBUԠNԠNŠƠHŠABVŠHŠUSҠSASKDƠH ANSԠNZD.HŠSYSMSNZDϠŠP. A̠HҠUNSAŠUSԠNZD. ANYDVŠAKSAŠAGGDDV.ƠHŠDV AKSAŠUNDNHŠSYSMHŠAUجҠHŠSAHUN HYAŠNDNϠABSSϠHYMAYBŠSKPPDDUNG GNANANDAGGDASSYSMAKSDUNGHŠAKAB GNAN. SPà3 NSNP ASԠNϠHADҠ SABU+3BADAKSAND SABU+N ASԠUNԠDVŠUNԠ SASYSSBZϠNDVҠAB DASDSADUS AƬA̠DMϠSHנH A̠NUMBҠƠDS MANA-ҠDMAPҠAK SADMSԠ DASDSGԠSS ASASDVDŠBYϠϠGԠN.NASD MANASԠNGAV SANSàSԠҠDV DAN0AҠHŠBAD SABUƠAKAB DBGҠGԠADDSSƠAB ASԠϠ-ҠNϠNY N0SABɠSԠNAB NBSPABŠADDSS SZBUƠDN? MPN0NϠDϠNԠN DASYSSBYS-GԠHŠUNԠSUBHANNp N̠DBMSGNGԠNԠDAABԠҠDV PASYSHƠSYSMSUBHANN ADBM000SԠHŠŠPԠB SBNԱSԠҠDV SSSKPҠUN MPNBSUBHANN̠NԠNSYSM SBSHGϠGԠSUBHANN̠SZ MBNBSԠNGAVŠSZ SBNMPNUN PASYSHHSHŠSYSM? SS PASHSAH SS PAAUHAUؠUN? MPNAYS-BYPASSUSN SZBU+NϠ-HADҠPNDY? MPNàYS-SKPHADҠPN SBSPAŠNϠ-PNԠԠN DAP9SNDMSSAG: DBMS9NZŠSUBHN: SBDKYɠϠY NàDASYSSBGԠUNԠSUBHANN ADA"?0"ADDASɠ?0 AƬAƠAŠANDS SAMS3+ DAPSND DBMS3USN SBADϠPYUN SBYůNϠSԠҠYSNϯ MPNà--YAGAN MPNBNϠ-SKPN SPà NADASYSSBSԠS ADAAB30AKҠHS DAAɠUNԠMH SASYSԠAKMAP AS NDSABU+AKϠZ DBM000ADDSSϠ000 ŠŠҠ SBDSKDA̠DV NƠDABU+GԠAK ADAM00ADD SZNMPSPUNԠ--DN? MPNDNϠ-DϠNԠAK SPà NBAYS-SԠҠNԠUN SABU+3SԠNϠHADAGҠҠP SZSYSSBSPUN DASYSSBSNנUN PAP AƬSAYSDN MPN̠NϠ-DϠNԠUN MANAS SADMDMϠ- AANDA SANԱNԠAG !DASYSHSԠUPHŠDVҠAB SASYSSBSԠSUBHANN ADAAB30GԠSԠAK DBAɠMH SBSYSԠAB DASHGԠSAHSUBHANN SASSBSԠNAB ADAAB30GԠSԠAKM DBAɠHŠAB SBSԠANDSԠ DASHGԠSAHSUBHANN DBSYSSANDSYSASԠSKADDSS ŬASԠϠSAHUN SABUƠSAV DASYSSBGԠSYSMSUBHANN ŬASԠϠUN PABUƠƠSAMŠUNԠASSAH SSSKP NBSŠUSŠDNԠASԠSKADDSS SBSSSKADDSSҠSAH MPNSɠUN HDMHGNNԠҠUNŠANDAKAGG HŠDVҠNSHŠAҠ0SHAVŠADϠNZŠH DS. SPà NҠDASABGԠSAUSAND ANDM0MASKSKHKHKANDNDƠYND SZASSBS-ƠNԠSԠNNU MPN0HBADAKUN DAMS3SŠSNDBADSPAN SBҠMSSAGŠAND MP00SA N0DADYƠSԠMMAND SANԱϠAGAKDV ŠAND DBM000A DABU+HŠDV SBDSKDDV AS SABU+HADҠAG SZBU+3BADAKHADҠPNDY MPNSYS-SKP SBSPAŠNϠ-SNDSPA DAP0SNDMSSAG: BADAKSSUBHAN̠ DBSYSSBGԠSUBHANN ADBBK0ADDASàBANK0 SBMS-SԠNMSSAG DBMSSNDH SBDKYɠMSSAG NSDABU+GԠAKADDSS AƬAƠMVŠԠϠ A̠A MANASԠ{ NGAVŠҠDMA̠NVSN DBABUƠSԠBUҠADDSS SBNVDNVԠHŠNUMB DAP6AND DBABUƠSND SBDKYɠHŠAKNUMB AKSNנAGGDANDPDԠSNנNDNH SYSMABŠƠԠSNHŠSYSMAUجҠSAH SUBHANN. DASYSSBSԠH DBMSGNNԠDAA PASYSHƠSYSM ADBM000ADDHŠŠPԠB SBNԱSԠҠDV PASYSHƠNԠSYSM SS PASHSAH SS PAAUHAU SSSKP MPNƠSŠUNϠNԠUN DABU+GԠHŠAK ADASYSSBSŠSԠSUBHANNA̠ANDAKD SASԠϠSԠMPSAV DBGҠGԠHŠBADAKABŠADDSS DAN0Aנ0NS SABU+SԠUN NűDABɠGԠNY SSANGAV? MPNԠYS-USŠHSN NBNϠAADYUSD SZBU+SPUNԠ0Y? MPNűNϠ-YNԠN DAMSYS-SNDVABŠ SBҠҴ NԠDASԠGԠSUBHANN̯AK SABɠSԠNAB MPNƠGϠNSHNZAN. SPà3 DYƠԠ0000 ABUƠDƠ+ BSS3 MSASà M0Ԡ0 MS3ASà3 MS9DƠ+ ASà0NAZŠSUBHN: MSASà0BADAKSSUBHN̠ MSDƠMS BK0ASà0 HDMHGNDSàDVŠɯϠNSUNADDSSS ɯBDƠDSKDADAAHANN DƠDSKDB DƠDSKD DƠDSKDD DƠDSKD DƠDSKD DƠDSKDG DƠDSKDH DƠDSKD DƠDSKD DƠDSKDK DƠDSKD DƠDSKDM DƠDSKDN DƠDSKD DƠDSKDP 7TRNDƠDSKD DƠDSKD DƠDSKDS DƠDSK5 DƠDSK5 DƠDSK53 DƠDSK5 DƠDSK55 DƠDSK56 DƠDSK5 DƠDSK5 DƠDSK59 DƠDSK60 DƠDSK6 DƠDSKDZ ɯàDƠDSKAMMANDHANN DƠDSKB DƠDSK DƠDSKD DƠDSK DƠDSK DƠDSKG DƠDSKG DƠDSKH DƠDSK DƠDSK DƠDSKK DƠDSK DƠDSKM DƠDSKP DƠDSK DƠDSK DƠDSKS DƠDSK DƠDSKU DƠDSKV DƠDSK0 DƠDSK0 DƠDSK03 DƠDSK0 DƠDSK05 DƠDSK0 DƠDSK0 DƠDSK09 DƠDSK0 DƠDSK DƠDSK6 ɯDU SPà BSSBGN+500B-SKPϠ500BϠAVDPBMSH 'ϠUSA-500B' HDMHGNS.0K0BSAP HŠNGADҠPMSADNGƠHŠSDNԠPNS ƠHŠA̠MŠMN.HŠADҠSADNSҠ0 AK0ƠHŠSYSMDS.ԠSGNADBYHŠSYSM TGNAҠANDNSSS: (HŠNSUNSUDҠADNGHŠSYSM (HŠDSKANDŠADDSSSSPYNGADNG HŠADDSSSUDҠADNGAŠHŠNG: (ABASŠPAGŠNKAGS (נŠADDSS (HGHŠADDSS (3DSKADDSSƠABSUŠD (BSYSMԠSDNԠMAN (נŠADDSS (HGHŠADDSS (3DSKADDSSƠABSUŠD (éBGSDNԠMAN (נŠADDSS (HGHŠADDSS (3DSKADDSSƠABSUŠD HŠPGAMSASSUMDϠBŠADDNHŠAAUSԠPDNG HŠPDAD. SAԠABSDB-+ASPBƠGԠADDSSƠDSKSP.BU ABSSB-+SPADSԠUNԠSPBUƠADDSS ABSSB-+PADADMANSYSMԠSDNS ABSSB-+PADADMANBGSDNS ABSSB-+PADADBPNKAGS MP3BɠANSҠϠԠMNҠNYP. PADABS000B-+SAԠADDSSҠBԠHNBBD'D ABSDB-+SPAD++ɠGԠנŠADSS ABSSZ-+SPADNҠUNԠSPBUƠADDSS ABSDA-+SPAD++ɠGԠHGHŠADSS ABSSZ-+SPADNҠUNԠSPBUƠADDSS MAŬNAMPMNԬSԠDNB ADABSԠAA̠DUN B̬BSԠDNBԠNŠADD à BSԠMMYADDSSGS ABSSA-+NԠNAZŠMANNGUN ABSDA-+SPAD++ɠGԠHŠDSKADSS ABSAND-+M.SAŠHŠSҠADDSS SABSԠNB ABS-+SPAD++ɠSAŠHŠAKADSS ABSSZ-+SPADSPHŠPAMABŠAN AƬAƠAŠ A̠נA ABSADA-+BASŠADDAKZϠϠGԠABSUŠAK ABSSA-+ԣAKSAVŠҠADDSSNG BSADDUSԠSҠUNԠҠDSS DABGԠSҠϠA AƬAƠMUPYBY AҠ MANAANDSUBAԠM SADABSADA-+DKNUMBҠƠDSPҠAK ABSSA-+PDSSԠPSVŠDS MANAAND ABSSA-+NDSNGAVŠDSHSAK SSSKPVҠBBD̠ADDSSD ABS000B+BN-ϠDNŠADDSSƠBN ABSDA-+NԠGԠNUMBҠ SSASSƠPSV ABSMP-+PAD++ɠDNŠ-SϠ ABSADA-+PDSSŠSԠϠAD ABSSA-+NԠSAVŠMANNGUN SSANԠAK AUSŠMN.ƠNUMBҠNAK ABSADA-+NDSNUMBҠ SàSԠDMAҠDUN AANDSND ABSDA-+ԣAKGԠHŠAKADDSS DSKDAA0ANDSND DSKDBSà0à ABSDA-+SKMDGԠHŠSK DSKAàMMANDAND DSKBASND DSKàSààSAԠSK ABSADB-+NSԠSUBAKNUMBҠPҠSD SSBSSƠSDŠ ABSADB-+.00ADDHADB SSBS ABSADB-+PSԠADDBAKϠGԠS ABSADB-+BMSKADDHŠSUBHANN̠HADB DSKDàSS0AԠҠAK ABSMP-+DSKD DSKDDB0SNDHADSҠD DSKDŠSà0à̠HŠN ABSDA-+ңMDGԠHŠADMMAND DSKDSS0AԠҠSK ABSMP-+DSKD DSKŠASNDADMMAND DSKDƠSà0àSԠUPҠAD DSKƠà Sà6àSAԠDMA DSKGSààSAԠAD DSKHSSAԠҠND ABSMP-+DSKH SƠ6DSABŠDMAҠSAUS DSKDGSà0àD ABSDA-+UNԠSAUS DSKɠà DSKʠANUN DSKKSà DSKDHSS0AԠҠSAUS ABSMP-+DSKDH DSKDɠA0GԠSAUS SAƠBAD HԠ3BSAUSHA SANSA ABSMP-+SAԠSAԠV BSԠSҠϠZϠҠSԠƠSGMN ABSSZ-+ԣAKSPHŠAKADDSS AAND ABSMP-+SADGϠAD DAAAA ԣAKDà-MVŠUNԠҠBBD̠MV .00Ԡ00 M.Ԡ PDSNP NDSNP NԠԠ500NGUDϠBB̠ADDSS SPADԠ500NGUDϠBB̠ADDSS DKDà30HSŠ BASŠNPSYSMAK SKMDԠ30000 PSԠDà-DSA NSԠDà BMSKNPSԠBYH ңMDԠ0000 UNԠNPGNA ASPBƠABSASPB+- BSS9SYSMADNGSPANS BNԠNPSBHŠMBBD SƠ6ANUPDMA à0àANDHŠɯϠSYSM HԠBDSABŠHŠADҠNABŠSHANDUN DBԠABSDA-+PAD++ɠMVŠDSϠBB- ABSSA-+N++ ABSSZ-+PAD ABSSZ-+N ABSSZ-+ԣAKDN? ABSMP-+DBԠNϠGԠNԠD ABSMP-+SPAD++ɠYSGϠUŠHŠB HŠNGUSNASHŠBSAP ϠBŠADANYHŠNŠHNUPUԠ DSKBUԠUABŠMHŠASԠPAGŠƠ. ϠUSA-500BSԠҠSAԠAԠ500PAGŠAV DBU066000BDB SBU06000BSB ADBU06000BADB SBU06000BSB SZU036000BSZ DAU06000BDA SAU0000BSA ADAU0000BADA ANDU0000BAND ҠU0000B MPU06000BMP ɠU00000BNDԠBԠ(DŠAS+ɩ HŠNGUAŠUSŠϠSԠUPHŠBBD̠MVŠD HNBDBYHŠBBD̠HŠADҠSADDϠ0 ANDSB'DϠAԠ055ɠ(AVũ Ϡш.USA-BAVŠPAGŠANƠSA SPà BSS000B+DBP--5BSVŠKҠDUMMYBP. HDMVŠHADPAPҠAPŠBԠSAP MVNGHADBSAP HSBSAPSNGUDANDPUNHDBYHŠGNAҠANDS USDϠADHŠDSàSDNԠBSAPMSYSMAK 0SҠ0. SPà3 SAPDƠ+ADDSSƠHŠBԠSAP ABSB̲56NGHƠADҠNHGHHAƠƠD ABSBGADADDSS SAԠà0àSPVHNG-ŠSMMNG! DAԣA0-ADNSK DSKDʠA0 DSKDKSà0àSԠSYSM DASK-ADNAK DSK̠A DSKMSààAND DSKDSSS0 MP--ADNHAD DAHAD-ADN DSKD̠A0SA DSKDMSà0àSK DADSKD-ADNS A6UP àDMA DBBADD-ADNBUҠADDSS B DADM-ADNDS Sà A DSKDZSSAԠ MP--ADNSK DAңDM-ADNS DSKPàUP DSKѠAH DSKDNSà0àAD Sà6 DSKҠSààSAԠAD DSKSSSA MP--ADNҠ SƠ6AҠDMAҠSAUS DSKDϠSà0àD DAUN-ADNSAUS DSKԠà DSKUA DSKVSà DSKDPSS0AԠ MP--ADNSAUS DSKDѠA0 B̬ŬBMVŠSGNBԠMADDSS SASSANYS? MPBɠN.GϠϠHŠNSN PASD-ADNSHSHŠSԠM? SSYSYAGAN. HԠBNϠHA MSAMPSA-ADNYNSA SDԠ0000 DMDà- BADDABSSA-++ɠHS UNԠNPSVN HADNPDS SKàԠ30000A ңDMԠ0000SԠBY DSKD?ҠԠ0000H ԣA0NPGNA SPà HNDҠMPSA-ADNMUSԠBŠAԠ00BHNADD NPANҠHKSUM SPà BGU00B+SA-HNDҠUNMŠGƠPAPҠB ADNUHND-00BADDSSADUSNGNSAN. B̠UHND-SA+BԠNGH B̴UB+B+B+B̠BԠNGHMS Ḇ6UB̴+B̴+B̴+B̴MS6 B6UḆ6+Ḇ6+Ḇ6+Ḇ6MS6 B̲56UB6+B6+B6+B6MS56 B̠ABS-B-3NGHҠPUNHNG NBàABS-B-BԠNGHҠHKSUMAUAN HDGNAŠ$B3AKMAPAB DSB̠NP GNAŠB3 SPà DAAB30GԠHŠABŠADDSS SABUƠSԠҠNDNG DAN6GԠNUMBҠƠDS SABU+SԠUN DB$B3GԠHŠSԠNY SBSSҠ$B3 HԠ0BADNSNϠ$B3????? DBPP̠GԠHŠŠADDSSҠAB SBS5ɠSԠNHŠSYMB̠AB DSBDABUƬɠGԠDMAB SBABDϠSNDϠDS SZBUƠSPABŠADDSS SZBU+SPUNԠ-DN? MPDSBNϠ-GԠNԠNY SBPP̠SԠNנŠADDSS MPDSB̬ɠUN SPà3 $B3DƠ+ ASà3$B3 HDMHGNNMNԠDSàADDSSUN NMNԠDSKADDSS HŠDSKASUBUNŠNMNSHŠUNԠDSKADDSS ϠPVDŠHŠADDSSƠHŠSUDNGSҬ HHҠHAԠSҠSNHŠSAMŠAKҠHŠNG AK.NADDNHŠDSKASUBUNŠHKSHA HŠNԠDSKADDSSSVAD. ANGSUN: AUNԠDSKADDSS BGND SBDSKA UN: ANԠDSKADDSS BDSYD DSKANP SABSAVŠUNԠADDSS AN7DMSAŠSҠNUMB NAADD. PASDSƠϠMAؠN.NSYS.DSì ASԠ0 SADSKԠANDSAVŠNנSҠ. DABSA AƬAƠAK A̠ADDSS ANDMNנA. BƠN PBDSKԠSҠ0 NAADDϠAK. PBDSKԠNנAK? SBSԠYS-SԠҠDV SZƠSYSMSKP MPDSKSŠHKAGANSԠSAH PBDSZŠϠAGŠVҠ? MPDKҠYS-BMB MPDSKNϠ-SKP DSKPBSSZSAHV? MPDKҠYS-BMB DSKAƬA̠SŠAKϠ-0 A̬A̠AND ҠDSKԠNSԠSҠ. MPDSKAɠ-UN. DKҠDAұSԠDŠҠNSUNԠDSK SBҠVABŠҠ ұASàҠDSNԠUN DSKԠNP-MPAYSAG HDSԠҠBADAKSUBUN HŠSԠUNŠSSADSàAKϠSŠƠԠHASBNAGGD DVŠBYHŠNZANUN.ԠUNSHŠSԠGD AKABVŠHŠSԠAKƠHŠAKSBAD. SPà SԠNP DBN0SԠUNҠ SBM0NS AƬŬAƠAŠAK AA̠HGHAANDSAVŠSBԠN SZSSADDHŠPP ADASYSHUN SZ ADASHN DBGҠGԠHŠABŠADDSS SPABɠBADAK? ADAM00YSSPAKADDSS NBNϯYSSPABŠADDSS SZMSPUNԠDN? MPSNϠHKNԠNY AƬAƠYSAŠAND ANDM3MASKUԠUN SABSAVŠNBҠUN SZƠNԠSYSUN ҠM00SԠSGN MPSԬɠUN MNP HDMHGNDSàNPUԠN DSKNPUԠDV HŠDSKɠSUBUNŠNSHŠNPUԠMHŠDSK. HSUNŠUSSAŠBUҠϠMAKŠHŠDSàAPPAҠϠHAV 6DSS. ANGSUN: ADSKADDSS BŠADDSS SBDSK UN:NNSƠAANDBAŠDSYD. DSKɠNP ŬASԠVNSҠADDSS SBDSKϠSAVŠŠADDSSҠMV DBUBU+GԠUBUҠADDSS PAUBUƠUSDSҠNUBU? MPDS0YS-GϠMV DBNBU+USDSҠNNBU? PANBUƠ? MPDS0YSGϠMV ASҠNԠNŠG ŠϠDV SBDSKDϠADHŠS DADMNDSԠϠSH ŬASҠN SANBUƠ DBNBU+GԠBUҠADDSS DS0DAN6SԠUNԠҠ6 SADSKԠDS SZƠDDS ADBP6ADD6ϠA̠BUҠADDSS DS03DABɠMVŠH SADSKϬ SZDSKϠ6 NBDS SZDSKԠϠH MPDS03USҠBU MPDSKɬɠUN HDMHGNDSàUPUԠN DSKUPUԠDV HŠDSKϠSUBUNŠNSA̠UPUԠϠH DS.ԠUSSAŠBUҠϠMAKŠHŠDSàAPPAҠϠHAVŠ6 DSS. ANGSUN: ADSKADDSS BŠADDSS SBDSK UN:NNSƠAANDBAŠDSYD. DSKϠNP SBDSKɠSAVŠŠADDSS DBDSKAGԠASԠMAؠADDSS MBNBSԠNGAND ADBASUBAԠMUNԠASS SSBSSƠìUNԠHGH SADSKAHNSԠMA. ŬASԠϠVNS PAUBUƠSAMŠASUNԠS? MPDS0YS-GϠMV AŠNϠ-SԠϠŠUNԠS SADSKASAVŠUSԠADDSS DAUBUƠGԠBUҠADDSSҠŠS DBUBU+GԠŠADDSSƠHŠS AŠAҠŠҠ SBDSKDŠHŠS DADSKAGԠHŠUSDS DBUBU+ANDA̠BUҠADDSS ŠSԠŠҠAD SBDSKDADHŠS DADSKASԠϠSHנԠSN ŬA SAUBUƠ DS0DBNBUƠƠUNԠŠBU PABSHŠAD BBUҠHN SBNBUƠSHנADBUҠMPY DBN6SԠUNҠ SBDSKԠ6DS DBUBU+GԠHŠA̠BUҠADDSS SZƠADDSSSDD ADBP66ϠHŠBUҠAN DS0DADSKɬɠMV SABɠH NB SZDSKɠϠH SZDSKԠA MPDS0BUҠAND MPDSKϬɠUN SPà3 UBUƠԠ DƠBUUUPUԠBUҠADDSS NBUƠԠ-NBUƠNŠAG(MPSSBũ DƠBUNNPUԠBUҠADDSS BUNBSSNPUԠBUҠҠDS BUUBSSUPUԠBUҠҠDS HDMHGNPAGŠNSANS SԠDSKAKAB DSԠSSUPHŠDSKAKABŠҠBHHŠSYSM ANDAUAYDSK.ԠUSSHŠDSGMNԠBUҠ PUNGUԠHŠAKABS. ԠASϠASHŠŠPԠAGSN HŠUPPҠNN-SYSMPNƠHŠSYSMSUBHANN ANGSUN: AN.USDAKS SBDS UN:NNSƠAANDBAŠDSYD. DSԠNP SABUƠSAVŠw@ƠUSDAKS DAADSŠSԠҠADDSSҠDV SANŠϠA̠UN DASDSS AƬA̠DSàDS A̠PҠAK MANANG. SABU+NBU+ DSűDABUƠGԠAK PADSZŠDN? MPDSŴYS-GϠDϠAUؠUN SBSԠNϠ-GDAK? PABUƠS MPDSŲYS-GϠMVŠŠP DAMSGNNϠ-SԠBAD DS3SBUDSԠAKASSGNMNԠAB SZBUƠSPAK MPDSűDϠNԠAK SPà DSŲDABU+GDAKSԠNGH SADMҠU̠AK DAMSGNS SANԱNZŠDAAMMAND DABUƠGԠAK DBM000USŠ000ҠBUҠADDSS AƬAƠAŠAKϠHGH ŬAҠAҠHŠ SBDSKDGϠAҠHŠŠPԠB DADS MANAHŠ SADMUN AAҠH SANԱNԠAG MPDS3GϠSԠDNAKASSGNMNԠAB SPà ADSŠDƠ+ҠUNŠADDSS MPDSKҠGϠϠNMA̠ҠUN SPà DSŴDADAUNGԠSZŠƠAUؠUN MANASZASSSԠNG.ƠZ MPDSԬɠ SABU+SAVŠUN DAAUHSԠAUؠUNԠN SSAƠNԠADSàNSAMŠHANN MPDSԬɠUN SASHSҠUNԠҠSԠUN DAM00SԠAGSϠS SABUƠUSSSҠUN DS5DABUƠGԠAK SBSԠSԠ PABUƠGD? ASSYS-SԠZ DAMSGNNϠ-SԠSGNNAKASSGNMNԠAB SBUDGϠSԠAK SZBUƠSPAK SZBU+SPUNԠ-DN MPDS5NϠ-DϠNԠAK MPDSԬɠYS- SPà3 SԠSAUNŠϠSԠADSPSNHŠADSP. ABŠNHŠDSàSDNԠBԠNSNAND USHHŠNA̠SҠMŠAԠHŠND GNAN. ANGSUN: DASPàBUҠADDSS..ADDSSƠHŠNNŠDS SBS UNGS.MANNGSS SԠNP SADSԠSAVŠHŠADDSSҠAB DBABԠGԠH AŠBԠM SBDSKDHŠDS DADSԠGԠHŠMADDSS DBASBUƠANDHŠϠADDSS SBMVנANDMVŠHŠDS Dà-9 DBABԠNנ AŠHŠB SBDSKDBAKϠHŠDS DAUBUƠUSH DBUBU+HŠNA̠BU AŠM SBDSKD MPSԬɠUN HDMHGNMMNɯϠDSàDV HŠDSKDSUBUNŠSHŠMANDSàNPUԯUPUԠDV. ԠSSUPHŠMPŠANSҠANDADSҠS DSSNHŠDS.ԠASUN̠HŠANS SMP.SAUSSDNŠAҠAHANSҠҠ PԠSHŠPAҠSASKDϠUNNHŠSH. ҠDVŠYNDҠSHŠVABŠҠҴ0S AKN.ҠNԠADYSHŠPAҠSND. ҠHҠSNSAŠMAD.ƠHŠҠS̠S AND: A-ƠHŠNԠAGSSԠԠϠNŠND B-SŠNYPAҠANDHA ADSàADDSS-6DSԠBASS- BDSàSAUS SPà3 ANGSUN ADSKADDSS-NA6DSҠBASS- BŠADDSS ŠҠAD Š0Ҡ UN-AAYSNMA--GS.MANNGSS SPà3 DSKDNP B̬BSťԠHŠADŠB SBMADDҠANDSAVŠHŠADDSS SADMNDDϠAKMAPPNG ANDMSAŠS SASԱSAV ҠDMNDSAŠHŠAK ŬASAHUNԠAGϠ AƬAƠAŠAKϠנA DBDSԱGԠADDSS SZSYSMSAHPAAMҠABŠ-SAH? ADBP3YS-ADDHŠϠGԠSAHPAAMS ADABɠADDSԠAKϠAVŠAK SAԣA0SAVŠABSUŠAK NBSPABŠADDSSϠADDSS DABɠASԠSKAG SAASKSԠADDSSƠASԠSKAG NBSPϠUNԠNUMBҠADDSS DBBɠGԠSUBHANN̠NUMBҠMAB ŬBBSUNԠNԠŠSHGHHADB SBUNԠSAVŠUNԠNUMB ADBM000SԠMMANDS DANԱADDNԠAGϠ ADABMMAND SAףMDANDSԠŠMMAND ADBM000AD SBңDMSԠAD ADBM000 SBSKàSK ASZŬSSƠŠ0 NASԠHAD DBSԱGԠS BSBSAUA̠S SBHADSAV ADBNSàSUBAԠNUMBҠNASD SSBSSƠPSV SBHADSԠS AMVŠNנHADB AƬAƠA ADAHADANDADDHŠS SAHADSAVŠHADSҠADDSS YDAN0SԠ0YUN SADN DSK6SƠSԠAGҠSAUS SBSAàGϠDϠSAUS ANDM00HKADYB SZAƠS MPNҠGϠ̠HŠMAN DAԣA0SԠAKϠA SBSKANDSKHŠD DBMADDҠSԠHŠŠADDSSϠB DAңDMSԠҠAD SSBSS? DAףMDAYS-SԠϠ DSK0àSԠUPMMAND DSK0ASNDMMAND DSK5SƠ0SԠҠ ŬSSBAD? DSK5Sà0àYSSԠҠAD DADSKDҠGԠDMAD A6ASSGNDMA àSԠҠADDSS BSNDADDSS DADMSԠNGHϠ- SàSԠҠNGH ASND Sà6àSAԠDMA DSK03SààSAԠDV à6 SBSAàGԠSAUS SASABSAV SASSƠK MPDSKDɠUN A̬ŬAAҠSGNB PAP9ŠPԠ? MPPMYS-GϠ̠HM PAP5DVŠYND? MPDSBMPGAM-- ANDM00SAŠADYB SZAADY? MPNҠNϠ-GϠ̠HM DAP0YS-YϠV SBSKSK0 AAND SBSKZ SZDNSPA̠ҠUN DAN0ANDN SZDNԠMŠHSPUN MPDSK6NԠNYԠGϠYAGAN DANԱ0MSNNԠPHAS? SZA MPNŬɠYSGϠϠNԠҠUN DSKҠDAҲSŠSND SBҠҠ DADMNDGԠDSKADDSS DBSABANDHŠSAUS HԠBPAUS MPYYAGANNSA SPà PMSBSPAŠŠPԠSHS DAP33 DBMS3Ơ-S SBDKYɠ̠HŠMANϠUNԠN HԠ3BAԠҠUNN MPYYAGAN. SPà NҠSBSPAŠDSàSNԠADY DAP DBMSSNDHŠDϠHŠMAN SBDKY DSK56A0GԠSAUSϠA HԠ33BPAUS MPYNSAԠY SPàoc DSBMDANԱ AƬAƠDVŠYND SAAGPANNPGSS MPDSKDɠGNҠҠANDUN DAҴ0SŠDVŠY̠SGA SBҠNԠVABŠ-SHUDNVҠHAPPN- SPà Ҵ0ASà0ҠD SPà SKNPSKUN DSK5A0SNDAK DSK5Sà0àSԠDAAϠSHנAKSND AƬAƠAKϠHGHA ADAUNԠADDHŠUNԠNUMB DBSKàGԠSKMMAND PAASKɠASASԠSKNHSUNԠϠSAMŠAK ADBMSGNYS-HANGŠϠADDSSMMAND SAASKɠSAVŠASԠSKADDSS DSK09àSԠUPMMANDHANN DSK0BSNDMMAND DSKSàà̠N DBHADGԠHADSҠADDSS DSK59SS0ADY? MPDSK59A DSK60B0SNDHADS DSK6Sà0àSA SBSAàGԠSAUS MPSKɠUN SPà SAàNPAԠANDSAUSUN DSK0SSAԠҠAG MPDSK0 SƠ6AҠDMA DSK05àAҠN DSK53Sà0àSԠDAA DAUNԠSAUS DSK0ASNDSAUSUS DSK0SààSA DSK5SS0AԠ MPDSK5SAUS DSK55A0GԠSAUSAND MPSAìɠUN SPà MADDҠNPMMYADDSSҠUNԠANS DMNDNPDSàADDSSҠUNԠANS DNԠNPҠUNԠҠUNԠANS SԱNP SABNP ASKNP NSàNP ףMDNP ҲASàPAYҠDAA MS3DƠ+ ASàUNƠDSàPԠ-PSSUN MSDƠ+ ASàADYDSàANDPSSUN G NDU ND TRNNT ! 92001-18017 1529 S C0122 RTE II SYS GEN DVR-PART 2 (FIXED HEAD DISC)             H0101 ASMB,R,L,C FH-RTGEN DRIVER SECTION. HED FH RTGEN DRIVER SECTION * NAME: FHDVR * SOURCE: 92001-18017 * RELOC: 92001-16017 * 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 FHGEN 92001-16017 REV 1529 DATE CODE 750630 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 FROM CORE D 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 * * 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 DSKAB OCT 4 INITIAL DISC ADDRESS FOR SYS CODE ASBUF DEF ASPBF+1 ADDRESS OF 9-WORD BUFFER IN BOOT ABOOT DEF START ADDRESS OF BOOTSTRAP LOADR LSAUX NOP LSSYS EQU *-1 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 SYSCH NOP SUBCHANNEL OF SYSTEM UNIT AUXCH NOP SUBCHANNEL OF AUX UNIT PTRAK NOP NUMBER OF PROTECTED TRACKS * DBP EQU * START OF DUMMY BASE PAGE DBPO EQU DBP DEFINE ENTRY POINT * INTMP BSS 1 TEMP FOR INITILIZATION ROUTINES * MES50 DEF *+1 ASC 7,START SCRATCH? MES40 DEF *+1 ASC 8,# SECTORS/TRACK? * HED FH RTGEN DRIVER SECTION INTERACTIVE CODE * * DSETU NOP ENTRY POINT FOR QUESTION SECESSION. 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 CHANNEL NUMBER * SPC 1 JSB SPACE ISYSC uLDA P14 SEND MESSAGE: LDB MESS1 SYS DISK SIZE? JSB READ GET ANSWER LDA N3 THREE DIGIT DECIMAL JSB DOCON GO CONVERT JMP ISYSC ERROR - TRY AGAIN * STA DSIZE SET SYSTEM SIZE SPC 1 JSB SPACE 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 DSIZE GET DISC 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 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 * JSB SPACE SET NO. PROTECTED PROTD LDA P14 LDB MES21 'NO. PROTECTED?' JSB READ PRINT MESSAGE, GET REPLY LDA N2 SET FOR 2 DIGIT DECIMAL INPUT JSB DOCON GET DIGITS JMP PROTD IF ERROR REPEAT * STA PTRAK SET NO. PROTECTED TRACKS * * JSB SPACE GET # SECTORS FOR SYSTEM DISC #SEC1 LDA P16 LDB MES40 '# SECTORS/TRACK?' JSB READ PRINT MESSAGE, READ REPLY LDA N3 SET FOR 3 DECIMAL DIGIT INPUT JSB DOCON GET DIGITS JMP #SEC1 IF ERROR REPEAT * STA SDS# SET # SECTORS FOR SYSTEM DISC * * GET AUXILIARY DISK SIZE JSB SPACE NEW LINE AUXDS LDA P14 LDB MES33 MES33 = ADDR: AUX DISK SIZE? JSB READ PRINT MESSAGE, GET READ LDA N3 SET FOR 3 DECIMAL DIGITS INPUT JSB DOCON GET DIGITS, RETURN OCTAL JMP AUXDS $ REPEAT INPUT * STA DAUXN SET AUXILIARY DISK SIZE SZA,RSS IF AUX. DISC NOT PRESENT, JMP DSETU,I SKIP # OF SECTORS INPUT. * * GET # SECTORS FOR AUX. DISC JSB SPACE NEW LINE #SEC2 LDA P16 LDB MES40 REPEAT JSB READ # SECTORS LDA N3 MESSAGE AND JSB DOCON INPUT. JMP #SEC2 STA ADS# SET # SECTORS OF SYSTEM DISC JMP DSETU,I RETURN TO MAIN GENERATOR * HED FH RTGEN DRIVER SECTION CONFIGURE DRIVERS AND BOOTSTRAPS PTBOT NOP * * CONFIGURE DISK I/O INSTRUCTIONS * LDA N5 LDB HPDSK GET HIGH PRIORITY ADDRESSES JSB STDSK SET HIGH PRIORITY CHANNEL NOS. * ISZ DCHNL SET DISK CHNL NO. TO L.P. * LDA N9 JSB STDSK SET LOW PRIORITY DISK ADDRESSES * CLA DSK5 OTA 0 SET DISK ADDRESS = 0,0 DSK6 LIA 0 GET STATUS WORD AND P4 ISOLATE PROTECT BIT SZA SKIP - TRACK IS PROTECTED JMP PTB1 * JSB SPACE NEW LINE LDA P33 LDB MES32 MES32 = ADDR: TURN OFF DISK ETC. JSB DRKEY,I PRINT: TURN OFF DISK PROTECT HLT 32B WAIT FOR OPERATOR JMP DSK6 REPEAT CHECK * PTB1 LDA ASPBF GET ADDRESS OF BOOTSTRAP BUFFER AND M1777 ISOLATE PAGE BITS STA B LDA LWASM GET LWA SYSTEM MEMORY AND M0760 ISOLATE PAGE NUMBER STA TBUF SAVE PAGE NO. OF BOOTSTRAP LDR IOR B SET A = NEW BUFFER ADDRESS STA ASPBF SET BUFFER ADDR IN BOOTSTRAP LDA SDS# SET # OF SECTORS -1 FOR ADA N1 SYSTEM DISC IN STA #SECT BOOTSTRAP LOADER. CPA M177 IF 128 SECTORS/TRACK JSB FS128 MAKE A FAST BOOT CMA,INA AND M177 CONSTRUCT AND SET UPDATE TRACK STA #MASK # WITH SECTOR 0 VALUE. CLA,INA SET -,DISK ADDRESS = 0,1 LDB ABOOT GET ADDRESS OF BOOTSTRAP JSB DISKO OUTPUT BOOTSTRAP TO 0,1 * CLA SET DISK ADDRESS = 0,0 LDB ADBUF GET ADDRESS OF DBUF JSB DISKI READ DISK 0,0 LDB ADBUF GET ADDRESS OF DBUF ADB P3 ADJUST FOR 4TH WORD IN 0,0 LDA B,I GET WORD 4 OF 0,0 (BASIC ENT PT) STA DMS SET BASIC ENTRY PT. IN NEW LDR LDA B1600 GET PAGE OFFSET OF BOOTSTRAP IOR TBUF ADD PAGE NO. STA RT/TS SET RT LOADER ENTRY PT. IN LDR CLA SET DISK ADDRESS = 0,0 LDB BLODR GET ADDRESS OF 0,0 BOOTSTRAP JSB DISKO PUT OUT 0,0 BOOT JMP PTBOT,I RETURN TO MAIN * * FS128 NOP FAST BOOT ROUTINE LDB JMPST THIS ROUTINE STB ADP64 MODIFIES THE BOOT LDB JMPPL TO LOAD THE WHOLE AREA IF STB LDAB THE CONTROLER SUPPORTS END OF JMP FS128,I TRACK SWITCHING (IT DOES IF 128 SECT/TR) * BLODR DEF RLOAD ADDRESS OF 0,0 LOADER DCHNL NOP DISC CHANNEL WDCNT NOP TEMP 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 WDCNT SAVE NO. OF INSTRUCTIONS 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 WDCNT SKIP - ALL INSTRUCTIONS CONFIG. JMP *-6 CONFIGURE NEXT INSTRUCTION JMP STDSK,I RETURN SPC 3 B1600 OCT 1600 MESS1 DEF *+1 ASC 7,SYS DISC SIZE? MESS2 DEF *+1 ASC 7,FH DISC CHNL? MES21 DEF *+1 ASC 7,NO. PROTECTED? MES32 DEF *+1 ASC 17,TURN OFF DISC PROTECT - PRESS RUN MES33 DEF *+1 ASC 7,AUX DISC SIZE? * * HPDSK DEF *+1,I HIGH PRIORITY CHANNEL NOS. DEF LINKG DEF DMAC DEF DSK3 DEF DSK8 DEF DSKB * LOW PRIORITY CHANNEL NOS. DEF DSK2 DEF DSK4 DEF DSK5 DEF DSK6 DEF DSK7 DEF DSK9 DEF DSKAG DEF DSKC HED FH RTGEN DRIVER SECTION** TRACK 0, SECTOR 0 BOOTSTRAP ** * ADBUF DEF *+1 BSS 64 BUFFER TO PUSH BOOT 0,0 AROUND IN BSS BEGIN+1000B-* MAKE CODE EASY TO READ * THE FOLLOWING IS THE FORMAT FOR THE PORTION OF THE * BOOTSTRAP LOADER TO BE SET IN 0,0. THIS SECTION OF THE * BOOTSTRAP IS LOADED INTO 2 TO 77B BY THE PROTECTED BINARY * LOADER. WHEN IT IS READ COMPLETELY INTO CORE IT CHECKS FOR * READ PARITY ERRORS DURING ITS INPUT. FOLLOWING THIS A HALT * INSTRUCTION PERMITS THE OPERATOR TO PROTECT THE BASIC * BINARY LOADER AND SET SWITCH 0 OF THE SWITCH REGISTER * TO 0 (EITHER REAL TIME EXECUTIVE OR TIME-SHARED BASIC) * OR 1 (DISC MONITOR SYSTEM). PRESSING 'RUN' READS THE * SELECTED SYSTEM LOADER FROM 0,1 OR 0,2 RESPECTIVELY. THIS * PORTION OF THE BOOTSTRAP OPERATION WILL THEN LOAD INTO * CORE THE SELECTED SYSTEM AND TRANSFER CONTROL TO IT. * BSBSO EQU * * RLOAD OCT 0,0 DON'T USE (A) AND (B) RT/TS OCT 0 REAL TIME EXEC/TIME-SHARED BASIC DMS OCT 0 HLT 4,C IN CASE OF POWER FAIL * BSLD0 STA BSLD2-BSBSO+1 CHANGE IRRECOVERABLE HLT 0 ISZ BSLD2-BSBSO INTO RECOVERABLE HLT 1 HLT 77B PROTECT BBL, SET SWR FOR SYSTEM LDA LINKG-BSBSO SET UP DISC/DMA OTA 6 LINKAGE * BSLD1 LIA 1 SELECT SYSTEM LOADER CLB,INB FROM SWITCH REGISTER: SLA SWR = 0 IMPLIES SECTOR 1 INB SWR = 1 IMPLIES SECTOR 2 DSK7 OTB 0 OUTPUT DISC ADDRESS CCE,INB SAVE LDA 1,I CHOSEN LOADER'S STA CORAD-BSBSO ENTRY POINT RAL,ERA OUTPUT 'READ' FORM CLC 2 OF LOADER'S OTA 2 CORE ADDRESS LDA .N64-BSBSO OUTPUT STC 2 TRANSFER OTA 2 LENGTH STC 6,C START DMA DSK8 STC 0 START DISC TRANSFER JSB TSTAT-BSBSO VALIDATE READ JMP CORAD-BSBSO,I TRANSFER TO SYSTEM LOADER * TSTAT DEF BSLD0-BSBSO (INITIAL EXIT) DSK9 LIA 0 WAIT FOR SLA TRANSFER JMP *-BSBSO-2 COMPLETION AND BSB32-BSBSO TRANSFER SZA,RSS OK? JMP TSTAT-BSBSO,I YES BSLD2 HLT 0 NO (HLT 1, NOP AFTER CHECK JMP *-BSBSO-1 JMP BSLD1-BSBSO RETRY LOAD * CORAD OCT 0 SYSTEM LOADER ENTRY ADDRESS LINKG OCT 20000 DISC/DMA LINKAGE TEMPLATE BSB32 OCT 32 TRANSFER VALIDATION MASK .N64 DEC -64 * BSS 77B-*+BSBSO PUT JUMP IN LOCATION 77B * JMP DSK9-BSBSO TEST BOOTSTRAP LOAD SPC 2 BSS BEGIN+1600B-* SKIP TO 1600B TO AVOID PROBLEMS WITH * 'O EQU START-1600B' HED FH RTGEN DRIVER SECTION ** TRACK 0, SECTOR 1 BOOTSTRAP** * * THE FOLLOWING LOADER PERMITS LOADING OF THE RESIDENT PORTIONS * OF THE REAL TIME MONITOR. THE LOADER IS LOCATED ON SECTOR 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 * IS ALWAYS ENTERED TO * * INITIALIZE A SYSTEM OR USER REQUEST TO * * ANY 264X SUBSYSTEM. * ****************************************** * * REV.1805 FIXES SPURIOUS INTERRUPT PROBLEM AFTER * REV.1806 FIXED T BIT ON KEYBOARD ENTRY * POWER UP. ALSO CHANGED WRITE T.O. TO 3.5 SEC * * REV. 1913 FIXED INTERMITTENT HANGUP PROBLEM * THIS CHANGE USES EXTENDED COMM. CARD * REV. 1926 FIXED "TERST" RE-ENTRANT PROBLEM * IFN NAM DVR05 92001-16028 REV. CODE 1926 4-27-79 XIF * L, IFZ NAM DVR05 92001-16027 REV.1926 4-27-79 XIF ENT I.05,C.05 EXT $LIST,$OPSY I.05 NOP STA TEM12 SAVE SELECT CODE CLB STB TEMP5 SET I.05 C.05 POINTER.DO NOT MOVE JSB SETIO OR Y O U ' L L L O S E CLB DO NOT MOVE THIS BEFORE "SETIO" !!!!! STB EQT20,I "DO'NT SAY I DID'NT TELL YOU SO!!!" * ** DVA ** SFS01 SFS CARD IF FLAG SET THEN POWER FAIL JMP I.055 FLAG NOT SET I.054 JSB XMIT SET UP TO CLR INTERRUPT LDA BN5 CLR ALL CARD INTERRUPTS I.053 JSB OUT2 (0-377) CPA BN7 IS THIS ALL? JMP I.055 YES! FINISHED INA JMP I.053 DO IT AGAIN I.055 LDA EQT16,I FOR BINARY CTU READ AND BN1 CLR SELECTED BITS STA EQT16,I BIT 0 (0\1=TERM.STAT. READ NO\YES) * * * LDA EQT17,I GET THE SCHEDULE FLAG. SZA IS IT DEFINED? JMP I.051 YES, CONTINUE LDA TEM12 SET UP SCHEDULE FLAG . ADA B.6 INDEX INTO INTERRUPT TABLE ADA INTBA GET SCHEDULE WORD.IF WORD NEG. LDB A,I THEN ID SEG. OF PROG. TO SCHED. CMB,SSB,INB CHANGE SIGN OF WORD. CCB NO PROG. TO BE SCHED. (INT. POINTS TO EQT) STB EQT17,I SAVE FOR FURTURE REFERENCE. LDB EQT1 SET EQT ADDRESS IN INTERRUPT STB A,I TABLE LDA EQT4,I SET THE "I WILL HANDLE IOR BN4 TIME OUT" BIT IN STA EQT4,I EQT4.RESTORE WORD. JMP I.054 GO CLEAR ALL SPECIAL INTERRUPTS * * ***************************************************** * "B.X" IS NEG. BINARY NO., "D.X" IS NEG. DECIMAL NO* * "BN" IS SOME BINARY NO. * * SEE BELOW. * ***************************************************** * BN1 OCT 137767 BN4 OCT 10000 BN7 OCT 60377 BN5 OCT 60000 BN70 OCT 173777 * B.6 OCT M177772 B100 OCT 100 * * TEM13 NOP CARD STATUS ON INTERRUPT TEM12 NOP SELECT CODE * * I.051 JSB CDINT * IFZ * SWH1A NOP SWITCH CRT \CTU ,LP= RSS\NOP * JMP I.251 YES! A CTU OR LP REQUEST XIF LDA TEMP4 GET REQUEST TYPE RAR THIS IS A CRT REQUEST SSA,SLA JMP I.05C THIS IS A CONTROL REQUEST. ** DVA ** LDA TEMP4 GET REQUEST TYPE SLA,RSS JMP I.05W THIS IS A WRITE REQUEST JMP I.05R THIS IS A READ REQUEST * ****************************************************************** * SUBROUTINE INITIALIZES THE COMPLETION SECTION * * FOR ALL COMPLETION INTERRUPTS. * * ****************************************************************** * * C.05 NOP ISZ TEMP5 SET CONT. FLAG JSB SETIO CONFIGURE IO ** DVA ** CLC01 CLC CARD GET CARD STATUS LIA01 LIA CARD STA TEM13 STORE CARD STATUS AND B40 CHECK FOR BUFFER OVERFLOW ** DVA SZA HAS IT OVER FLOWED? ** JMP EOOP9 HARD OVERFLOW (B=3,XMISSON ERROR) *** LDA TEM13 CHECK FOR BREAK INT. TO AVOID AND B100 SPURIOUS INT. AFTER POWERUP SZA JMP EXIT5 THIS IS A BREAK INT. *** LDA EQT1,I GET QUE WORD SZA IS A REQUEST IN PROCESS? JMP *+4 YES! JSB SCHED NO REQUEST IN PROCESS JSB SETEM SET FOR ANOTHER INTERRUPT JMP EXIT5 LDA EQT4,I ALF CHECK FOR TIME OUT ENTRY SSA IS THIS TIME OUT (BIT 11) ? JMP TIMOT YES! LDB EQT11,I GET INTERRUPT ADDRESS JMP B,I GOTO IT * ********************************************* * IS CALLED FOR ALL TIMEOUT * * PROCESSING * ********************************,z************* * ** DVA TIMOT JSB CDINT REINITIALIZE IO CARD JSB SETEM GO ENABLE CONSOLE *** LDA B4 LDB TEM10 GET DEVICE TYPE. IF CRT/GRAPHICS ADB B.60 DO NOT DOWN SZB,RSS CLA CRT JMP C.05,I *** * ***************************************************** * IS CALLED WHENEVER AN INTERRUPT OCCURS AND* * NO PROGRAM IS SCHEDULED (I.E. USER HITS A KEY TO * * GET THE SYSTEM'S ATTENTION * ***************************************************** * * SCHED NOP JSB CLRCD GET CHAR. OFF CARD CLA STA EQT15,I SET T.O. TO 0 LDB EQT1 IS THIS THE SYSTEM CONSOLE? CPB SYSTY JMP OPFLG YES! GO SET OPERATOR FLAG LDB EQT17,I GET TERMINAL ID ADD. LDA EQT28,I IS TERMINAL ENABLED? RAR,SLA SSB YES! IT IS ENABLED JMP SCHED,I IT IS NOT STB TEMP1 *** LDB EQT4 GET ADDRESS OF THIS TERMINAL'S EQT4 STB TEM7 JSB $LIST GO SCHEDULE IF POSSIBLE OCT 601 SCHEDULE PARAMAETER TEMP1 NOP TEM7 NOP JMP SCHED,I RETURN *** OPFLG ISZ OPATN SET OPER. ATTN. FLAG JMP SCHED,I EXIT * ************************************************* * DOES CONTROL REQUEST PROCESSING FOR * * THE KEYBOARD\DISPLAY. * ************************************************* * *******TERMINAL STATUS****************************** * BIT STATUS * * 1 TERMIAL ENABLED * * 5 "CONTROL D" ENTERED * * 7 BUFFER FLUSH ENABLED * * * **************************************************** * * *******CRT CONTROL********************************** * EXEC CODE CRT CONTROL REQUEST * * 11 SPACE nLINES * 20 ENABEL TERMINAL * * 21 DISABLE TERMINAL * * 22 SET TIME OUT * * 23 SET BUFFER FLUSH * * 24 REMOVE BUFFER FLUSH * * 25 UPDATE TERM. STATUS * * **************************************************** * I.05C LDA EQT6,I GET CONTROL WORD LSR 6 SHIFT LDB EQT7,I SSB,RSS CMB,INB COMPLEMENT OPTIONAL PARAMETER AND B37 ISOLATE CON TROL PARAMETER * CPA B11 JMP CN11 GO SPACE LINES CPA B20 JMP CN20 GO ENABLE TERMINAL CPA B21 JMP CN21 GO DISABLE TERMINAL CPA B22 JMP CN22 GO SET TIME OUT CPA B23 JMP CN23 GO SET BUFFER FLUSH CPA B24 JMP CN24 GO REMOVE BUFFER FLUSH *** CPA B25 GET TERMINAL STATUS JMP CN25 *** ********************REJECT REQUEST****************** CLA JMP IOR19 ** * * B11 OCT 11 LF OCT 12 B37 OCT 37 B20 OCT 20 B21 OCT 21 B22 OCT 22 B23 OCT 23 B24 OCT 24 B25 OCT 25 B2 OCT 2 B.3 OCT 177775 B200 OCT 200 B17 OCT 17 B70 OCT 70 BN73 OCT 77776 BN68 OCT 163777 B.60 OCT -60 * **SPACE LINES***** **MAX NO. IS 55** * CN11 SZB,RSS CHECK FOR 0 VALUE CCB CHANGE TO -1 STB EQT7,I ADB B70 MAX NO. OF (CR,LF'S) IS 55 SSB BECAUSE CARD BUFFER IS 128 JMP REJ2 JSB CDINT MASTER RESET JSB EORP OUTPUT (CR,LF) JSB EXIT1 !!!!!!!!!!!!!!!!! JSB ENAK GIVE TERM. TIME TO PROCESS ISZ EQT7,I JMP *-5 * CN11B CLA STA EQT19,I SET A REG. EXIT JMP EOOP4 JMP EOOP4 DVA * * * **GO ENABLE TERMINAL(BIT 1 OF EQT 19)** * CN20 LDA EQT17,I IF -1 THEN NO PROG. TO SCHED. еB@< INA,SZA OR "0" INTO EQT28 IF NO PROG. LDA B2 SET BIT 1 (TERM. ENABLED) IOR19 IOR EQT28,I CONSTRUCT NEW STATUS WORD ST19 STA TEM8 STA EQT28,I RESTORE JSB STPUT PUT IT IN EQT5 JMP REJ2 GO EXIT A=2 * **GO DISABLE TERMINAL** * CN21 LDA B.3 AND19 AND EQT28,I REMOVE BIT 1 JMP ST19 * **GO SET NEW TIME OUT** * CN22 STB EQT14,I B REG. HAS NEW TIME OUT.STORE IT. JMP REJ2 * **GO SET BUFFER FLUSH (BIT 7 OF EQT28)** * B*^^^^ FIRST LINE OF TAPE 2 ^^^^** CN23 LDA B200 SET BIT7 IN EQT28 JMP IOR19 * **GO REMOVE BUFFER FLUSH** * CN24 LDA BN27 REMOVE BIT 7 JMP AND19 * *** UPDATE TERMINAL STATUS * CN25 LDA EQT16,I AND BN73 CLEAR BIT0 AND 15 STA EQT16,I JSB TERST GET STATUS JMP CN11B *** ** DVA ** * **********EQT6 FOR READ\WRITE***************** * * EQT6 FOR READ\WRITE OPERATIONS IS: * * BIT MEANING * * 6 0\1 IS ASCII\BINARY * * 8 0\1 IS OFF\ON ECHO * * 10 0\1 OFF\ON HONEST MODE * * 9 AND 10 SET USER ENABLED BLOCK READ * * ********************************************** * * I.05W CLB,RSS SETUP EQT9(RUNNING CHAR. ADD.) AND I05W1 NOP EQT 10 (LAST CHAR. ADD.) LDA EQT7,I GET BUFFER STARTING ADDRESS RAL,CLE MULTIPLY S.A. BY TWO STA EQT9,I STORE AT EQT9 LDA EQT8,I GET BUFFER LENGTH CMA,SSA,INA,RSS COMPLEMENT,ARE THEY CHAR.? JMP I.W1 YES! CMA,INA MAKE POS AGAIN RAL MULTIPLY WORDS X 2 AND * I.W1 ADA EQT9,I STA EQT10,I STORE LAST CHAR. ADD. AT EQT10,I CMA,INA MAKE LAST CHAR. ADD. NEG. ADA EQT9,I - NO. OF CHAR. ARE NOW IN A REG. SZB JMP I05W1,I SZA,RSS IS IT 0 ? JMP I.W32 YES! IT IS ZERO * *** LDA TEM11 IS THIS GRAPHICS? CPA B3 SUBCHANNEL 3 JSB GRAPH *** JSB TRAN1 GOTO OUTPUT SUBROUTINE * LDA TEMP2 IS THIS HONEST MODE? SZA,RSS * I.W32 JSB EORP THIS IS NOT HONEST JSB EXIT1 JSB ENAK JMP EOOP2 ABOVE NEEDED FOR INTERRUPT * * ********************************************** * WRITES TO THE DISPLAY,CTU AND PRINTER. * STARTING ADDRESS OF DATA IS EQT9,I * * "TEMP1" COUNTS THE NUMBER OF CHAR. IN ONE * * TRANSMISSION AND IS USED TO LIMIT THE TIME * * IN THE DRIVER FOR A SINGLE INTERRUPT. * * IF BUFFER IS NOT EMPTIED IN 1 CALL TO WE* * WILL WAIT FOR A BUFFER EMPTY INTERRUPT AND * * COMPLETE THE TRANSMISSION. * ************************************************** * * TRAN1 NOP LDA TRAN1 SAVE RETURN ADDRESS STA EQT19,I TRAN4 JSB XMIT SET CARD FOR XMIT LDB BN2 SET FOR 33 CHAR.MAX STB TEMP1 IN ONE TRANSMISSION * TRAN2 LDB EQT9,I GET BUFFER ADDRESS X 2 CLE,ERB DIVIDE BY TWO TO GET TRUE ADD. * LDA B,I GET WORD SEZ,RSS DO WE WANT UPPER OR LOWER CHAR.? ALF,ALF UPPER! SHIFT TO LOWER AND B377 LOWER! MASK WORD * IFZ SWH1B NOP CRT\CTU=RSS\NOP JMP TRAN3 YES! IGNORE BELOW CHECKS XIF * * LDB FILL DO NOT SEND "ESC" TO CRT ON SZB BINARY WRITE. JMP ON1 CPA ESC IS THIS AN ESCAPE? JMP OUT6B * ON1 CLB,INB SET B REG TO 1 ADB EQT9,I ADD 1 TO EQT9 CPB EQT10,I IS THIS THE LAST WORD? RSS JMP OTA18 NO! CONTINUE LDB TEMP2 IS THIS HONEST? SZB JMP OTA18 THIS IS HONEST,IGNORE UNDERSCORE CPA B137 IS THIS A "_" UNDERSCORE? JMP EOOP8 YES! GO TO END OF OUTPUT PROCESSING JMP OTA18 TRAN3 LDB FILL IS THIS BINARY? SZB,RSS JMP OTA18 THIS IS BINARY,OUTPUT CHARACTER CPA CR IS IT A ? RSS CPA LF IS IT A LINEFEED? RSS IT IS A CPA RS IS IT A JMP TRAN5 YES,TERMINATE ON OROR * OTA18 OTA CARD OUT6B ISZ EQT9,I INCREMENT CHAR. COUNT LDB EQT9,I GET CURRENT CHAR. ADD.R CPB EQT10,I HAVE WE SENT LAST WORD? JMP TRAN5 THIS IS THE LAST CHARACTER ISZ TEMP1 OINCREMENT CHAR. COUNT. JMP TRAN2 WE HAVE NOT SENT 33 CHAR. JSB EXIT1 WE HAVE SENT 33 CHAR. *** LDA FILL CHECK FOR BINARY SZA JSB ENAK IT IS NOT JSB CDINT !!!!!! *** JMP TRAN4 NOW THAT CARD BUFFER IS EMPTY,RESTART TRAN5 LDA EQT19,I GET RETURN ADDRESS JMP A,I RETURN * * *************************************************** * DOES KEYBOARD READ. IF FIRST CHARACTER * * A "DC2" THE DRIVER EXPECTS A BLOCK TRANSFER AND * * WILL SEND A DC1 TO TRIGGER IT. IF THE FIRST * * CHAR. IS NOT A "DC2" THE DRIVER ASSUMES A CHAR. * * TRANSFER. *************************************************** * * I.05R CLB,INB JSB I05W1 GO SETUP EQT9 AND EQT10 JSB TERST GO CHECK TERMINAL STATUS LDA EQT6,I CHECK IF ECHO SET AND B400 ISOLATE BIT 8 (SET ECHO) RAR,RAR MOVE TO BIT 4 RAR,RAR JSB ECHO SET/CLR = 20/0 ECHO JSB SPCH1 SET CR AND RS INT. LDB BN9 SET RUBOUT INT. JSB CDSET LDB BN40 SET CONTROL "D" INT. JSB CDSET LDA EQT6,I CHECK FOR USER ENABLED BLOCK READ AND B3000 BITS 9,10 WILL BE SET CPA B3000 JMP C05R3 THIS IS ENABLED BLOCK READ JSB DC1OT ENABLE TRANSFER CLB,INB JSB CDSET SET CARD FOR RECEIVE,CHAR.MODE JSB EXIT1 WAIT FOR INTERRUPT * JSB CHRIN GET CHARACTER CPA B22 IS IT A DC2? JMP C05R3 FIRST CHAR. IS A DC2 * * *******THIS IS A CHARACTER TRANSFER********* * * LDA TEMP2 IS THIS HONEST? SZA JSB CLRNT CLB LDA FILL IF BINARY KEYBOARD SET FOR CHAR. REC. SZA,RSS INB IT IS BINARY KEYBOARD JSB CDSET SET BLOCK OR CHAR RECEIVE (B=0\1) LDB BN2 SET CHAR. PROCESS COUNT. FOR 33 CHAR. STB TEM9 FOR ONE INTERRUPT. JMP CHPR8 * * CLRNT NOP LDB BN56 CLR. RUBOUT INT. JSB CDSET LDB B412 CLR. CONTROL "D" INT. JSB CDSET JMP CLRNT,I * B6 OCT 6 RS OCT 36 B377 OCT 377 B137 OCT 137 CR OCT 15 BN9 OCT 57712 BN10 OCT 40000 BN13 OCT 140000 BN40 OCT 40412 B177 OCT 177 B4 OCT 4 B1400 OCT 1400 B3000 OCT 3000 B1512 OCT 1512 B3612 OCT 3612 BN56 OCT 17712 B412 OCT 412 * * ***********THIS IS A BLOCK TRANSFER********* * * C05R3 LDA EQT16,I THIS IS A BLOCK TRANSFER IOR BN10 SET BIT 14 =0/1 CHAR/BLK STA EQT16,I RESTORE SSA IS TERMINAL LINE STRAPPED? JMP C05R4 NO! IT IS PAGE STRAPPED * LDA EQT6,I CHECK FOR USER ENABLED BLOCK READ AND B3000 CPA B3000 JMP C05R5 *** LDA TEM14 GET CHAR. COUNT +1 AND B1400 IF 3 CR HAS ARRIVED CPA B1400 RSS JSB EXIT1 WAIT FOR CR JSB CHRIN GET CR *** JMP C05R5 * C05R4 LDB B1512 REMOVE CR INT. FOR PAGE (RS ONLY) JSB CDSET STRAP AND BLOCK MODE JMP C05R6 * * * WAS ADDED FOR THE 2645 * C05R8 LDB CHPC2 STB EQT11,I SAVE RETURN ADDRESS LDB FILL IF BINARY CLR ALL INTERRUPTS LDA BN20 IF ASCII DO NOT CLR SPEC. CHAR. INTERRUPT SZB LDA BN30 DO NOT CLR. SPEC. CHAR. INT. JSB OUT2 JMP STC04 * * C05R5 LDB B3612 REMOVE "RS" INT. ("CR" ONLY FOR LINE) JSB CDSET FOR ASCII CTU, LINE STRAP AND BLOCK * C05R6 JSB CLRNT CLA JSB ECHO TURN OFF ECHO JSB DC1OT TRIGGER TRANSFER C05R7 JSB EXIT1 AND WAIT FOR INTERRUPT * * ********************************************** * PROCESSES DATA ON KEYBOARD AND CTU * * READ REQUESTS. "TEM9" COUNTS THE NUMBER * * OF CHARACTERS WE HAVE PROCESSED AND IS USED* * TO LIMIT THE TIME WE ARE IN THE DRIVER. * * FOR ASCII READS THE EOR IS DETECTED BY * * LOOKING FOR THE SPECIAL CHAR. BIT SET ON * * THE 12966 CARD. * FOR BINARY EOR IS DETECTED BY THE CHAR. * * COUNT READ FROM THE TAPE. * ********************************************** * * CHPRC LDA BN2 SET CHARACTER PROCESS. COUNT TO -33 STA TEM9 CHPCC JSB CHRIN GET CHARACTER ** LDB TEM14 GET COMPLETE DATA WORD CPB B400 IF BUFFER EMPTY WAIT FOR MORE DATA JMP C05R8 SSB,RSS IF NON VALID WAIT FOR MORE JMP C05R8 ** CHPR8 LDB FILL SZB,RSS IS THIS BINARY? JMP CHPR9 YES,THIS IS BINARY * ********THIS IS ASCII******* * * * LDA TEM14 GET DATA WORD AND BN10 ISOLATE SPEC. CHAR. BIT SZA,RSS IS IT SPECIAL? JMP CHPR2 NO * IFZ SWH1C NOP SWITCH NOP\RSS =CTU\CRT JMP EOOP5 THIS IS CTU ASCII TRANSFER XIF LDA EQT16,I GET TERMINAL STATUS AND BN13 ISOLATE PAGE(15) AND BLK(14) CPA BN13 ARE THEY BOTH SET? JMP EOOP2 YES,TERMINATE REQUEST LDA TEMP8 GET CHARACTER CPA B177 IS IT A RUBOUT? JMP RUB01 YES! GO PROCESS RUBOUT CPA B4 IS IT A CONTROL "D" (SET EOT) JMP CNTLD YES! GO SET EOT CHP9 JSB CDINT !!!!!!!!!!! JSB EORP FOR CHAR. OR LINE STRAP BLK REQUES !!!!!!! JMP EOOP1 FIRST SEND * * CHPR2 LDA EQT16,I * ** DVA IFZ SWH1D NOP CRT\CTU=RSS\NOP JMP CHPR9 THIS IS CTU XIF AND BN10 CHECK FOR BLOCK\CHAR. XFER SZA JMP CHPRA THIS IS BLOCK ** * THIS IS CHAR. XFER LDA TEMP2 IS THIS HONEST MODE? SZA JMP CHPR9 THIS IS HONEST MODE LDA TEMP8 GET CHARACTER JMP LINFD CHAR. TRANSFER AND NOT HONEST ******************************************** * IS CALLED IF RUBOUT INTERRUPT IS * * DETECTED. IT DELETES THE CURRENT RECORD * * =AND OUTPUTS (/,CR,LF). * ******************************************** * * RUB01 JSB CDINT !!!!!!!!!!!!!!! LDA B134 JSB OUT1 SEND A "\" JSB EORP GO OUTPUT JSB EXIT1 EXIT WAITING FOR BUFFER EMPTY INTERRUPT JMP I.051 RE START INPUT * LINFD CPA LF IS THIS A LINEFEED? JMP CHPRC YES,GO GET NEXT CHARACTER CPA CR IS THIS A CR ? JMP CHP9 YES! IT IS A CR,EXIT CPA B4 IS FIRST CHAR. A CONTROL "D" ? JMP CNTLD YES! * CPA B10 IS THIS A BACKSPACE RSS RSS JMP CHPR9 NO! CONTINUE LDA EQT7,I GET STARTING ADDRESS OF BUFFER RAL MULTIPLY BY 2 CPA EQT9,I ARE WE AT STARTING ADDRESS? JMP RUB01 YES! PROCESS AS RUBOUT CCB ADB EQT9,I DECREMENT CURRENT ADDRESS STB EQT9,I CLE,ERB DIVIDE BY TWO TO GET TRUE ADDRESS LDA B,I GET ADDRESS IS A REG. AND BN31 MASK HIGH END ADA FILL ADD ASCII FILL CHARACTER STA B,I RESTORE JMP CHPR6 GO GET NEXT CHARACTER * * TEMP2 NOP HONEST MODE =2000 TEMP8 NOP ASCII DATA WORD TEMP9 NOP CARD STATUS FILL NOP BINARY\ASCII = 0\40 TEM9 NOP CHAR COUNT TEM14 NOP COMPLETE DATA WORD B134 OCT 134 BN30 OCT 50037 B40 OCT 40 B60 OCT 60 OENCE OCT 10000 BN2 OCT 177737 * CNTLD LDA B40 SET BIT 5 (EOT) IOR EQT28,I IN TERMINAL STATUS STA TEM8 CLA STA EQT19,I SET AREG. EXIT JMP EOOP4 GO SET B REG. TO 0 AND EXIT * * *** *** CHPRA LDA TEMP8 ** CPA B37 REMOVE "US" RSS CPA RS REMOVE "RS" JMP CHPR6 CHPR9 LDB EQT9,I GET CURRENT CHAR. ADD. CPB EQT10,I IS BUFFER FULL? JMP CHPR6 YES BUFFER FULL LDA TEMP8 GET CHARACTER LDB EQT9,I GET CHARACTER ADDRESS ISZ EQT9,I INCREMENT CLE,ERB CONVERT TO WORD ADDRESS. SEZ,RSS IF E=0 THEN EVEN AND ALF,SLA,ALF HENCE SHIFT CHAR. TO UPPER 8.SKIP XOR B,I IF ODD ADDRESS XOR WITH CHAR. XOR FILL XOR FILL TO ADD FILL IF EVEN STA B,I REPLACE FULL WORD LDB EQT9,I IS THIS THE LAST WORD? CPB EQT10,I RSS YES IT IS JMP *+5 LDA FILL IF BINARY KEYBOARD REQUEST AND BUFFER ADA TEM10 FULL THEN EXIT CPA B60 JMP EOOP2 YES! EXIT ** ** CHPR6 ISZ EQT20,I INCREMENT RECORD LENGTH COUNT.FOR RSS CTU BINARY READ ONLY. *** JMP CHPR5 THIS IS ALL FOR BINARY READ *** ISZ TEM9 INCREMENT BUFFER COUNT JMP CHPCC IF NOT ZERO GET ANOTHER CHAR. LDB CHPC2 SETUP INTERRUPT RETURN STB EQT11,I STF01 STF CARD SET FLAG FOR IMMEDIATE INTERRUPT JMP EXIT4 THIS IS ALL WE CAN PROCESS,EXIT * CHPC2 DEF CHPRC * CHPR5 LDA OENCE KILL CE INTERRUPT IFZ JSB OUT2 JMP EOOP5 *************************************************** * DOES CTU AND PRINTER REQUEST PROCESSING * *************************************************** * * * * DVA * I.251 LDA TEMP4 RAR SSA,SLA JMP I.25C THIS IS CTU OR LP A CONTROL REQUEST SSA JMP I.25R THIS IS CTU A READ REQUEST * *********CTU OR PRINTER WRITE REQUEST********** * CLB,INB JSB I05W1 GO SET EQT9 AND EQT10 LDB FILL SZA IS CHARACTER COUNT ZERO? JMP I25W6 NO! IT IS NOT ZERO SZB,RSS IS IT BINARY JMP REJ1 EXIT WITH A=1 I25W6 SZB IF BINARY MAX LENGTH IS D 256 JMP *+3 FOR ASCII MAX LENTH IS D 254 (NEDED CR,LF) ADA B400 RSS ADA D254 THIS IS ASCII SSA LESS THAN 254 CHARACTERS JMP REJ1 IT IS NOT,THEREFOR4E EXIT * * JSB CTPRP GO PREP. TERMINAL FOR TRANSFER LDA B144 JSB OUT1 OUTPUT LDA FILL GET FILL CHARACTER SZA IS IT BINARY? JMP I25W2 NO! THIS IS ASCII * ***********CTU BINARY WRITE******** * LDA EQT8,I GET BUFFER LENGTH SSA,RSS IF WORDS MULTIPLY X2 RAL SSA IF CHARACTERS (-) MAKE POS. CMA,INA JSB BINAS GO CONVERT TO ASCII AND SEND * * I25W2 LDA B127 OUTPUT TO INITIALIZE CTU TRANSFER JSB OUT1 * JSB EXIT1 GO EXIT AND WAIT FOR INTERRUPT * LDA FILL IS THIS BINARY SZA,RSS JSB ENAK THIS IS BINARY,GO HANDSHAKE JSB CDINT LDB EQT8,I GET WORD COUNT SZB IS IT ZERO?(ASCII ONLY,BINARY CHECKED * JSB TRAN1 ALREADY).IT IS NOT ZERO LDA FILL GET FILL CHAR. SZA IS IT BINARY JSB EORP NO! THIS IS ASCII,WRITE A "CR,LF" I25W5 JSB EXIT1 &&&&FOR INTERRUPT JSB CDINT JSB SPCH1 JSB DC1OT GO TRIGGER STATUS REPORT JSB EXIT1 WAIT FOR INTERRUT * * JSB CHRIN GET STATUS CHARACTER * STA TEM7 JSB CLRCD GET THE "CR" LDA TEM7 CPA B106 FAILURE? JMP I25W7 YES CLA RSS I25W7 LDA B10 SET BIT 3 IN EQT5 FOR PRINT FAIL LDB TEM10 IS THIS A PRINTER? CPB B64 JMP EOOP6 THIS IS A PRINTER JMP EOOP7 THIS IS A CTU * * D254 DEC 254 B144 OCT 144 B127 OCT 127 B163 OCT 163 B122 OCT 122 B62 OCT 62 B106 OCT 106 * * ***********THIS IS A CTU READ REQUEST******** * * CONTROL CODE FUNCTION I.25R LDB TEM10 IF READ FROM PRINTER REJECT CPB B64 JMP REJ1 LDB EQT8,I GET BUFFER LENGTH SZB,RSS IS IT ZERO? JMP CN3C YES --GO SKIP ONE RECORD CLB,INB NO!, IT IS NOT ZERxO JSB I05W1 GO SET UP EQT9,EQT10 JSB CTPRP GO PREP. TERM. FOR CTU TRANSFER LDA B163 STA TEMP2 SET HONEST FLAG I25R1 JSB OUT1 OUTPUT LDA FILL IS THIS BINARY? SZA,RSS IS THIS BINARY? JMP I25R2 YES! THIS IS BINARY I25R3 LDA B122 OUTPUT JSB OUT1 JSB EXIT1 * * THIS IS ASCII JSB SPCH1 SET AND INTERRUPTS JMP C05R6 GO TRIGGER TRANSFER FOR ASCII * * ****THIS IS BINARY READ***** * I25R2 LDA B62 OUTPUT <2> I25R6 JSB OUT1 LDA B122 OUTPUT JSB OUT1 JSB EXIT1 #### JSB CDINT #### JSB SPCH1 SET FOR INTERRUPT JSB DC1OT TRIGGER BYTE COUNT JSB EXIT1 EXIT AND WAIT FOR INTERRUPT * LDA B.4 INITIALIZE TO READ 4 BYTES STA TEM9 CLA I25R5 ALF SHIFT UP STA TEMP1 AND STORE JSB CHRIN GET CHARACTER CPA RS IS IT A" RS"? JMP EOOP5 YES,THIS IS ALL AND B17 ISOLATE DATA IOR TEMP1 "OR" WITH LAST BYTE ISZ TEM9 IS THIS ALL?? JMP I25R5 NO! GET NEXT BYTE CMA,INA THIS IS ALL,COMPLEMENT STA EQT20,I STORE BINARY RECORD LENGTH. JSB CLRCD JSB CDINT !!!!!!!!!!!!!! JSB DC1OT TRIGGER TRANSFER ** DVA * I25R7 LDA ENCE ENABLE RING INTERRUPT JSB OUT2 FOR BINARY EOR DETECTION JMP C05R7 * * * ***************************************************** * * * * * PRINTER * * 11 SPACE

    LINES IF OPTIONAL * * PARAM (+) OR PAGE EJECT IF * * OPTIONAL PARAM (-). * PAGE EJECT 9871 ONLY ***************************************************** * <*^^^^^ FIRST LINE OF TAPE 3^^^^^** I.25C LDA EQT28,I GET TERMINAL STATUS ALF,ALF IS BUFFER FLUSH SET? SSA JMP REJ4 YES IT IS,EXIT * LDA EQT6,I GET CONTROL WORD LSR 6 SHIFT RIGHT 6 PLACES AND B37 ISOLATE BITS <0-4> STA EQT10,I STORE FOR LATER USE LDB TEM10 GET DEVICE TYPE CPB B64 IS IT A LP? JMP CN28C YES! IT IS A LP CPA B1 IS IT EOF? JMP CN1C YES! CPA B2 IS IT BACKSPACE RECORD? JMP CN50C YES! CPA B3 FORWARD SPACE? JMP CN3C YES! CPA B4 REWIND? JMP CN4C YES! CPA B6 DYNAMIC STATUS JMP CN6C YES CPA B5 REWIND? JMP CN4C YES! CPA B10 GENERATE LEADER(EOF) JMP CN10C CPA B13 FORWARD SPACE 1 FILE? JMP CN13C YES! CPA B14 BACKSPACE FILE? JMP CN50C YES! CPA B26 WRITE EOV? JMP CN26C YES! CPA B27 LOCATE FILE

    OR SPACE

    LINES IF OPTIONAL * * PARAM (+) OR PAGE EJECT IF * * OPTIONAL PARAM (-). * PAGE EJECT 9871 ONLY ***************************************************** * I.25C LDA EQT28,I GET TERMINAL STATUS ALF,ALF IS BUFFER FLUSH SET? SSA JMP REJ4 YES IT IS,EXIT * LDA EQT6,I GET CONTROL WORD LSR 6 SHIFT RIGHT 6 PLACES AND B37 ISOLATE BITS <0-4> STA EQT10,I STORE FOR LATER USE LDB TEM10 GET DEVICE TYPE GCPB B64 IS IT A LP? JMP CN28C YES! IT IS A LP CPA B1 IS IT EOF? JMP CN1C YES! CPA B2 IS IT BACKSPACE RECORD? JMP CN50C YES! CPA B3 FORWARD SPACE? JMP CN3C YES! CPA B4 REWIND? JMP CN4C YES! CPA B6 DYNAMIC STATUS JMP CN6C YES CPA B5 REWIND? JMP CN4C YES! CPA B10 GENERATE LEADER(EOF) JMP CN10C CPA B13 FORWARD SPACE 1 FILE? JMP CN13C YES! CPA B14 BACKSPACE FILE? JMP CN50C YES! CPA B26 WRITE EOV? JMP CN26C YES! CPA B27 LOCATE FILE

    OR SPACE

    LINES JMP CN27C YES * **************ILLEGAL CONTROL REQUEST************* * * JMP REJ2 * B1 OCT 1 B13 OCT 13 B14 OCT 14 B26 OCT 26 B27 OCT 27 B65 OCT 65 B55 OCT 55 B160 OCT 160 B66 OCT 66 B103 OCT 103 ENCE OCT 10004 B300 OCT 300 * ******BACKSPACE 1 OR 2 RECORDS****** * BSR1 NOP BACKSPACE 1 LDB B61 GET ASCII <1> LDA BSR1 JMP OVER1 BSR2 NOP BACKSPACE 2 LDA BSR2 LDB B62 GET ASCII <2> OVER1 STA EQT8,I STORE RETURN ADD. STB EQT9,I SAVE 1 OR 2 LDA B55 SEND ASCII (-) JSB OUT4 LDA EQT9,I RETREIVE BS NUMBER JSB OUT1 LDA B160 SEND JSB OUT1 LDA B70 SEND JMP OUT5 * *********WRITE EOF************* * CN1C LDA B65 WRITE END OF FILE JSB OUT4 OUTPUT JMP OUT3 * ***********FORWARD SPACE RECORD************** * FSR1 NOP LDA FSR1 SAVE RETURN ADD. RSS CN3C CLA STA EQT8,I LDA B3 SET CONTROL REQUEST STA TEMP4 BECAUSE MAY GET HERE FROM READ 0 ADA B300 SET FOR FORWARD RECORD IOR EQT6,I ALSO SET IN CONWD BECAUSE WILL EXIT =STA EQT6,I LDA B160 JSB OUT4 CN3C1 LDA B61 OUTPUT JMP OUT5 **********REWIND*************** CN4C JSB CTPRP JMP OUT3 REWIND * **********DYNAMIC STATUS***************** CN6C JSB CTUST GET CTU STATUS STA B LDA TEM11 GET DEVICE TYPE (OCTAL) RAL AND EQT16,I TEST EOF FLAG FOR DEVICE SZA ADB B200 EOF FLAG IS SET. SET IN EQT5 STB TEM8 CLA SET FOR GOOD RETURN STA EQT19,I JMP EOOP3 * * *********LEADER AND TOP OF FORM********** * FOR THIS REQUEST DRIVER WRITES A EOF * * IF IT DID NOT JUST DO SO,OR TAPE IS * * NOT AT LOAD POINT * ***************************************** * CN10C JSB CTUST GET STATUS AND B300 SZA,RSS DID WE JUST WRITE A EOF OR AT LP? JMP CN1C NO! GO WRITE IT JMP EOOP4 YES,DO NOT WRITE TWO IN A ROW * **********FORWARD SPACE 1 FILE ************ * CN13C LDA B62 OUTPUT JSB OUT4 JMP OUT3 * ************BACKSPACE 1 FILE ************* * BSF1 NOP LDA BSF1 STA EQT8,I LDA B55 OUTPUT JSB OUT4 LDA B61 OUTPUT JSB OUT1 LDA B160 OUTPUT JSB OUT1 LDA B62 OUTPUT JMP OUT5 * ********WRITE END OF VALID DATA (EOV) * CN26C LDA B66 OUTPUT JSB OUT4 JMP OUT3 * *******LOCATE ABSOLUTE FILE (CTU)********* *****************OR*********************** *******SPACE LINES (PRINTER)************** * CN28C LDA EQT10,I GET CONTROL REQUEST CPA B11 IS IT T.0.F. OR SPACE LINES? RSS JMP REJ2 ONLY LEGAL CONTROL TO PRINTER IS 11B CN27C JSB CTPRP PREP. TERM. FOR CTU REQUEST LDA EQT7,I GET FILE NO. SZA,RSS IF ZERO CHANGE TO 1 INA JSB BINAS CONVERT TO ASCII AND SEND LDA B160  OUTPUT JSB OUT1 LDB TEM10 GET DEVICE TYPE CPB B64 IS IT LP? RSS YES A LP JMP CN27D LDB EQT7,I GET OPTIONAL PARAM. IF (-) THEN T.O.F. SSB,RSS IF (+) THEN SPACE (EQT7) LINES. JMP CN3C1 GO OUTPUT CN27D LDA B62 OUTPUT * OUT5 JSB OUT1 OUT3 LDA B103 OUTPUT JSB OUT1 JSB NXQU JMP I25W5 GO WAIT FOR REQUEST COMPLETION OUT4 NOP LDB OUT4 SAVE RETURN ADDRESS STB EQT19,I JSB CTPRP JSB OUT1 LDA EQT19,I JMP A,I * *********BACKSPACE FILE AND RECORD******** * * BACKSPACE FILE AND RECORD REQUIRES SPECIAL PROCESSING * * TO POSITION AND SET STATUS AS A MAG. TAPE UNIT. THIS * * SPECIAL PROCESSING ENABLES THE USE OF EXISTING MTU * * SUBROUTINES. IF THE TAPE IS POSITIONED AFTER AN EOF THEN* * IT WILL MOVE BEFORE THE EOF AND A FLAG SET IN EQT16 * * (BIT3/BIT2 =RIGHT CTU/LEFT CTU) WHICH IS EXAMINED BY * * A DYNAMIC STATUS REQUEST. THESE SPECIAL EOF FLAGS ARE * * NECESSARY BECAUSE THE 264X DOES NOT RETURN EOF STATUS * * BEFORE THE EOF MARK. * * *********************************************************** * * * CN50C LDA EQT16,I SET CN50C ENTRY FLAG IOR B10 BIT3 STA EQT16,I LDB RSS SET CN50C FLAG STB EOOP7 JSB BSR1 ISSUE BACKSPACE 1 RECORD JSB CTUST GET STATUS STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB WE ARE THERE LDA TEM8 NOT AT L.P. AND B200 IF WE ARE AFTER EOF THE BIT 7 SET SZA,RSS JMP CN54C TAPE NOT AFTER EOF CN55C JSB BSR2 ISSUE BACKSPACE 2 RECORDS JSB CTUST IF AT EOF AGAIN WE ARE AFTER ANOTHER EOF STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB LDA TEM8 AND B200 AND HENCE NO FORWARD S4NLHPACE SZA DO NOT SET EQT16 EOF FLAG IF JMP EOOPB BETWEEN EOF'S JSB FSR1 FORWARD ONE TO GET US BEFORE EOF * * LDA TEM11 GET DEVICE TYPE RAL FOR SETTING EOF FLAG IN EQT16 IOR EQT16,I BIT1/BIT2=EOF LCTU/EOF RCTU AND BN55 REMOVE CN50C FLAG STA EQT16,I RESTORE IT JSB CTUST GET STATUS IOR B200 ADD EOF BIT STA TEM8 JMP EOOPA * * CN54C LDA EQT10,I TAPE NOT AFTER EOF CPA B2 IS THIS A BS RECORD? JMP EOOPB YES JSB FSR1 GET TAPE TO ORIGINAL POSITION JSB CDINT RESET JSB BSF1 BS FILE TO GET US AFTER EOF JSB CDINT RESET JMP CN55C NOW POSITION BEFORE EOF * *** GRAPH NOP LDA ESC FOR 26XX GRAPHICS SEND ESC,*,(SMALL) L JSB OUT1 LDA B52 JSB OUT2 SEND * JSB OUT1 LDA B154 SEND SMALL "L" JSB OUT1 JMP GRAPH,I *** ** DVA P.ERR NOP LDA EQT28,I SEE IF WE HAVE BEEN AND B10 HERE BEFORE SZA JMP P.ERR,I WE HAVE! LDA B10 SET PARITY ERR IN STATUS `#N IOR EQT28,I STA EQT28,I JMP P.ERR,I * * LINCK NOP CHECK MODEM STATUS LINE SWH2A NOP HARD\MODEM =NOP\RSS JMP LINCK,I HARDWIRE IMMED. COMPLET. LDB EQT1 CHECK FOR SYSTEM CONSOLE CPB SYSTY IF IS CANNOT DOWN JMP LINK2 LINK1 JSB CHRIN GET LINE STATUS LDA TEMP9 AND B32 CHECK FOR CLEAR TO SEND ("CB"),DATA CARRIER DETECT("DF") CPA B32 AND DATA SET READY("CC") JMP LINCK,I EVERYTHING O.K. IOR BN69 SET INTERRUPT REF. JSB OUT2 LDA BN71 ENDABLE STATUS CHANGE INTERRUPT STA EQT20,I SET $UPIO FLAG JSB OUT2 LDA B20 SET DATA SET NOT READY IOR EQT28,I STA EQT28,I STA TEM8 ..ALSO SAVE FOR STATUS UPDATE *2013* LDA EQT4,I TALKING TO KBD/DISP SUBCHANNEL?? *2013* LSR 6 *2013* AND B37 MASK *2013* SZA,RSS WELL?? *2013* JSB STPUT SUBCH. 0: UPDATE STATUS *2013* LDA TEMP5 CHECK FOR INIT. OR CONT. ENTRY SZA JMP NR CONT. ENTRY REJ3 LDA B3 SET NOT READY TO RTE * JMP IA05,I NR CLA,INA JMP CA05,I SET FOR NOT READY * LINK2 LDA TEM10 CHECK FOR CRT CPA B60 JMP LINCK,I IT IS A SYSTEM CONSOLE CRT JMP LINK1 IT IS NOT THE CRT ** RECIV NOP LDB B5 SET CARD UP FOR RECEIVE,CHAR. JSB CDSET CLA JSB ECHO TURN OFF ECHO STC05 STC CARD ENABLE INTERRUPT JMP RECIV,I **************************************************** * SUBROUTINE READS 1 CHARACTER FROM IO CARD* * AND PLACES IT IN A REG. * * BOARD STATUS IS ALSO READ * * TEMP8=DATA * * TEMP9=BOARD STATUS * * **************************************************** * CHRIN NOP STC02 STC CARD PUT CARD IN DATA MODE LIA03 LIA CARD GET DATA WORD STA TEM14 STORE COMPLETE DATA WORD AT TEM14 AND B377 ISOLATE DATA CHAR.(0-7) STA TEMP8 STORE IT CLC02 CLC CARD PUT CARD IN STATUS MODE LIA02 LIA CARD GET STATUS WORD STA TEMP9 STORE IT LDA TEMP8 RESTORE DATA WORD STC03 STC CARD THIS IS NECESSARY JMP CHRIN,I INTERRUPT * * * *********************************************** * SUBROUTINE TRIGGERS BLOCK TRANSFERS * * FROM THE CPU. THIS IS DONE BY SENDING A * * DC1 TO TRIGGER THE TRANSFER AND * * THEN SETTING UP CARD TO RECEIVE DATA. * * SEE WARNING AT ENAK *********************************************** * DC1OT NOP LDA B21 JSB OUT1 LDA D.60 WAIT FOR DC1 TO RIPPLE THRU FIFO JSB TIMER 150 USECS ON XE(SPEC 64 MAX) LDB B4 JSB CDSET SET RECEIVE MODE JMP DC1OT,I RETURN * B5 OCT 5 B154 OCT 154 BN55 OCT 177767 BN20 OCT 50077 B10 OCT 10 BN17 OCT 40040 B400 OCT 400 BN19 OCT 30003 BN21 OCT 50000 BN69 OCT 20000 DVA05 BN71 OCT 10032 D.60 DEC -60 * * * ****************************************************** * SUBROUTINE SETS UP THE IO CARD PER B REG. * * 1/0 IS CHARACTER/BLOCK * * 1/0 IS TRANSMIT/RECEIVE * * 1/0 IS CLEAR/NOT CLEAR INTERUPT FLAGS * * 1/0 SPECIAL CHARACTER IS/IS NOT TO BE * * ADDED OR DELETED.SPECIAL CHARACTER IS IN POSITION * * . 1/0 IS ADD/DELETE * * SPECIAL CHARACTER. * ****************************************************** * CDSET NOP LDA BN4 SET WORD1 IN A REG. SLB,BRS IOR B40 "OR" CHARACTER MODE BIT JSB OUT2 LDA BN17 SET WORD4 IN A REG(SET SBA) SLB,BRuS IOR B400 "OR" TRANSMIT BIT JSB OUT2 LDA BN21 SET WORD5 IN A REG. SLB,BRS IOR B177 "OR" CLEAR INTERRUPTS JSB OUT2 LDA BN5 SET WORD6 IN A REG. SLB,RSS JMP OUT BRS,BRS BRS IOR B "OR" SPECIAL CHARACTER JSB OUT2 OUT JMP CDSET,I * * * ECHO NOP SET ECHO ON CARD PER A REG. IOR BN19 A =20/0 IS ECHO ON\OFF JSB OUT2 JMP ECHO,I * *************************************************** * SUBROUTINE INITIALIZES 12966 * * IO CARD. * * BELOW ARE THE INITIAL CONDITIONS FOR CONTROL: * * WORD 0 DO NOT SEND * * WORD 1 DO NOT SEND * * WORD 2 CE=1 STATUS REF. IS 0 * * WORD 3 CHARACTER FRAME CONTROL * * CHAR. SIZE=8 BITS * * NO PARITY * * ECHO ON (CRT REQUEST ONLY) * * ONE STOP BIT * * * WORD 4 INTERFACE CONTROL * * EXT. CLOCK * * DMA CONTROL OFF * * SBA/SCA ON * * CD (DATA TERM. READY) OFF * *N CA (REQUEST TO SEND) OFF * * TRANSMIT MODE ON * * MASTER RESET * MASTER RESET * * WORD 5 CLEAR CARD INTERRUPTS * * * WORD 6 SPECIAL CHARACTER * * * * ALL USED SPECIAL CHARACTERS (EXCEPT * * RUBOUT) ARE CLEARD * * * *************************************************** * * CDINT NOP * LDA BN19 SET A REG. = 30003  LDB TEM10 GET DEVICE TYPE ADB TEMP4 ADD REQEST TYPE CPB B61 IS IT A CRT READ IOR B20 YES! TURN ON ECHO JSB OUT2 IT IS OFF FOR CTU AND LP * LDA BN17 ** DVA IOR BN72 OR MASTER RESET AND XMIT JSB OUT2 SEND WORD 140XXX * LDA BN20 SEND WORD 50077 JSB OUT2 * LDA BN22 JSB OUT2 SEND 20004 * LDA BN25 SET A REG. = 60004 JSB OUT2 CPA BN26 CLEAR ALL USED SPECIAL INTERRUPTS JMP CDINT,I (4 THRU 36) INA JMP *-4 * * BN22 OCT 20004 B61 OCT 61 BN72 OCT 100400 DVA BN25 OCT 60004 BN26 OCT 60036 BN27 OCT 177577 ESC OCT 33 B136 OCT 136 B.4 OCT 177774 * * FOR ALL WRITE REQUESTS AND CTU CONTROL * THE BUFFER FLUSH BIT IS EXAMINED.IF SET ************************************************** * IS CALLED BY ALL WRITE AND CONTROL * * REQUESTS IF THE BUFFER FLUSH BIT IS SET. * ************************************************** * *** NXQU NOP IF LAST REQUEST IN QUE THEN STOP FLUSH LDA $OPSY GET SYSTEM TYPE CPA BN55 CHECK FOR -9 RSS CPA D.13 CHECK FOR -13 JMP GTDMS THIS IS A DMS SYSTEM * OLDSY LDA EQT1,I CHECK FOR LAST REQUEST LDA A,I CHECK SZA IF NOT LAST REQUEST DO NOT CLR BIT7. JMP NXQU,I THIS IS NOT THE LAST REQUEST. LDA EQT28,I LAST REQUEST AND BN27 REMOVE B177 STA EQT28,I RESTORE EQT5 JMP NXQU,I AND RETURN * GTDMS RSA CHECK MAP. IF SYSTEM NO CROSS LOAD ALF,SLA BIT12= 0\1 =SYSTEM\USER RSS JMP OLDSY SYSTEM MAP XLA EQT1,I USER MAP CROSS LOAD XLA A,I JMP CHECK *** * ********************************************* * SUBROUTINE READS TERMINAL STATUS * * AND SETS EQT16 FOR : * * LINE STRAP\PAGE STRAP 0\1 (BIT1^5) * * TERM. STATUS READ 0\1 NO\YES (BIT 0) * ********************************************* * TERST NOP LDA TERST DVAO5 STA EQT27,I LDA EQT16,I GET TERMINAL STATUS TO SEE IF IT SLA HAS ALREADY BEEN READ JMP TERST,I IT HAS. RETURN. CLA JSB ECHO TURN ECHO OFF JSB SPCH1 SET SPECIAL INTERRUPTS LDA ESC OUTPUT ESCAPE JSB OUT1 LDA B136 OUTPUT CARROT. THESE TWO CHARACTERS JSB OUT1 PREP. TERM. FOR STATUS JSB EXIT1 EXIT AND WAIT FOR BUFFER EMPTY INTERRUPT * JSB DC1OT GO TRIGGER STATUS TRANSMISSION WITH DC1 JSB EXIT1 AND WAIT FOR CR OR RS INTERRUPT * LDA B20 JSB ECHO TURN ECHO ON LDA B.4 SET TO GET BYTE 1 STA TEMP1 JSB CHRIN GO GET CHAR..IT IS NECESARY TO READ AND B10 ISZ TEMP1 ESC AND \ BEFORE JMP *-3 READING DESIRED STATUS BYTE. RAR,RAR RAR,RAR MOVE TO SIGN POS. (LINE\PAGE =0\1) INA SET LSB FOR COMPLETED IOR EQT16,I STA EQT16,I JSB CLRCD GO CLEAR CARD LDA EQT27,I JMP A,I * ************************************************* * SUBROUTINE OUTPUTS AN ENK TO TERMINAL * * AND WAITS FOR AN ACK. * * BE CAREFUL IN CALLING ENAK BECAUSE YOU MUST * * DO A MASTER RESET TO GET CHAR. COUNT =0 * * OTHERWISE YOU WILL NEVER SEE A BUFFER * * EMPTY INTERRUPT AGAIN!!! * * THIS CODE CHANGED 1913 * ************************************************* * ENAK NOP CLA INHIBIT ECHO JSB ECHO LDA ENAK STA EQT23,I SAVE RETURN ADDRESS JSB LINCK CHECK MODEM STATUS LINES SWH2C NOP MODEM=RSS JMP OVR15 HARDWIRE JSB XMIT JMP OVR16 OVR15 LDA CLRSB INHIBIT HARDWIRE TERM. JSB OUT2B OVR16 LDA B5 OUTPUT ENK TO TERMINAL OTA20 OTA CARD LDA D.60 !!!!!!!!!!!!!!!!!!! JSB TIMER !!!!!!!!!!!!!!!!!! LDB B5 CLEAR INTERRUPTS AND SET CARD TO RECEIVE JSB CDSET *1913,TER. CAN'T SEND TILL CARD IN REC. JSB EXIT1 EXIT TO WAIT FOR INTERRUPTS JSB CHRIN GET CHARACTER TO EMPTY CARD * LDA EQT23,I GET RETURN ADDRESS JMP A,I RETURN * CLRSB OCT 40400 * TIMER NOP 2.5 USEC TIMER(XE) PER LOOP SSA,INA,RSS !!!!!!!!!!!!!!! JMP TIMER,I !!!!!!!!!!!!! JMP *-2 !!!!!!!!!!!!!!!!! * * ************************************************ * SUBROUTINE READS THE CTU STATUS * * * *SET BIT0--UNIT BUSY OR CARTRIDGE NOT INSERTED* * BIT1--END OF VALID DATA * * BIT2--CARTRIDGE NOT WRITE ENABLED * *-------------- * BIT3--LAST COMMAND ABORTED * * BIT4--READ\WRITE ERROR * * BIT5--END OF TAPE * * ----------- * BIT6--LOAD POINT * * BIT7--END OF FILE * * * * THE CTU STATUS COMES IN THREE BYTES * * * BYTE * 1 EOF - LP - EOT - WR. ERR(2645) * 2 CMD.AB.- W.P. - RD.ERR. -BUSY(2645) * 3 RD.ERR. - RD.ERR.(HARD) - EOD -C.I. ************************************************ * CTUST NOP JSB CDINT !!!!!!!!!!!!!!! LDA CTUST STA EQT24,I * JSB CTPRP GO PREP. TERMINAL FOR CTU TRANSFER LDA B136 OUTPUT <^> JSB OUT1 JSB EXIT1 !!!!!!!!!!!!!!!!! JSB SPCH1 SET CR AND RS AS SPECIAL CHAR. JSB DC1OT TRIGGER TRANSFER WITH DC1 JSB EXIT1 EXIT WAITING FOR CR OR RS INTERRUPT * JSB CHRIN GET DATA CTUS3 LDB B.5 INITIALIZE STATUS COUNT m STB TEMP1 RSS * * CTUS1 JSB CHRIN GET CHARACTER ISZ TEMP1 ARE THESE STATUS BYTES? JMP CTUS1 NO! GO GET NEXT CHAR. AND B17 ALF STA TEMP1 JSB CHRIN GET STATUS BYTE NO. 2 AND CR ISOLATE BITS 0,2,3 IOR TEMP1 "OR" BYTE 1 WITH BYTE 2 STA TEMP1 STORE IT TEMPORARILY JSB CHRIN GET BYTE 3 AND B4 CHECK FOR READ ERROR RAL,RAL MOVE TO BIT 4 IOR TEMP1 STA B LDA TEMP8 GET BYTE 3 AND B3 ISOLATE FIRST TWO BITS (WEN AND EOV) XOR B1 COMPL. C.I. IOR B OR WITH BYTES 1 AND2 XOR B10 COMPLEMENT BIT 3 AND B377 ISOLATE STATUS BITS STA TEMP1 JSB CDINT LDA TEMP1 * JSB CLRCD GO CLEAR CARD LDB EQT24,I SAVE RETURN ADDRESS JMP B,I * CTPRP NOP THIS SUBROUTINE PREPARES TERMINAL TO ACCEPT LDB CTPRP SAVE RETURN ADDRESS STB EQT25,I STA EQT22,I CTU CONTROL AND R\W REQUESTS LDA EQT16,I CHECK FOR KEYBOARD DISABLE BIT AND B20 (BIT4) SZA IF SET ALREADY DISABLED JMP OVER6 LDA ESC JSB OUT1 LDA B143 (SMALL "C") JSB OUT1 CLA JSB OUT1 CLA JSB OUT1 LDA B20 IOR EQT16,I SET KEYBOARD DISABLE BIT STA EQT16,I JSB EXIT1 JSB CDINT OVER6 LDA ESC JSB OUT1 OUTPUT LDA B46 JSB OUT1 OUTPUT <&> LDA B160 JSB OUT1 OUTPUT LDA TEM10 GET DEVICE JSB OUT1 LDA B165 LDB TEMP4 GET REQUEST TYPE CPB B3 IS IT CONTROL? JSB OUT1 YES, SEND LDA EQT22,I RESTORE A REG LDB EQT25,I GET RETURN ADDRESS JMP B,I * * * * * ************************************************ *SUBROUTIONE TAKES A NO. IN A REOjG. * * (<1000D) AND CONVERTS TO ASCII WITH MSB * * AT BUFF1 AND LSB AT BUFF3. * *THE CHARACTERS ARE SENT MSB FIRST * ************************************************ * BINAS NOP LDB BINAS SAVE RETURN ADDRESS STB EQT22,I SSA IS NUMBER OK? (POSITIVE) JMP BINAS,I NO! LDB BN50 LOAD B WITH DEC -1000 ADB A ADD NUMBER TO -1000 SSB,RSS IS SIGN ZERO? JMP BINAS,I YES! EXIT FOR NUMBER >999 LDB ADDRT GET BUFFER ENDING ADDRESS ADB B2 ADD 2 STB TEMP1 STORE IT AT TEMP1 BINA1 CLB DIV LF DIVIDE NO. IN A REG. BY 10 ADB B60 CONVERT TO ASCII STB TEMP1,I STORE IT. LDB TEMP1 GET NEXT ADDRESS ADB B.1 DECREMENT IT STB TEMP1 RESTORE IT SZA IS THE A REG.(QUOTIENT) =0 ? JMP BINA1 NO! GO DIVIDE A REG. AGAIN LDA ADDRT YES! IT IS ZERO ADA B.1 CPA TEMP1 ARE WE FINISHED? JMP BINA2 YES!NOW GO OUPUT CHAR. CLA NO,GO FILL REMAINING PLACES WITH JMP BINA1 ASCII <0> BINA2 LDB ADDRT GET MSD IN B REG. STB EQT19,I STORE IT FOR LATER USE LDA B.3 SETUP COUNTER STA EQT20,I I25W8 LDA B,I GET ASCII CHAR. IN A REG. JSB OUT1 GO SEND IT! ISZ EQT19,I INCREMENT ADDRESS POINTER LDB EQT19,I RESTORE IN B REG. FOR ISZ EQT20,I ISZ COUNT COUNTER JMP I25W8 THERE ARE MORE,GO GET 'EM LDA EQT22,I GET RETURN ADDRESS JMP A,I * ADDRT DEF BUFF1 BUFF1 BSS 3 B.5 OCT 177773 B46 OCT 46 B165 OCT 165 B143 OCT 143 * * BN11 OCT 43612 BN12 OCT 41512 * TEMP4 NOP REQUEST TYPE (1-3) TEMP5 NOP INIT\COMP. = 0\1 TEM8 NOP TEMP STATUS TEM10 NOP ASCII TYPE (6X) TEM11 NOP DEVICE TYPE IN BINARY * XMIT NOP SET CARD UP FOR XMIT LDA BN17 IOR B400 SET XMIT JSB OUT2 JMP XMIT,I * OUT1 NOP STA B JSB XMIT LDA B OTA02 OTA CARD SEND CHAR. JMP OUT1,I * OUT2 NOP GENERAL PURPOSE CARD PROGRAMMING OTA10 OTA CARD ROUTINE JMP OUT2,I * SPCH1 NOP THIS SUBROUTINE SETS SPECIAL CHAR. INTERRUPTS LDB BN12 JSB CDSET SET INTERRUPT LDB BN11 JSB CDSET SET INTERRUPTS JMP SPCH1,I RETURN * * USINT NOP SUBROUTINE TO TEST FOR USER KEYBOARD INTERRUPT LDA USINT SAVE RETURN ADDRESS STA EQT27,I JSB ENAK GO SHAKE HANDS WITH TERMINAL LDA TEMP8 GET CHAR. CPA B6 IS IT A "ACK" ? RSS YES! NO INTERRUPT JSB SCHED USER INTERRUPT JSB CLRCD GET ALL CHAR. OFF CARD LDA EQT27,I JMP A,I * *********************************************** * SUBROUTINE GETS DATA OF CARD UNTIL * * BUFFER EMPTY. * * *********************************************** * CLRCD NOP STA TEMP1 SAVE A REG. LDB B4 SET CARD TO RECEIVE AND CLR. INT. JSB CDSET CLRC1 JSB CHRIN GET CHARACTER LDA TEMP9 GET STATUS WORD ALF,ALF ISOLATE BUFFER EMPTY SSA IS IT EMPTY? JMP CLRC2 YES WE'RE FINISHED LDA TEM14 IS THIS A VALID CHARACTER? SSA JMP CLRC1 YES IT IS CLRC2 LDA TEMP1 RESTORE A REG. JMP CLRCD,I RETURN * B.1 OCT 177777 BN50 DEC -1000 * *********************************************** * ENABLES IO CARD INTERRUPT IF TERM. * * HAS BEEN ENABLED OR IF TERMINAL IS A * * SYSTEM CONSOLE. * *********************************************** * SETEM NOP SUBROUTINE TO SETUP IO CARD FOR RECEIVE CLC03 CLC CARD INHIBIT INTERRUPT LDA EQT28,I MODE PRIOR TO EXIT. GET TERM.STATUS RAR,SLA IS TERMINAL ENABLED? (BIT 1=1) JSB RECIV YES! IT IS LDA SYSTY GET CONSOLE EQT. CPA EQT1 IS THIS THE SYSTEM CONSOLE? JSB RECIV YES! IT IS JMP SETEM,I * *********************************************** * * * EXIT IS A=2 (ILLEGAL CONTROL REQUEST). * *********************************************** * * REJ2 JSB NXQU CHECK QUE JSB SETEM SETUP CARD FOR EXIT LDA B2 RSS REJ1 CLA,INA RSS REJ4 LDA B4 IMMEDIATE COMPLETION CLB JMP IA05,I * **************************************************** * IS USED FOR INITIATOR OPERATION WITH * * INITIATED EXITS (A=0), AND COMPLETION * * CONTINUATION EXITS (P+2). "TEMP5" INDICATES * * WHICH EXIT TO TAKE. * **************************************************** * EXIT1 NOP LDB EXIT1 GET CALLING PROGRAMS ADDRESS+1 STB EQT11,I STORE AT EQT11,I FOR INTERRUPT EXIT5 LDA BN20 CLEAR CARD INTERRUPTS JSB OUT2 STC04 STC CARD RE-INITIALIZE CARD FOR INTERRUPT LDB TEM10 CHECK FOR CRT CPB B60 JMP ON3 IT IS A CRT LDA BN68 NOT A CRT SET 60 SEC T.O. JMP ON2 ON3 LDA TIM1 IF READ USE PRESET T.O. LDB TEMP4 CHECK REQUEST TYPE CPB B2 IF A WRITE SET 4 SEC. T.0. ON2 STA EQT15,I EXIT4 CLA EXIT6 LDB TEMP5 GET INITIATION COMPLETION FLAG SZB,RSS JMP IA05,I INITIATION RETURN ISZ CA05 RETURN JMP CA05,I COMPLETION RETURN * EOOP9 LDB B3 SET B=3 FOR XMISSION ERROR STB EQT19,I A REG. EXIT JMP EOOP4 * ********************************************************* * DOES ASCII CTU AND DISPLAY WRITE EOR PROCESSING* ********************************************************* * * EORP NOP LDA } CR OUTPUT A JSB OUT1 LDA LF OUTPUT A JSB OUT1 JMP EORP,I * * ******************************************** * ENABLES KEYBOARD IF IT HAS BEEN * * LOCKED BY A CTU REQUEST * ******************************************** * KEYBD NOP LDA EQT16,I AND B20 IS IT LOCKED (BIT 4) SET SZA,RSS JMP KEYBD,I NO! LDA ESC UNLOCK KEYBOARD JSB OUT1 LDA B142 JSB OUT1 SEND SMALL B JSB EXIT1 WAIT FOR INTERRUPT JSB CDINT LDA EQT16,I AND BN3 REMOVE KEYBD LOCK BIT STA EQT16,I JMP KEYBD,I * EOOP7 NOP IF CN50C FLAG IS SET(BIT3,EQT16) JMP EOOPC THEN EOOP7 IS LDA EQT8,I IT IS SET JMP A,I * EOOP8 LDB TEMP1 THIS EXIT IS USED IF UNDERSCORE CPB BN2 IS ONLY CHAR. RSS * ********************************************************* * AND ARE ENTRIES FOR COMPLETION (P+1) * * EXITS. THE TERMINAL OR CTU STATUS IS TEMPORARLY PUT * * IN TEMP5. * ********************************************************* * EOOP1 JSB EXIT1 EOOP2 CLA STA EQT19,I SET A REG. EXIT LDA EQT28,I GET TERMINAL STATUS STA TEM8 JMP EOOP3 * EOOPC LDB TEMP4 IF CONTROL ALWAYS GET STATUS CPB B3 RSS SZA IF GOOD WRITE DO NOT GET STATUS EOOP5 JSB CTUST YES!,GO UPDATE CTU STATUS ** EOOP6 STA B LDA EQT28,I CHECK FOR CTU PARITY ERROR AND B10 SZA ADB B20 SET FOP ERROR STB TEM8 ** * EOOPB LDA BN55 REMOVE EOF FLAG IN EQT16 LDB TEM11 BECAUSE TAPE HAS MOVED RBL XOR B LDB EQT16,I AND B STA EQT16,I LDA TEM8 * ****************************************************** * A READ TO END OF TAPE WILL GIVE BELOW STATUS * d* STATUS * * 0 GOOD READ * * 40 END OF TAPE. GOOD RECORD READ * * 240 EOT+EOF. NO RECORD READ, * * SET FOR NR(A=1) EXIT * * 42 EOT+EOV * * 52 EOT+EOV+ABORT * * 52 EOT+EOV+ABORT * * * ****************************************************** * * ****************************************************** * A WRITE TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 42 EOT+EOV GOOD RECORD WRITTEN * * 52 EOT+EOV+ABORT (NO RECORD WRITTEN)* * SET ET(A=1) EXIT * * * ****************************************************** * ****************************************************** * READ TO EOV IN MIDDLE OF TAPE * * STATUS * * 200 EOF * * 2 EOV * * 12 EOV+ABORT * * SET NR(A=1) EXIT * * * * ****************************************************** * EOOPA AND B373 REMOVE WRITE PROTECT CPA B240 IF EOF+EOT THEN SET NR JMP OVER4 CPA B52 IF FAILURE ON WRITE JMP OVER4 DUE TO EOT DO THIS(SAVE REQ.) AND B30 CHECK FOR CMD ABORT OR ERROR SZA JMP OVER4 SET N.R. CLB STB EQT19,I SET A=0 FOR GOOD EXIT JMP EOOP3 OVER4 CLB,INB SET NR STB EQT19,I SET A REG. EXIT *********************************************************** * PNLH IS ENTRY FOR B=0 (TRANS. LOG =0) EXIT. * *********************************************************** * EOOP4 CLA STA EQT8,I SET UP FOR B REG. =0 EXIT * ********************************************************** * SETS 2640\2644 AND IO CARD FOR NEXT INTERRUPT * * OR REQUEST, AND SETS EITHER CTU OR CRT STATUS IN EQT5 * * * IT ALSO SETS THE TRANSMISSION LOG IN B REG. (+CHAR. OR * * + WORDS). IF EQT8 =0 (VIA EOOP4) THEN B=0. * ********************************************************** * EOOP3 JSB STPUT SET STATUS IN EQT5,I JSB CDINT !!!!!!!!!! JSB KEYBD ENABLE KEYBD IF LOCKED JSB USINT WITH KEYBOARD ENABLED JSB USINT JSB CLRNT CLR RUBOUT INTERRUPT JSB CLRCD GET ALL DATA OFF CARD JSB SETEM ** DVA CLB SET 0 XLOG LDA EQT28,I IF PARITY ERROR ON BLOCK INPUT AND B10 UPDATE XLOG SZA,RSS LDB EQT9,I GET 2X LAST CHAR. ADDRESS N CMB,INB MAKE NEG. ADB EQT7,I SUBTRACT TWO TIMES STARTING ADD. ADB EQT7,I CMB,INB LDA EQT8,I IF WORDS THEN DIV. BY 2 SSA JMP *+4 THESE ARE CHARACTERS SLB IS LSB SET? INB YES! INCREMENT SO EVEN FOR DIVIDE BRS DIVIDE TO CONVERT TO WORDS * SZA,RSS IF EQT8 IS 0 THEN CLEAR B REG. CLB LDA EQT19,I SET A REG. EXIT JMP CA05,I ** * * **************************************************** * INSERTS CORRECT DEVICE STATUS INTO EQT5 * **************************************************** STPUT NOP LDA EQT5,I GET CURRENT STATUS AND BN31 RE MOVE OLD STATUS IOR TEM8 OR NEW STATUS STA EQT5,I RESTORE IT JMP STPUT,I * * * TIM1 OCT 177200 BN62 OCT 40040 KEEP FOR DVA BN63 OCT 30002 """""""" BN57 OCT 14740 BN3 OCT 177757 BN37 OCT 102100 B373 OCT 373 B142 OCT 142 B240 OCT 240 B64 OCT 64 B3 OCT 3 BN31 OCT 177400 B1100 OCT 1100 B4000 OCT 4000 B2000 OCT 2000 B52 OCT 52 D.13 DEC -13 B600 OCT 600 B500 OCT 500 ********************************************************** * CONFIGURES IO INSTRUCTIONS TO SELECT CODE SET * * IN A REG. * ********************************************************** * SETIO NOP LDA TEM12 GET SELECT CODE DVA05 IOR BN37 CONSTRUCT STF STA STF01 STF IS 1021XX * IOR B400 CONSTRUCT LIA AND SAVE STA LIA01 STA LIA02 STA LIA03 * XOR B600 CONSTRUCT SFS STA SFS01 SFS IS 1023XX * * * XOR B500 CONSTRUCT OTA AND SAVE STA OTA10 STA OTA02 STA OTA18 STA OTA20 IOR B1100 STA STC02 STA STC03 STA STC04 STA STC05 * IOR B4000 CONSTRUCT CLC,C AND SAVE STA CLC01 CLC,C IS 10C77XX STA CLC02 STA CLC03 * * * * * * * * LDA EQT4,I GET SUBCHANNEL AND STORE IN TEM11 LSR 6 SC=0 IS CRT (TEM10=60) AND B37 SC=1 IS L CTU )(TEM10=61) STA TEM11 SC =2 IS R CTU (TEM10 =62) *** SC =3 IS GRAPHICS (TEM10=60) CPA B3 IF GRAPHICS CRT CLR TEM11 CLA SO TEM10 =B60 ADA B60 STA TEM10 LDA EQT6,I GET CONTROL WORD LDB TEM10 GET DEVICE CPB B64 IS IT LP? CLA YES! SET FOR ASCII RAR BIT6 1\0 IS BIN\ASCII AND B40 ISOLATE BIT 5 XOR B40 REMOVE BIT 5 IF BINARY STA FILL SET FILL CHARACTER LDA EQT6,I GET WORD AGAIN TO SET HONEST WORD AND B2000 HONEST IS BIT 10 =1 STA TEMP2 * * ** LDA TEM10 CLB CPA B60 SET SWITCH CRT/CTU = RSS/NOP LDB RSS STB SWH1A STB SWH1B STB SWH1C STB SWH1D * * **************************************************** * SETUP EXTENSIONS ON EQT * * * * EQT NO. USE * * 1-8 STANDARD * * 9 RUNNING CHAR. ADDRESS * * 10 LAST CHAR. ADDRESS * * 11 ADDRESS TO GO ON INTERRUPT * * 12 NO. OF EQT EXTENSIONS * * AND CURRENT CONWD * 13 EQT EXTENSION STARTING ADD. * * 14-15 STD * * 16 TERMINAL STRAPPING AND CTU INFO* * BIT 14 IS 0\1 =CHAR.\BLOCK * * BIT 15 IS 0\1 =LINE\PAGE * ** DVA * BIT 5-8 IS BAUD RATE * BIT 9 IS PARITY EVEN\ODD 1\0 * * BIT 10 IS PARITY ON\OFF 1\0 * * +BIT 11 IS "CD" (DTR) SET * BIT 12 IS "CA" (RTS) SET * BIT 13 IS LINE 0\1 HARD\MODEM * BIT 4 IS KEYBOARD LOCKED * * BIT 3 IS CNC50 FLAG * BIT 2 IS RCTU EOF FLAG * BIT 1 IS LCTU EOF FLAG * BIT 0 IS TERMINAL STRAPPING * * ALREADY READ. * * 17 ID ADDRESS OF TERM. PROG. * * 18 NOT USED G * * 19 RETURN ADDRESS * * AND A REG. EXIT * 20 BINARY RECORD LENTGH * * AND PARITY ERR XLOG * * AND $UPIO ENTRY * 21 NOT USED * * 22 RETURN ADDRES* * 23 RETURN ADDRESS * * 24 RETURN ADDRESS * * LINE CONTROL REF.(MODEM) * * 25 RETURN ADDRESS * * AND LINE CONTROL FLAG * * 26 NOT USED * * 27 RETURN ADDRESS * * 28 TERMINAL STATUS * * BIT 1 TERMINAL ENABLED * BIT 3 PARITY ERROR * BIT 5 CNTRL D ENTERED * BIT 7 BUFFER FLUSH IN PROGRESS * **************************************************** * * SETIP LDA EQT13,I GET STARTING ADDRESS OF EXT. LDB D.13 STB TEMP1 STORE NO. OF EXT. AT TEMP1 LDB ADR16 GET ADD. OF EQT16 STA B,I STORE S.A. OF EXT. IN IT INA INB ISZ TEMP1 JMP *-4 * * ** DVA LDA EQT16,I SET MODEM SWITCHES CLB PER BIT 13 RAL,RAL HARDWIRE\MODEM =0\RSS SSA LDB RSS STB SWH2A STB SWH2B STB SWH2C F STB SWH2E * SEP1 CLB LDA EQT16,I GET BAUD RATE AND STORE AND BN57 IN CARD CONTROL WORD 4 (BN17) LSR 5 IOR BN62 STA BN17 BITS 0-4 * LDA EQT16,I GET PARITY INFO. AND AND B3000 STORE IN BN19 (CARD CONTROL WORD 3) LSR 7 IOR BN63 * STA BN19 AND B10 CHECK FOR PARITY. PARITY ON? SZA,RSS IF NO PARITY CHARACTER LENGTH IS 8 ISZ BN19 NO PARITY * * LDA EQT16,I STORE A AT EOOP7 IF CN50C AND B10 FLAG IS SET SZA LDB RSS STB EOOP7 * LDA EQT6,I GET CONTROL WORD AND B3 STA TEMP4 STORE REQUEST TYPE AT TEMP4 CPA B3 IS THIS CONTROL? JMP OVER7 YES RAR SSA IS THIS A WRITE? JMP OVER2 NO! *** *** LDB EQT28,I IF WRITE AND BUFFER FLUSH SET BLF,BLF THEN EXIT VIA REJ2 SSB JMP OVER8 JMP OVER2 OVER7 LDA EQT6,I LSR 6 IF CONTROL TYPE 0 AND B37 THEN SPECIAL PROCESSING REQUIRED SZA,RSS AT JMP OVER3 * * OVER2 LDA EQT6,I NORMAL NON CNTL 0 REQ. STA EQT12,I STORE CURRENT CONWD FOR SYS. INTERRUPT JMP SETIO,I * * BUFFER FLUSH EXITS * OVER8 LDA TEMP5 GET IA05/CA05 FLAG SZA JMP OVER2 CA05 EXIT JMP REJ2 * * SPECIAL "CONTROL 0" PROCESSING * OVER3 LDA EQT6,I IS THIS A SYSTEM REQ.? SSA,RSS JMP SETIO,I * LDA EQT12,I GET OLD CONWD STA EQT6,I PUT IN CURRENT CONWD AND B2 IF WRITE MUST COMPLETE XFER CPA B2 OR TERMINAL WILL HANG JMP OVER9 LDA EQT9,I NO MORE DATA IN USERS BUFFER! STA EQT10,I IT IS GONE!!! OVER9 LDA TEM11 IF NON CRT REQ. WE MUST COMPLETE SZA JMP EXIT4 CONTINUE NOT CRT REQ. * JSB CLRCD GET ALL OFF CARD JSB KEYBD ENABLE KEYBOARD IF LOCKED LDA EQT6,I RAR SLA,RSS IF WRITE OR CONT. THEN SEND NULL JMP REJ2 THIS IS A CRT READ CLA SEND NULL TO ALLOW CHAR. OUT OF UART JSB OUT2 JMP EOOP1 ADR16 DEF EQT16 EQT16 NOP 1 EQT17 NOP 1 EQT18 NOP 1 EQT19 NOP 1 EQT20 NOP 1 EQT21 NOP 1 EQT22 NOP 1 EQT23 NOP 1 EQT24 NOP 1 EQT25 NOP 1 EQT26 NOP 1 EQT27 NOP 1 EQT28 NOP 1 * * * * EQU'S FOR VARIOUS ENTRIES A EQU 0 DEFINE A REG. B EQU 1 DEFINE B REG. CARD EQU 15 DEFINE CARD FOR IO INSTRUCTIONS * * SYSTEM BSAE PAGE COMMUNICATION AREA * . EQU 1650B ESTABLISH ORIGIN OF EQTA EQU 1650B * BASE PAGE EQT1 EQU .+8 EQT2 EQU .+9 ADDRESSES EQT3 EQU .+10 EQT4 EQU .+11 OF CURRENT EQT5 EQU .+12 EQT6 EQU .+13 EQT ENTRY EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * INTBA EQU .+4 SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM CONSOLE * OPATN EQU .+52 OPERATOR KEYBOARD ATTN. FLAG ORG * DRIVER LENGTH END C !3U 92002-18001 1805 S 0422 GASP SOURCE              H0104 ASMB,R,L * NAME: $SPOL * SOURCE: 92002-18001 * RELOC: 92002-16001 * 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. * * *************************************************************** * NAM $SPOL 92002-16001 REV. 1805 771116 END SPL,L,O ! NAME: GASP ! 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 GASP(3,80) "92002-16001 760615" ! ! 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 CS43,N.SEQ,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 INT7#EGER 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 INTEGER 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 Ew 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) 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. G0P1V_60K !SET CODE TO GET TO INIT CALL G1ROT(G0PBF,G0NOP,IERR) !CALL INNITILIZE 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 i !KEEP THE HISTORY RETURN !EXIT END ! ! END GASP END$ 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 E !PRINT OUT STATUS IF [FL_TYP] = 2 THEN [ \IF NAME KEY, THEN BEGIN _ BEGIN + 1; GOTO 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 SUBRjOUTINE,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] !ELSE 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 mIT 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: 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$ 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 L !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 !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 TOl( 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" !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) !UNL=NLHOCK 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$ wN 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 PROykGRAM 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 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$ ASMB,R,L HED GASP1 * NAME: GASP1 * SOURCE: 92002-18008 * RELOC: 92002-16008 * 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 GASP1,5 92002-16001 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 ASMB,R,L HED GASP2 * NAME: GASP2 * SOURCE: 92002-18008 * RELOC: 92002-16008 * 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 GASP2,5 92002-16001 760615 EXT G0PBF,G1SUB,G1SEG SPC 1 GAj640SP2 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 g6ASMB,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<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 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 WRMITF 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 PROCED URE 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 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 LOCAHFBL 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 [HASMB,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 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 92002-16001 760526 ENT ST.LU * EXT N.SEQ,$LIBR,$LIBX 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 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 POI NT 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 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 JSB $LIBX DEF ST.LU * SEEK 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 B77 OCT 77 D15 DEC 15 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 * 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 w 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 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 ASMB,R,L,C HED G1STM * NAME: G1STM * SOURCE: 92002-18001 * RELOC: 92002-16001 * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETTZ-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 CFONTINUE * 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 ASMB,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 <:66< %3Y 92002-18002 2001 S C0322 &SMP SPOOL MONITOR PROG             H0103 ASMB,Q,C,N ASSEMBLY STATEMENT FOR RTE II * *ASMB,Q,C,Z ASSEMBLY STATEMENT FOR RTE III HED SMP ROUTINE * NAME: SMP * SOURCE: 92002-18002 (RTE II AND III) * RELOC: 92002-16002 (RTE II) 92060-16007 (RTE III) * PGMR: A.M.G. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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. 2001 791031 XIF * IFZ NAM SMP,18,30 92060-16007 REV. 2001 791031 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 INITIATION ENTRY OF SPOOL DRIVER 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 BATC8H 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 OUTSPOOLINlG * * * P1 =17 START UP OUT SPOOLING * * * P1 =18 CALL FROM SPOUT 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 JSB 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. 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 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 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 REeQUEST. * 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,RSS SKIP IF NOT GIVEN JMP CKVAL * STA BUF23+15 LDA BUF23+10 GET STATUS WORD LDB "W" SZA,RSS STATUS DEFINED? STB BUF23+10 NO, THEN SET STATUS TO WAIT * CKVAL 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 uTEMP1,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 SRSEX GO SEND IT (SST#4235,#4236) * 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 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. NNLH 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,I 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 AN 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 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 OUTSPG~OOLING. * QUEUE LDA PTR23 (SST# 4341) LDB RECNO JSB WTREC 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 TEMP6 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 * 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? 0 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 LDA 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 ISSt 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 STATUS 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 ENTRY8C 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 RECORD 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 GOZ* CLEAR IT LDA BUF23+1 STA RESLU JSB SMENU GET OUTSPOOL LU QUEUE REC# (SST#4197) JMP KILL3 ERROR * INB STB TEMP6 SAVE SPLCON REC # LDB A LU QUEUE REC # LDA PTR24 JSB RDREC NOP ******************************************* * 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 THE 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 PARAMETERShr 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 LDB 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 * nNLHPRG0 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 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 GN 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. 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 JSB UNLOK DEF WRN 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 PkJSB 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 WORD 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   (#L 92002-18003 1926 S 0222 DVS43 (SPOOL LVR)              H0102 ?ASMB,R,Q,C,Z ASSEMBQE STATEMENT FOR RTE III * *ASMB,R,Q,C,N ASSEMBQE STATEMENT FOR RTE II IFN HED SPOOL MONITOR DRIVER FOR RTE II XIF IFZ HED SPOOL MONITOR DRIVER FOR RTE III XIF * NAME: DVS43 * SOURCE: 92002-18003 (RTE II AND III) * RELOC: 92002-16003 (RTE II) 92060-16009 (RTE III) * PGMR: A.M.G.,G.A.A * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 DVS43 92002-16003 REV. 1926 790503 XIF IFZ NAM DVS43 92060-16009 REV. 1926 790503 XIF * * ENT IS43,CS43,$MPID,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 - NOT USED * 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 IFZ EXT $DVM IN RTE III TO SETUP USER MAP EXT $RSM IN RTE III TO RESTORE PREVIOUS MAP XIF EXT $UPIO 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 * LDB EQT6,I TEST FOR CLEAR IO RQ CPB BSN3 BSN3=100003B JMP IS43,I SYSTEM CLEAR ACCEPT IT. * 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 <5S0) 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 FOR 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 NOjNE OF THE ABOVE JMP RTRN REJECT REQUEST * ABORT LDA D25 SEND ABORT ERROR IO25 JMP RTRN RETURN * * COMMON RETURN POINT * RTRN STA XA SAVE A REG LDA EQT1,I IS CLEAR IO IN PROGRESS RAL,CLE,SLA,ERA CLEAR SIGN BIT IN CASE CLB,RSS YES SET B TO CLEAR TIME OUT JMP RTRN2 NO GO EXIT * STA EQT1,I SET EQT1 WITH CLEARED FLAG BIT STB EQT15,I CLEAR THE TIME OUT WORD LDA EQT5,I CLEAR THE BUSY BIT ALR,RAL AND STA EQT5,I SET IT BACK JMP $UPIO NOW GO TO UPIO * RTRN2 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 BSN3 OCT 100003 * * * * 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 l 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 BACK 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 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 # WORDS 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 SAVE,I GET THE WORD STA B,I PUT IT INTO BUFFER OF BUFFERED REQUEST 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 LDA EQT1,I GET THE CLEAR IN PROGRESS FLAG SSA THEN JMP ERN5 GO EXIT * 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 IFN JMP $XEQ GO TO SYSTEM IDLE LOOP XIF IFZ JMP WT1 IF IN RTE III XIF * IOR D2 STA EQT11,I CLA JMP RTRN * IFZ WT1 JSB $RSM IN RTE III,RESTORE PREVIOUS JMP $XEQ MAP AND GO TO SYSTEM IDLE LOOP. XIF * 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 B 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 POST6 CLEAR THE LU SO WON'T BE FAKED OUT 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 IM MEDIATE 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. THIS 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 WRITTENT 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 #NLH 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 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 ;NINC5 LDA EQT11,I SET UP TO TIME OUT IOR B2000 SET RETURN VECTOR 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 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. IFZ JSB $RSM IN RTE III,RESTORE PREV. MAP XIF 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. IFZ NOP MAP INFORMATION (RTE III) XIF 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) IFZ SSA,RSS USER REQUEST ? JSB $DVM YES, IN RTE III, SET UP USER MAP. XIF 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 B6 IFZ JSB $RSM IN RTE III,RESTORE PREV. MAP XIF JSB $XSIO XSI22 NOP LOGICAL UNIT #. DEF COMP2 COMPLETION ADDRESS. NOP LIST POINTER WORD. NOP CONTROL INFO., REQUEST CODE. DEF DSCC2 DISK CONTROL WORDS. DEC 10 PRIORITY OF REQUEST. IFZ NOP MAP INFORMATION (RTE III) XIF 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 JMP EXEQT,I RETURN TO THE CALLER * * * *THE LIST SUBROUTINE CALLS $LIST IN THE RTE OPERATING SYSTEM *TO SCHEDULE EXTND * * LIST NOP IOR EQT11,I SET THE RETURN VECTOR STA EQT11,I IN EQT 11 JSB $LIST SCHEDULE THE EXTND PROGRAM OCT 1 DEF *+5 $MPID NOP SET TO EXTND'S ID ADDRESS BY GASP DEF PRM1 DEF PRM2 DEF PRM3 * SZA SUCCESSFUL? JMP NTRDY NO, SO TRY LATER JMP LIST,I * PRM1 NOP PRM2 NOP PRM3 NOP HED SPOOL MONITOR DRIVER WRITE ROUTINES ADR16 DEF EQT16 N18 DEC -18 * * COME HERE FOR WRITE EOF RECQUEST * 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 FLAGS * 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 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 K 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 EQT1,I CHECK IF PROCESSING A SYSTEM CLEAR SSA IF SO THEN CLB SET UP TO FOURCE A COMPLETION RETURN 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 FILE 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 PROC$"ESSOR 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. DEC -1 MARKS END OF BUFFERS. A EQU 0 B EQU 1 END IS43 *f$ *C 92002-18004 1805 S 0122 EXTND (GET FILE EX)              H0101 QASMB,R,L,C,Z ASSEMBLE STATEMENT FOR RTE III *ASMB,R,L,C,N ASSEMBLE STATEMENT FOR RTE II HED EXTND ROUTINE * NAME: EXTND * SOURCE: 92002-18004 (RTE II) 92060-18010 (RTE III) * RELOC: 92002-16004 (RTE II) 92060-16010 (RTE III) * 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. * * *************************************************************** * IFZ NAM EXTND,17,10 92060-16010 REV.1631 760622 XIF IFN NAM EXTND,1,10 92002-16004 REV. 1631 760622 XIF * IFN ENT SP.CL XIF IFZ SUP EXT SP.CL XIF * EXT EXEC,RMPAR,$MPID,$LIBR,$LIBX EXT $PVCN,$CIC,$YCIC * IFN SP.CL DEC 0 XIF 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. JSB $LIBR YES. SET UP $MPID FOR NOP DVS43 AND RETURN. LDA XEQT STA $MPID JSB $LIBX DEF *+1 DEF *+1 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? z 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 ERRORS? 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 IFZ SJP $YCIC DRIVER TO TELL IT WE ARE XIF IFN JMP $YCIC DRIVER TO TELL IT WE ARE XIF 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 r 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 5 +3 92002-18005 1805 S 0122 JOB (JOB ENTRY MON)              H0101 nASMB,R,L,C HED JOB ROUTINE * NAME: JOB * SOURCE: 92002-18005 * RELOC: 92002-16005 * 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 92002-16005 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 ,> 92002-18006 2001 S C0722 &BMLIB BATCH MONITOR LIBRARY             H0107 fASMB,R,L * NAME: $BALB * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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. * * *************************************************************** * NAM $BALB 92002-16006 REV.2001 791022 END ASMB,R,L,C HED CREAT * NAME: CREAT * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 CREAT,7 92002-16006 REV.1926 790501 ENT CREAT EXT CLOSE,$OPEN,.ENTR EXT NAM..,RMPAR EXT EXEC EXT D.R SUP * * MODIFIED 781108 GLM TO NOT SET EOF READ BIT IN DCB * MODIFIED 790501 GLM TO CHECK FOR REQUESTED SIZE > 16383 BLKS * * * * 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 INCLUDING 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) * SKP DCB NOP IERR NOP NAME NOP SIZE NO<P TYPE DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 CREAT NOP ENTRY POINT JSB .ENTR TRANSFER THE PARAMETERS DEF DCB LDA TYPE MAKE SURE THERE ARE CPA DZERO ENOUGH JMP ER10 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 BUF SET ISZ NAME UP DLD NAME,I SKELETON DIRECTORY DST BUF+1 ENTRY IN BUF LDA TYPE,I SZA TYPE MUST BE SSA >0 JMP ER16 NOT >0 ; ERR STA BUF+3 LDB SIZE,I GET THE SIZE * *790501* CLE,ELB DOUBLE TO GET 64-WORD SECTORS 790501 SEZ IF REQUEST IS FOR THE REST OF THE DISC, 790501 JMP ALLD GO SET SIZE PARM FOR D.RTR 790501 * SSB IF > 16383 BLKS 790501 JMP ER16 GIVE SIZE ERROR 790501 * RSS 790501 ALLD CCB SET TO -1 * *790501* SZB,RSS IF ZERO JMP ER16 ERROR STB BUF+6 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 BUF+3 GET TYPE CPB .1 IF TYPE=1 LDA .128 SET SIZ!E 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 BUF+7 SET RECORD SIZE LDA SC,I SET STA BUF+8 SECURITY CODE SPC 2 JSB EXEC GET DEF TRRQ ONE DEF .4 TRACK DEF .1 FROM DEF TRACK THE DEF DLU SYSTEM DEF TMP TRRQ JSB EXEC WRITE DEF WRRTN THE DEF .2 DIRECTORY DEF DLU ENTRY DEF BUF ON DEF .128 THE DEF TRACK TRACK DZERO DEF ZERO AT SECTOR ZERO WRRTN CCA SET TO DISC ERROR CODE CPB .128 DISC ERROR RSS NO; SKIP JMP EXIT YES; EXIT LDA TRACK COMBINE LSL 6 TRACK ADA DLU AND LU STA TMP FOR D.RTR SCHLP JSB EXEC SCHEDULE DEF SCHRT D.RTR DEF .9 TO DEF D.R CREAT DEF XEQT THE DEF TMP FILE DEF LU,I PASSING DEF TMP THE DEF .1 TRACK SCHRT SZA SCHEDULE OK JMP SCHLP NO; TRY AGAIN SPC 2 JSB RMPAR YES; DEF *+2 CALL RMPAR DEF BUF+4 TO GET RETURN CODES JSB EXEC RELEASE DEF RTRTN THE DEF .5 SYSTEM DEF .1 TRACK DEF TRACK DEF DLU RTRTN LDA BUF+4 GET D.RTR COMPLETION SSA CODE - OK JMP EXIT NO; TAKE EXIT LDA BUF+5 YES; SET UP STA DCB,I TO CALL LDB DCB $OPEN CLE,INB TO LDA BUF+6 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 aDEF IBLK,I ADDRESS OF BLOCK SIZE DEF BUF+8 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 * *781108* LDA .1I SET WRITTEN ON AND DATA IN DCB FLAG LDB DCB GET WRITE FLAG ADB .13 ADDRESS STA B,I SET WRITTEN ON FLAG ADB .3 STEP TO THE BUFFER AND SET EOF CCA STA B,I IN FIRST WORD OF BUFFER * *781108* EXIT0 LDA BUF+4 NO; USE D.RTR RETURN FOR ERROR EXIT LDB DZERO CODE STB SC RESTORE STB LU CALL WORDS STB TYPE FOR NEXT CALL STB IBLK STA IERR,I SET ERROR CODE JMP CREAT,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 .1I DEF 1,I 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 BUF BSS 9 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ASMB,R,L,C HED OPEN * NAME: OPEN * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 OPEN,7 92002-16006 741208~5 ENT OPEN EXT EXEC,CLOSE,RMPAR,$OPEN EXT .ENTR EXT D.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 DCB NOP ERR NOP NAME DEF ZERO OP DEF ZERO SC DEF ZERO LU DEF ZERO IBLK DEF ZERO SPC 1 OPEN 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 LDA NAME,I GET NAME WORD1 LDB OP,I AND OPTION ERB EXCLUSIVE BIT TO E CME INVERT AND RAL,ERA SET IN SIGN OF A STA NAME1 SET FOR CALL TO D.RTR ISZ NAME GET DLD NAME,I REST OF DST NAME1+1 NAME AND SET FOR D.RTR CALL LDA XEQT GET ID CCE AND RAL,ERA SET STA ID SIGN FOR D.RTR CALL SCDRT JSB EXEC SCHEDULE DEF SCRTN D.RTR DEF .23 WITH WAIT DEF D.R TO OPEN X REP 4 THE FILE DEF ID+*-X DEF LU,I SCRTN 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 LDB DZERO RESET THE Y REP 5 DEFAULT STB NAME+*-Y PARAMETERS STA ERR,I SET THE ERROR CODE JMP OPEN,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 .2 DEC 2 .3 DEC 3 B3700 OCT 3700 B77 OCT 77 .23 DEC 23 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 3 END EQU * END ASMB,L HED PURGE * NAME: PURGE * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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. * * *****************9********************************************** * NAM PURGE,7 92002-16006 740801 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 DCB NOP IERR NOP NAME DEF ZERO SC DEF ZERO LU DEF ZERO SPC 1 PURGE 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 LDB DZERO RESET X REP 3 THE STB NAME+*-X ENTRY JMP PURGE,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 ASMB,L HED NAMF * NAME: NAMF * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 NAMF,7 92002-16006 771115 EXT EXEC,.ENTR,CLOSE,NAM..,OPEN,RMPAR ENT NAMF * * NAMF IS THE FILE NAME CHANGE MODUL_E 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 DCB DEF ZERO DEFINE IERR DEF ZERO PARAMATER NAME DEF ZERO ADDRESSES NNAME DEF ZERO IS DEF ZERO ILU DEF ZERO NOP SPC 1 NAMF NOP ENTRY POINT 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,"LI SECURITY LDA N7 CODE SSB,RSS MATCH? JMP CLOEX NO; CLOSE AND EXIT JSB EXEC GET DEF EXR1 A DEF .4 SYSTEM DEF .1 TRACK DEF TRACK DEF LU DEF DCB2 EXR1 JSB EXEC WRITE DEF EXR2 THE DEF .2 NEW DEF LU NAME DEF NNAME,I ON DEF .128 THE DEF TRACK TRACK DEF ZERO SECTOR ZERO EXR2 DLD DCB,I GET DCB2 TO B STB DCB2 AND SAVE IT LDA TRACK FORM TRACK/LU LSL 6 WORD ADA LU FOR STA NAME D.RTR CALL SCH JSB EXEC CALL DEF EXR3 D.RTR DEF .9 TO DEF D.RTR CHANGE DEF XEQT THE DEF NAME FILE DEF DCB,I NAME DEF DCB2 DEF .2 EXR3 SZA SCHEDULE JMP SCH CONFLICT- THEN TRY AGAIN JSB RMPAR CALL RMPAR TO GET DEF *+2 RETURN PARAMETERS DEF NAME TO LOCAL AREA. JSB EXEC RETURN DEF EXR4 THE DEF .5 SYSTEM DEF .1 TRACK DEF TRACK DEF LU 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 LDB DZERO RESET X REP 3 THE STB *-X+NNAME ADDRESSES JMP NAMF,I EXIT TO USER SPC 3 * FOLLOWING CONSTANTS SPC 1 DCB2 NOP LU NOP TRACK NOP ZERO NOP DZERO DEF ZERO SPC 2 * TEMPS REFERENCED ONLY BY DEFS SPC 1 .1 DEC 1 .2 DEC 2 .4 DEC 4 .5 DEC 5 .9 DEC 9 .128 DEC 128 D.RTR NLHASC 3,D.RTR SPC 2 * ASSEMBLY AIDS SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * PROG. LENGTH SPC 1 END ^NASMB,R,L,C HED READF - WITH RENT. I/O * NAME: READF * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 READF,7 92002-16006 REV.2001 791018 ENT READF,WRITF EXT EXEC,R/W$,.ENTR,P.PAS EXT RW$UB,$KIP EXT D$XFR EXT RFLG$ EXT REIO SUP * * * 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 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 ZERO 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, 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 WRITF DEC -1 WRITE ENTRY POINT LDA WRITF TRANSFER RETURN ADDRESS STA READF TO READ ENTRY JMP READF+1 AND GO TO READ ENTRY 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 READF 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 BUFPT GET CURRENT BUFFER POINTER STA TDCBP AND SAVE IN CASE OF EOD DLD BUFPT,I GET BUFPT AND RWFLG DST TBUFP AND SAVE IN CASE OF EOD ON EXTENT * 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 WRITF 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 CPA N6 POSSIBLE END OF DISC (ON CREAT) JMP EOD CPA N14 OUT OF DIRECTORY ON EXTENT CREAT ? ` JMP EOD EXIT1 LDB N17 EXIT STB BUF RESTORE LDB DMBUF OPTIONAL STB IL PARAMETER LDB DZER0 ADDRESS STB L FOR STB N NEXT CLB CALL STB ZER0 STB DM CCB STB WRITF RESET READ WRITE FLAG AND JMP READF,I RETURN SPC 2 EOD CCB SET -1 INTO LAST STB TBUFP,I POSITION IN DCB DLD TBUFP NOW RESTORE BUFFER DST TDCBP,I AND FLAG WORDS LDA IERR,I RE-SET ERROR CODE JMP EXIT1 SPC 2 TBUFP NOP TEMP STORAGE TFLAG NOP DON'T CHANGE TDCBP NOP THE ORDER 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 FORCE LENGTH TO 128 FOR TYPE 1 FILES STA RL,I FOR THE POSITION ROUTINE STA BFSZ FORCE BLOCK LENGTH TO 128 FOR TYPE 1 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 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 WRITF 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 NA EOF RAR,RAR SET (READ) OR CLEAR (WRITE) ELA,RAL EOF SENT STA RWFLG,I BIT IN DCB LDA WRITF 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 WRITF 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 WRITF 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 WRITF 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 WRITF 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 REIO 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 THSE EOF BIT RAL TO BIT 15 SSA IF EOF BIT SET JMP EOF00 GO DO EOF THING * SZB IF ZERO 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 ZERO EXIT SPC 2 EOFW0 JSB EXEC WRITE TYPE ZERO EOF DEF EOFRT RETURN ADDRESS DEF .3I CATCH 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 N6 OCT -6 N7 OCT -7 N12 DEC -12 N14 DEC -14 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 ASMB,L HED FSTAT * NAME: FSTAT * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 FSTAT,7 92002-16006 740801 ENT FSTAT EXT EXEC,.ENTR SPC 1 * FSTAT READS THE DIRECTORY OF DISCS TO THE * USER SPECIFIED 125 WORD BUFFER * * CALLING SEQUENCE: SPC 1 * CALL FSTAT(ISTAT) SPC 1 * WHERE: ISTAT IS A 125 WORD BUFFER INTO * WHICH THE DIRECTORY WILL BE READ. SPC 5 ISTAT NOP SPC 1 FSTAT NOP ENTRY POINT JSB .ENTR FETCH THE DEF ISTAT ADDRESS SPC 1 CCA COMPUTE LAST ADA TATSD SYSTEM DISC STA TRACK TRACK NUMBER JSB EXEC CALL EXEC DEF RTN TO DEF .1 READ DEF .2 FROM LU 2 DEF ISTAT,I TO THE USER BUFFER DEF .125 125 WORDS DEF TRACK FROM THE LAST TRACK DEF .0 SECTOR 0 RTN JMP FSTAT,I RETURN SPC 3 .1 DEC 1 .2 DEC 2 .125 DEC 125 .0 NOP TRACK NOP 1756B SPC 2 A EQU 0 B EQU 1 TATSD EQU 1756B SPC 1 END EQU * SPC 1 END ASMB,R,L,C HED RWNDF * NAME: RWNDF * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 RWNDF,7 92002-16006 740801 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 OPEaN * * SPC 2 * PRE CONSTANT AREA SPC 1 .3 DEC 3 TYPE NOP .2 OCT 2 .7 DEC 7 .5 DEC 5 SPC 3 DCB DEF DCB IER DEF DCB SPC 1 RWNDF 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; SET 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 LDB DFDM RESET ENTRY ADDRESSES STB DCB AND STB IER THEN JMP RWNDF,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 `HFBBHASMB,L HED POSNT * NAME: POSNT * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 POSNT,7 92002-16006 760702 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 * 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 POSNT 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 DCkB 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 LDA 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 BSRC-5 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 SET 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 LDB DFZER EXIT-RESET STB NP OPTIONAL STB IR ADDRESSES STA ER,I SET ERROR AND JMP POSNT,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 ASMB,R,L,C HED APOSN * NAME: APOSN * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 APOSN,7 92002-16006 781103 REV.1901 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) * * CHANGE 781103 GLM CLEAR EOF FLAG CORRECTLY * * 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 DCB NOP ER NOP IRC NOP IRS NOP IOFF NOP SPC 1 APOSN NOP ENTRY POINT 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 TY PE,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 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 * *781103* LDB DCB GET DCB ADDRESS ADB .13 POSITION TO EOF FLAG LDA B,I GET BLOCK SIZE & EOF FLAG RAR,CLE,RAR CLEAR EOF ELA,RAL READ FLAG STA B,I & RETURN IT TO DCB * *781103* CLA,RSS OK - EXIT ER10 LDA N10 EXIT CLB CLEAR STB IRC PRAM STQB IOFF ADDRESSES FOR NEXT TIME STA ER,I SET ERROR CODE JMP APOSN,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 .13 DEC 13 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 ASMB,R,L,C,Q HED FCONT * NAME: FCONT * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 FCONT,7 92002-16006 REV.1826 780413 * * CHANGE: 4\13\78 TO NOT CHECK A REG ON RETURN FROM EXEC * FOR EOF INDICATION. (GLM) * ENT FCONT EXT .ENTR,EXEC * * THIS IS THE TYPE ZERO CONTROL ROUTINE OF * THE RTE FILE MANAGEMENT PACKAGE. * * A STANDARD 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 * * >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 SPEyCIFIED * ON RETURN A = IERR * B = DEVICE STATUS SPC 3 * PRE CONSTANT AREA .2 OCT 2 TYPE NOP .7 OCT 7 SPC 3 IDCB DEF ZERO PARAMETER IERR DEF ZERO ADDRESS ICON1 DEF ZERO AREA ICON2 DEF ZERO SPC 1 FCONT NOP ENTRY POINT JSB .ENTR FETCH PARAMETERS DEF IDCB 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 FCONT,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 FUNC THE DEF ICON1 CONTROL DEF ICON2,I FUNCTION EXRTN JMP EXM17 ERROR RETURN FROM EXEC. STA STAT SAVE STATUS FOR RETURN CLA INDICATE NO ERRORS *780413* JMP EXIT GO; EXIT * EXM17 LDA N17 JMP EXIT * SPC 3 * POST CONSTANT AREA SPC 1 FUNC OCT 100003 B1777 OCT 177700 B200 OCT 200 N17 DEC -17 SPC 2 A EQU 0 B EQU 1 XEQT V%EQU 1717B SPC 1 END EQU * SPC 1 END ASMB,R,L,C HED LOCF * NAME: LOCF * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 LOCF,7 92002-16006 750416 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 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 LOCF NOP ENTRY JSB .ENTR GET DFDCB DEF DCB PARAMETERS ADDRESSES LDA N10 NOT ENOUGH LDB IREC PRAM CPB DFDM TEST JMP EXIT NOT ENNOUGH - 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 LDB N9 SET UP STB COUNT AND LDB DFDCB RESTORE STB AD DUMMY LDB DFDM PARAMETER STB AD,I ADDRESSES ISZ AD ISZ COUNT IN JMP *-3 CALL JMP LOCF,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 ASMB,R,L,C HED CLOSE * NAME: CLOSE * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 CLOSE,7 92002-16006 771115 ENT CLOSE EXT EXEC,.ENTR,R/W$,RMPAR 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 IDCB DEF ZERO DCB ADDRESS IERR DEF IDCB ERROR CODE ADDRESS IRX DEF ZERO TRUNICATE CODE ADDRESS SPC 1 CLOSE NOP ENTRY POINT JSB .ENTR TRANSFER THE ADDRESSES DM DEF IDCB LDA IDCB IF NO PARAMETERS CPA DZ THEN JMP ER10 ERROR EXIT INA STEP TO WORD TWO STA DCB2 SAVE FOR D.RTR CALL ADA .8 ADD 8 TO GET THE THE OPEN 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 JSB R/W$ CALL TO FLUSH THE BUFFER JMP EXIT DISC ERROR EXIT LDB DCB2 GET THE TYPE FLAG INB TO 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 IRX SAVE SCHED JSB EXEC CALL EXEC DEF SCHRT TO DEF .9 SCHEDULE WITH WAIT DEF D.RTR D.RTR DEF XEQT WITH THE ID DEF IRX THE TRUNCATE WORD DEF IDCB,I THE FIRST DCB WORD DCB2 NOP THE SECOND DCB WORD DZ DEF ZERO AND THE CLOSE CODE SCHRT SZA SCHEDULE OK JMP SCHED NO; TRY AGAIN SPC 2 STA OPNFL,I CLEAR THE OPEN FLAG JSB RM}PAR CALL RMPAR TO GET DEF *+2 RETURN PARAMETERS DEF ERTN TO LOCAL AREA LDA ERTN GET ERROR RETURN EXIT STA IERR,I SET THE ERROR CODE LDB DM RESET STB IERR THE CALL WORDS LDB DZ FOR THE STB IRX NEXT CALL STB IDCB AND JMP CLOSE,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 N10 DEC -10 N2 DEC -2 .8 DEC 8 .9 DEC 9 .13 DEC 13 SC NOP OPNFL NOP ZERO NOP D.RTR ASC 3,D.RTR ERTN NOP NOP LOCAL STORAGE FOR NOP RETURN PARAMETERS NOP FROM D.RTR NOP SPC 2 SPC 3 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 END EQU * SPC 1 END ASMB,R,L,C HED POST - CLEAR THE DCB BUFFER * NAME: POST * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 POST,7 92002-16006 740801 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: * * TRNDCB IS THE DCB ARRAY * ER IS THE OPTIONAL RETURN ERROR CODE * DCB NOP ER NOP POST 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 POST,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 * 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 TASMB,R,L,C HED NAM.. ROUTINE * NAME: NAM.. * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 NAM..,6 92002-16006 740801 ENT NAM.. EXT $LIBR,$LIBX,.ENTP 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 SPC 3 NAME NOP ADDRESS OF THE NAME NAM.. NOP ENTRY POINT JSB $LIBR PRIVLEDGED NOP JSB .ENTP GET THE PRAMS DEF NAME 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 B377 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 "*" SEHZ,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 JSB $LIBX DEF NAM.. 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 ASMB,R,L,C HED IDCBS * NAME: IDCBS * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 IDCBS,7 92002-16006 750609 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 R 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 ASMB,L HED $OPEN * NAME: $OPEN * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 $OPEN,7 92002-16006 740801 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 WSAVE 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 CLΆE,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 ASMB,R,L,Z,C HED P.PAS * NAME: P.PAS * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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. * * *************************************************************** * IFN NAM P.PAS,6 92002-16006 740801 EXT $LIBR,$LIBX XIF IFZ NAM P.PAS,7 92002-16006 740801 ENT P.PAS XIF * 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 IFN JSB $LIBR CALL FOR PRIVILEGE NOP XIF 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 a 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 IFZ SEZ YES; EXIT TO JMP A,I END OF CALL JMP DEST,I SEQUENCE XIF IFN SEZ,RSS PRIVILEGE - COMPUTE LDA DEST RETURN ADDRESS AND STA P.PAS SET IT JSB $LIBX CALL SYSTEM DEF P.PAS TO RETURN XIF SPC 5 IFN COUNT EQU P.PAS+2 XIF IFZ COUNT NOP XIF DEST NOP LOAD LDB A TEST NOP SPC 2 A EQU 0 B EQU 1 END EQU * END ASMB,L,R,C HED RW$UB * NAME: RW$UB * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 RW$UB,7 92002-16006 750422 * * 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 SWI{/TCH 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 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 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 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 ASMB,R,L HED RWND$ * NAME: RWND$ * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 RWND$,7 92002-16006 771121 ENT RWND$ EXT EXEC,RMPAR 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 STB DCB SAVE THE DCB INB ADDRESS STB OF/SC FOR THE D.RTR CALL ADB .2 SAVE THE STB TMP TRACK ADDRESS STA TMP2 AND THE EXTENT ADB .12 INDEX TO THE 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 SET SET IT FOR CALL TO D.RTR AGAIN JSB EXEC ELSE DEF STEST CALL DEF .9 D.RTR DEF D.RTR TO DEF XEQT OPEN DEF TMP2 THE DCB NOP EXTENT. OF/SC NOP DEF SET STEST SZA SCHEDULE OK? JMP AGAIN NO; TRY AGAIN SPC 1 JSB RMPAR CALL RMPAR TO GET DEF *+2 RETURN PARAMETERS DEF ERTN TO LOCAL AREA LDB AERTN LDA B,I HFB 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 TMP2 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 ERTN NOP NOP LOCAL STORAGE NOP RETURN PARAMETERS NOP FROM D.RTR NOP AERTN DEF ERTN .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 D.RTR ASC 3,D.RTR XEQT EQU 1717B A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END HASMB,R,L,C HED R/W$ * NAME: R/W$ * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 R/W$,7 92002-16006 740801 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 ADA PRC 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 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 PRC OCT 74000 LST D.R ASC 3,D.RTR SPC 1 END EQU * SPC 1 END ASMB,R,L,C,Q HED SPOPN ROUTINE * NAME: SPOPN * SOURCE: 92002-18006 * RELOC: 92002-16006 * PGMR: G.A.A. * * ********************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM AGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARDANY. * * ********************************************************** * NAM SPOPN,7 92002-16006 REV.1826 780413 * * CHANGE: 780413 TO MAKE CROSS MAP ACCESS OF MP1 * IF IN A DMS ENVIRONMENT. (GL * ENT SPOPN * EXT .ENTR,EXEC,$OPSY * * THE FOLLOWING ROUTINE DOES A SETUP REQUEST * TO THE SMP AND PASSES THE BUFFER TO IT. * BUFFR BSS 1 LUNO BSS 1 * SPOPN NOP JSB .ENTR DEF BUFFR LDA BUFFR STA BUFR CLA STA CLASS JSB EXEC DEF *+8 DEF D20 DEF ZERO BUFR BSS 1 DEF D16 DEF ZERO DEF ZERO DEF CLASS LDA BUFFR,I SZA LDA B1717 STA BCHK JSB EXEC DEF *+6 DEF D23 DEF SMPA DEF ZERO DEF CLASS DEF BCHK * LDA $OPSY FETCH OP SYS IDENT *780413* ARS POSITION DMS BIT TO BIT 0 *780413* SLA,RSS IF BIT 1 CLEAR (NOT DMS) *780413* JMP NDMS DO A STRAIGHT LOAD *780413* * XLA B,I ELSE, DO A CROSS MAP LOAD *780413* RSS TO FETCH RTN PARM / *780413* NDMS LDA B,I FETCH RETURN PARM FROM SMP *780413* * STA LUNO,I JMP SPOPN,I * ZERO DEC 0 D23 DEC 23 D16 DEC 16 D20 DEC 20 B1717 EQU 1717B CLASS BSS 1 BCHK BSS 1 SMPA ASC 3,SMP B EQU 1 * END ASMB,R,L,C HED REAL-TIME, FMGR WRITE LOAD/GO DISK FILE NAM WRLG.,7 92002-16006 760622 ENT WRLG.,EFLG. EXT EXEC SPC 1 SPC 1 * PURPOSE: * THIS ROUTINE WRITES RELOCATABLE RECORDS ON DISK. SPC 1 * USES: * THIS ROUTINE IS USED BY FMGR TO WRITE THE RELOCATABLE * RECORDS ON A RTE * DISC BASED SYSTEM. * IN RTE SYSTEMS, THIS AREA IS CALLED THE * "LG" AREA. THE FORMAT ON DISC IS SAME AS PAPER TAPE FORMAT. SPC 1 * CALLED: * ASSEMBLY ONLY * JSB WRLG. (ALL INITIALIZATION DONE BY SYSTEM) * DEF *+4 * DEF BUFFR FIRST WORD ADDRESS OF WRITE BUFFER * DEF RLEN ADDRESS OF NUMBER OF WORDS TO WRITE * DEF PBUF ADDRESS OF A 128 WORD PACKING BUFFER * P+5 A = 0 IF NO ERROR ELSE ERROR * * ASSEMBLY ONLY * JSB EFLG. POST ANY PARTIAL RECORD IN MEMORY * DEF *+2 RETURN ADDRESS * P+2 A=0 IF NO ERROR ELSE ERROR SPC 1 * ERRORS: * THE PROGRAM WILL RETURN TO THE CALLING PROGRAM WITH * A,B= "IO06" ERROR IF THE "LG" AREA WAS NOT DEFINED, OR * A,B= "IO09" ERROR IF THE "LG" AREA OVERFLOWS. SPC 1 * NOTES: * "NAM" RELOCATABLE RECORDS MUST ALWAYS START ON A SECTOR BOUNDRY, * THEREFORE, WHENEVER AN "END" RELOCATABLE RECORD IS WRITTEN, THE * ENTRY POINT " EFLG. " MUST BE CALLED TO POST ANY PARTIAL RECORD * STILL IN MEMORY ONTO THE DISK. SPC 1 .WRIN NOP INIT2 STA BFWA SET THE BUFFER ADDRESS ON FIRST ENTRY CLA CLEAR FOR NEXT STA INIT2 ENTRIES LDA 1766B  LGOC= CURRENT LOAD/GO CODEWORD LDB D2 SSA INB STB WLUN LUN=2 IF SIGN=0, =3 OTHERWISE ALF,ALF RAL AND O377 STA TRACK SET TRACK NO. LDA 1766B LGOC= CURRENT LOAD/GO CODE-WORD AND O177 STA B STA SECTR SET SECTOR NO. LDA DM128 SLB CHECK IF ODD SECTOR IN RTE ARS YES, DIVIDE SECTOR TO 64 WORDS STA BCOUN SECTOR-BUFFER COUNT = -64 CMA,INA SET THE SECTOR SIZE STA PSIZE MAY BE 64 OR 128 WORDS IF RTE LDA BFWA STA BFRAD SET SECTOR BUFFER ADDR = FWA BFR JMP .WRIN,I * *EFLG. OUTPUTS THE WRITE-BUFFER TO THE CURRENT SECTOR *ON DISK, UPDATES THE CURRENT SECTOR NO. *EFLG. IS USUALLY CALLED AT THE END OF EACH SUBPROGRAM OUTPUT. SPC 1 EFLG. NOP LDA EFLG.,I GET RETURN ADD STA EFLG. AND SET IT CCA CHECK HOW MANY SECTORS TO POST ADA BCOUN ADA PSIZE A=# WORDS WRITTEN -1 IOR O77 MIRGE IN 63 SSA,INA CHECK IF ANY & BUMP JMP OKEX NONE, JUST RETURN * STA SSIZE EITHER 64 OR 128 LDB BCOUN IF NOT A WHOLE SECTOR CLA SZB STA BFRAD,I 0 FOR END OF SUBPROGRAM JSB EXEC WRITE SECTOR DEF *+7 DEF D2I CODE FOR WRITE DEF WLUN LUN BFWA NOP FWA OF BUFFER DEF SSIZE 64 OR 128 WORDS DEF TRACK TRACK NO DEF SECTR SECTOR NO JMP EFLG.,I RETURN IF ERROR * JSB .WRIN RE-INITIALIZE FOR NEXT WRITE OKEX CLA SHOW NO ERROR JMP EFLG.,I EXIT SPC 1 SSIZE NOP O77 OCT 77 O377 OCT 377 O177 OCT 177 SPC 1 WRLG. NOP LDA WRLG.,I STA EXIT SET RETURN ADR ISZ WRLG. LDA WRLG. LDA A,I RAL,CLE,SLA,ERA TEST I-BIT AND CLEAR JMP *-2 STA WBFAD SOURCE-BUFFER FWA ISZ WRLG. LDA WRLG.,I LDA 0,I CMA,INA STA COUNT SET COUNT ISZ WRLG. STEP TO THE BUFFER ADDRESS LDA WRLG. GET TO A LDA A,I AND TRACK DOWN INDIRECTS RAL,CLE,SLA,ERA JMP *-2 * INIT JSB .WRIN CALL TO INIT CLA FIRST TIME ONLY STA INIT SET IT WMOVE LDA WBFAD,I STA BFRAD,I MOVE WORD ISZ BFRAD POINTERS ISZ BCOUN BUMP SECTOR-BUFFER COUNT JMP NOEND NOT END OF BUFFER * JSB EFLG. END OF BUFFER, WRITE SECTOR DEF *+1 SZA IF OK JUST CONTINUE JMP EXIT,I ELSE EXIT A,B = CODE * NOEND ISZ WBFAD BUMP ISZ COUNT BUMP COUNTER JMP WMOVE CONTINUE TRANSFER * CLA SHOW NO ERROR JMP EXIT,I READY, EXIT SPC 1 EXIT NOP RETURN ADDR PSIZE DEC 128 DM128 DEC -128 D2 DEC 2 D2I DEF 2,I WLUN NOP LUN TRACK NOP CURRENT TRACK NO SECTR NOP CURRENT SECTOR NO BFRAD NOP CURRENT ADDR IN WRITE-BUFFER WBFAD NOP CURRENT SOURCE-BUFFER ADDR COUNT NOP TRANSFER COUNT BCOUN NOP B EQU 1 A EQU 0 END * * ASMB,L HED J.PUT * NAME: J.PUT * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 J.PUT,8 92002-16006 740801 ENT J.PUT EXT $LIBR,$LIBX EXT .ENTR * * J.PUT IS CALLED TO REQUEST A TRACK FOR THE FMGR * * THE CALL IS: * * CALL J.PUT(TAT1,CD,ER) * * >r W H E R E: * * TATA1 IS THE ADDRESS OF THE TAT WORD FOR THE DESIRED TRACK * CD IS THE CODE TO BE SET IN THE TAT. * ER IS 0 IF SUCCESSFUL OR NON-ZERO IF NOT. * * IF THE ERROR RETURN IS MADE NO TRACK WILL BE ASSIGNED. * * TATA1 NOP CD NOP ER NOP JPUT NOP JSB .ENTR DO ENTRY DEF TATA1 JSB $LIBR INHIBIT CHANGES NOP WHILE WE WORK LDB TATA1,I GET HIGH END OF TAT NEX LDA B,I GET CURRENT ASSIGNMENT SZA IF AVAILABLE CPA GLOBL OR GLOBAL CCA,RSS SKIP A _ -1 JMP EXIT ELSE ERROR RETURN LDA CD,I GET THE DESIRED CODE STA B,I SET IN TAT EXIT1 CLB SET B FOR GOOD ASSIGNMENT EXIT STB ER,I IT IS TRACK ON LU3 - SO SET IT JSB $LIBX EXIT DEF JPUT TO CALLER SPC 2 GLOBL OCT 77776 SPC 2 J.PUT EQU JPUT A EQU 0 B EQU 1 SPC 1 ENQ EQU * SPC 1 END ASMB,R,B,L HED IPUT * NAME: IPUT * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 IPUT,6 92002-16006 740801 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 ASMB,R,L,C HED WRIS$ * NAME: WRIS$ * SOURCE: 92002-18006 * RELOC: 92002-16006 * PGMRa: 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 WRIS$,7 92002-16006 740801 ENT WRIS,IWRIS,WEOFS EXT %WRIS,%WRIN,%WEOF EXT .ENTR * THIS ROUTINE IS USED TO CALL THE WRITE SOURCE ROUTINE * FROM A FORTRAN PROGRAM * INITILIZE CALL * CALL IWRIS(IER) IER=0 IF OK -1 IF NO TRACKS * WRITE CALL * CALL WRIS(BUF,L,ER) BUFFER ,LENGTH(-CHARACTERS),ER SAME AS ABOVE * TERMINATE CALL * CALL WEOFS SPC 3 BUF NOP L NOP ER NOP WRIS NOP JSB .ENTR DEF BUF LDA BUF GET THE BUFFER ADDRESS STA BA SET IF FOR THE CALL LDA L,I GET THE LENGTH STA L SET IT JSB %WRIS CALL TO TRANSFER DEF RT BA NOP DEF L CCA,RSS NO TRACK RETURN RT CLA NORMAL RETURN STA ER,I SET ERROR CODE JMP WRIS,I RETURN SPC 2 IER NOP IWRIS NOP JSB .ENTR DEF IER JSB %WRIN MAKE INITILIZE CALL CCB,RSS NO DISC RETURN CLB OK RETURN STB IER,I SET ERROR CODE JMP IWRIS,I RETURN SPC 3 WEOFS NOP JSB %WEOF WRITE THE END OF FILE LDA WEOFS,I GET THE RETURN ADDRESS JMP A,I RETURN SPC 2 A EQU 0 B EQU 1 END ASMB,R,L HED BUMP ROUTINE * NAME: BUMP * SOURCE: 92002-18006 * RELOC: 92002-16006 * PGMR: G.A.A. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975. ALL RIGHTS * * *3 RESERVED. 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 BUMP.,8 92002-16006 741025 ENT BUMP. EXT $BATM,.ENTR A EQU 0 * T1 NOP T2 NOP BUMP. NOP JSB .ENTR FETCH PARAM ADDRS DEF T1 * LDA T1 INA STA T3 SAVE ADDR OF SECOND WORD DLD $BATM FETCH BATCH TIME CMA,CLE,INA COMPLEMENT CMB,SEZ CLE,INB CLE SET UP FOR NEXT ADD ADA T2,I SUBTRACT FROM PREVIOUS TIME ISZ T2 TO GET ELAPSED TIME SEZ,CLE INB ADB T2,I CMA,CLE,INA COMPLEMENT CMB,SEZ A DOUBLE INTEGER CLE,INB CLE SET UP FOR NEXT ADD ADA T1,I SUBTRACT FROM TIME LIMIT SEZ TO GET TIME LIMIT LEFT. INB ADB T3,I DST T1,I RETURN NEW LIMIT TO CALLER JMP BUMP.,I * T3 NOP * BSS 0 SIZE OF BUMP. END ASMB,R,L HED SET.T ROUTINE * NAME: SET.T * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 SET.T,8 92002-16006 740801 ENT SET.T EXT $LIBR,$LIBX,.ENTP,$BATM SUP * NT NOP OT NOP SET.T NOP JSB $LIBR PRIVILEGED SUBROUTINE NOP JSB .ENTP FETCH PARAM ADDRS DEF NT LDA XEQT IF NOT-> IN BATCH ADA D20 THEN LDA A,I DO NOT SET UP SSA,RSS BATCH FLAG SET? JMP EX NO * DLD $BATM FETCH BATCH TIME DST OT,I RETURN IT AS OLD TIME DLD NT,I FETCH NEW TIME DST $BATM SET AS NEW BATCH TIME EX JSB $LIBX DEF SET.T RETURN. * D20 DEC 20 XEQT EQU 1717B A EQU 0 B EQU 1 BSS 0 SIZE OF SET.T END ASMB,R,L HED TL ROUTINE * NAME: TL. * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 TL.,8 92002-16006 760322 ENT TL. EXT TL.P,$BATM A EQU 0 * TL. NOP FUNCTION FALSE IF DLD TL.P $BATM < TL.P < 0 SSB,RSS OR IF TL.P < 0 AND $BATM > 0. JMP TEXIT LDA D$BA GET DIRECT ADDRESS RAL,CLE,SLA,ERA FOR SECOND WORD LDA A,I BATCH TIMER. INA STA T2 SAVE IT. LDB T2,I IF $BATM IS > 0 THEN SSB,RSS EXIT FALSE. JMP FEXIT DLD TL.P CMA,CLE,INA DO A COMPARISON CMB,SEZ OF $BATM AND TL.P INB REMEMBERING THAT BOTH ADA $BATM ARE DOUBLE WORD SEZ INTEGERS. INB ADB T2,I SSB FEXIT CLA,RSS EXIT FALSE. TEXIT CCA EXIT TRUE (-1). JMP TL.,I * D$BA DEF $BATM T2 NOP * END ASMB,R,L HED ST.TM ROUTING * NAME: ST.TM * SOURCE: 92002-18006 * RELOC: 92002-16006 * PGMR: G.A.A. * * *********\C****************************************************** * * (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.TM,8 92002-16006 741223 ENT ST.TM EXT .ENTR A EQU 0 * * THE FOLLOWING ROUTINE SETS UP THE BATCH * TIME VALUES FOR :JO. * HOUR NOP MIN NOP * ST.TM NOP JSB .ENTR DEF HOUR LDA MIN CLE,INA LDA A,I FETCH NUMBER OF 10'S OF MPY D100 MILLISECONDS AND HOLD IT. STA SEC LDA HOUR,I GET NUMBER OF MINUTES MPY D60 ADA MIN,I AND MULTIPLY TO GET 10'S OF MPY D6000 MILLISECONDS. ADA SEC ADD TO PREVIOUS VALUE. SEZ COMPENSATE FOR DOUBLE WORD INB INTEGER. CMA,CLE,INA COMPLEMENT AND INCREMENT THE CMB,SEZ,CCE DOUBLE WORD INTEGER. INB RBL,ERB SET SIGN IN ANY CASE JMP ST.TM,I RETURN TIME IN A AND B * D100 DEC 100 D60 DEC 60 D6000 DEC 6000 SEC NOP * BSS 0 SIZE OF ST.TM END ASMB,R,L HED B.FLG ROUTINE * NAME: B.FLG * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 B.FLG,8 92002-16006 741118 ENT B.FLG * EXT $LIBR,$LIBX,.ENTP * PARAM NOP * B.FLG NOP JSB ]$LIBR NOP JSB .ENTP DEF PARAM LDB XEQT IF NOT FMGR ADB D12 THEN DO NOT SET LDA B,I THE FLAG CPA "FM" FIRST WORD CHECK INB,RSS OK SKIP JMP EX BAD NEWS * LDA B,I GET NEXT WORD CPA "GR" OK? INB,RSS YES SKIP JMP EX NO EXIT * LDA B,I GET LAST WORD AND C377 MASK TO HIGH ONLY CPA BL MAKE IT? RSS YES SKIP JMP EX NO EXIT * LDB PARAM,I LDA XEQT ADA D20 STA PARAM LDA PARAM,I IOR MASK SZB,RSS XOR MASK STA PARAM,I EX JSB $LIBX DEF B.FLG * MASK OCT 100000 D12 DEC 12 C377 OCT 177400 "FM" ASC 1,FM "GR" ASC 1,GR BL OCT 20000 A EQU 0 B EQU 1 D20 DEC 20 XEQT EQU 1717B * END ASMB,R,L HED LULU ROUTINE * NAME: LULU. * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 LULU.,6 92002-16006 760227 ENT LULU. * EXT .ENTP,$LUSW,$LIBR,$LIBX,.DRCT * * THE FOLLOWING ROUTINE MANIPULATES THE * BATCH LU TRANSFORM TABLE. * LU1 BSS 1 LU2 BSS 1 * LULU. NOP JSB $LIBR NOP JSB .ENTP DEF LU1 CLA STA ADDR JSB .DRCT DEF $LUSW STA 1 LDA 1,I GET SIZE OF TABLE CMA,INA AND FORM COUNTER. STA CNTR INB LDA LU1,I SZA,RSS IS LU1 ZERO? JMP RESET YES. GO RESET THE TABLE. LOOP1 LDA 1,I SEARCH THE TABLE FOR (LU1-1). SSA KEEP TRACK OF EMPTY ENTRIES. STB ADDR SAVE ADDRESS OF EMPTY ENTRY. AND B377 INA CPA LU1,I JMP GOTIT HAVE IT. INB ISZ CNTR JMP LOOP1 LDB ADDR DO WE HAVE AN EMPTY ENTRY? SZB,RSS JMP OUT NO. NO ROOM. GOTIT LDA LU2,I WAS THIS A CLEAR REQUEST? SZA JMP *+3 NO. CCA CLEAR THE ENTRY. JMP DEP LDA LU1,I ADA M1 ALF,ALF PUT THE NEW LU TRANSFORM XOR LU2,I INTO THE TABLE. ADA M1 ALF,ALF DEP STA 1,I ISZ LULU. OUT JSB $LIBX DEF LULU. RESET CCA RESET LU TABLE TO STANDARD STA 1,I DEVICES BY CLEARING THE ENTRIES. INB ISZ CNTR JMP RESET JMP OUT-1 * B377 OCT 377 ADDR BSS 1 CNTR BSS 1 M1 DEC -1 * END ASMB,R,L HED RANGE ROUTINE * NAME: RANGE * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 RANGE,8 92002-16006 740801 ENT RANGE * EXT .ENTR * FNUM NOP BUFR NOP * RANGE NOP JSB .ENTR DEF FNUM LDB FNUM,I LDA BUFR,I ALF,ALF ADA BUFR,I AND B377 CMA,INA ADA FNUM,I ISZ BUFR SSA JMP *+3 ISZ BUFR JMP RANGE+4 LDA BUFR,I JMP RANGE,I * B377 OCT 377 * END hTRNNTASMB,R,L HED ONOFF ROUTINE * NAME: ONOFF * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 ONOFF,8 92002-16006 750128 ENT ONOFF,FIT. * EXT .ENTR,CONV.,EXEC,J.NAM,.DRCT EXT OPEN.,WRITF,O.BUF,TMP.,.DFER * * JNAME BSS 1 TMVAL BSS 1 * ONOFF NOP JSB .ENTR DEF JNAME LDB JNAME,I SZB,RSS JMP OFFM JSB .DFER DEF JOBM+4 DEF JNAME,I JSB .DFER DEF J.NAM DEF JNAME,I LDA MONTH+2 STA ONOFM+1 LDA ON STA ONOFM+2 JMP CONVT OFFM JSB .DFER DEF JOBM+4 DEF J.NAM LDA OFF LDB OFF+1 STA ONOFM+1 STB ONOFM+2 CONVT LDA TMVAL ADA D3 STA SAVE JSB CONV. CONVERT HOURS. DEF *+4 DEF SAVE,I DEF TMES1 DEF D2 LDA TMVAL ADA D2 STA YEAR JSB CONV. DEF *+4 DEF YEAR,I DEF SAVE DEF D2 JSB .DRCT DEF TMES1+1 LDB SAVE JSB FIT. LDA TMVAL INA STA SAVE JSB CONV. DEF *+4 DEF SAVE,I DEF TMES2+1 DEF D2 JSB CONV. DEF *+4 DEF TMVAL,I DEF SAVE DEF D2 JSB .DRCT DEF TMES3 LDB SAVE JSB FIT. LDA TMVAL ADA D5 STA SAVE LDB 0,I CHECK FOR LEAP YEAR. CLE,ERB LDA RYTAB SEZ,SLB,RSS LDA LYTAB GET CORRECT TABLE ADDRESS. STA DAY JSB CONV. CONVERT YEAREY TO ASCII. DEF *+4 DEF SAVE,I DEF YEAR+1 DEF D4 LDA TMVAL ADA D4 STA SAVE CLB LOOP LDA DAY,I FIGURE OUT MONTH. SZA,RSS JMP ENDLP ADA SAVE,I SSA,RSS JMP ENDLP INB ISZ DAY JMP LOOP ENDLP INA STA SAVE BLS ADB MNTAB LDA 1,I STA MONTH INB LDA 1,I STA MONTH+1 JSB CONV. CONVERT DAY AND STORE. DEF *+4 DEF SAVE DEF DAY DEF D2 JSB .DRCT DEF TMP. ADA D3 STA PAR3 JSB OPEN. OPEN THE LIST FILE. DEF *+5 DEF O.BUF DEF TMP. PAR3 BSS 1 DEF D0 JSB WRITF DEF *+5 DEF O.BUF DEF SAVE1 DEF JOBM+1 DEF JOBM JMP ONOFF,I * ADDR BSS 1 SAVE1 BSS 1 FIT. NOP STA ADDR STB SAVE1 ASR 8 LDA ADDR,I RRL 8 BLF,BLF STB ADDR,I ISZ ADDR LDA SAVE1 ASL 16 LDA ADDR,I ALF,ALF RRL 8 STB ADDR,I JMP FIT.,I * D0 DEC 0 WRITE EQU * D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 ICNW OCT 6 SAVE BSS 1 * RYTAB DEF *+1 DEC -335 DEC -305 DEC -274 DEC -244 DEC -213 DEC -182 DEC -152 DEC -121 DEC -91 DEC -60 DEC -32 DEC -1 DEC 0 * LYTAB DEF *+1 DEC -336 DEC -306 DEC -275 DEC -245 DEC -214 DEC -183 DEC -153 DEC -122 DEC -92 DEC -61 DEC -32 DEC -1 DEC 0 * MNTAB DEF *+1 ASC 2, DEC ASC 2, NOV ASC 2, OCT ASC 2, SEP ASC 2, AUG ASC 2, JUL ASC 2, JUN ASC 2, MAY ASC 2, APR ASC 2, MAR ASC 2, FEB ASC 2, JAN * JOBM DEC 25 ASC 1, ASC 2,JOB BSS 3 ONOFM ASC 1, ASC 4,b AT TMES1 BSS 1 ASC 1,: TMES2 ASC 1, : BSS 1 TMES3 ASC 1,. ASC 1, ASC 1, O ASC 1,N DAY BSS 1 MONTH BSS 2 ASC 1, YEAR BSS 2 ON ASC 1,ON OFF ASC 2, OFF * END ASMB,R,L HED EX.TM ROUTINE * NAME: EX.TM * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 EX.TM,8 92002-16006 771115 ENT EX.TM * EXT $BATM,TM.VL,CONV.,IPUT,.DRCT EXT EXEC,FIT.,.ENTR,WRITF,O.BUF EXT FM.ER SUP A EQU 0 XEQT EQU 1717B * * THE FOLLOWING ROUTINE PRINT OUT TOTAL * EXECUTION TIME FOR THE CURRENT JOB. * EX.TM NOP JSB .ENTR DEF EX.TM DLD TM.VL CMA,CLE,INA CMB,SEZ INB DST SAVE1 DLD $BATM CLE ADA SAVE1 SEZ INB ADB SAVE2 DST SAVE1 CLA STA SAVE3 JSB .DRCT DEF $BATM STA HSEC INA STA SEC ** * LDA XEQT CHECK TO SEE IF BATCH FLAG SET ADA D20 LDA A,I ELA BATCH FLAG SET?? SEZ,RSS JMP NOBTH NOT SET SO DON'T TOUCH THE BATCH TIMER * JSB IPUT GO CLEAR THE FIRST WORD DEF *+3 DEF HSEC DEF SAVE3 JSB IPUT AND NOW THE SECOND WORD DEF *+3 DEF SEC DEF SAVE3 ** * NOBTH DLD SAVE1 * DIV D6000 STB SAVE3 CLB DIV D60 STA SAVE1 HOURS STB SAVE2 MINUTES LDA SAVE3 CLB DIV D100 STA SEC SECONDS STB HSEC HUNDREDTHS OF SECONDS JSB CONV. CONVERT AND STORE HOURS. DEF *+4 DEF SAVE1 DEF EXMS1 DEF D2 JSB CONV. CONVERT AND STORE MINUTES. DEF *+4 DEF SAVE2 DEF SAVE1 DEF D2 JSB .DRCT DEF EXMS1+1 LDB SAVE1 JSB FIT. JSB CONV. CONVERT AND STORE SECONDS. DEF *+4 DEF SEC DEF EXMS2+1 DEF D2 JSB CONV. CONVERT HUNDREDTHS OF SECONDS. DEF *+4 DEF HSEC DEF SAVE1 DEF D2 JSB .DRCT DEF EXMS2+2 LDB SAVE1 JSB FIT. JSB WRITF DEF *+5 DEF O.BUF DEF SAVE1 DEF EXMS+1 DEF EXMS JSB WRITF NOW DO TOP OF DEF *+5 FORM TO FINISH DEF O.BUF THE JOB DEF SAVE1 DEF EXMS+1 DEF N1 LDA SAVE1 IF ERROR ON LIST FILE SSA,RSS THEN JMP EX.TM,I * JSB FM.ER REPORT TO OPERATOR DEF EX DEF D2 DEF LISTO DEF D7 EX JMP EX.TM,I * EXMS DEC 15 ASC 9, EXECUTION TIME: EXMS1 BSS 1 ASC 1,: EXMS2 ASC 1, : BSS 1 ASC 1,. ASC 1, * N1 DEC -1 D1 DEC 1 D2 EQU * WRITE DEC 2 ICNW OCT 6 SAVE1 BSS 1 SAVE2 BSS 1 SAVE3 BSS 1 HSEC BSS 1 SEC BSS 1 D6000 DEC 6000 D100 DEC 100 D60 DEC 60 D20 DEC 20 * D7 DEC 7 LISTO ASC 7,LIST OVERFLOW! END ASMB,R,L HED FREES ROUTINE * NAME: FREE. * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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. * * ***********************N**************************************** * NAM FREE.,8 92002-16006 740801 ENT FREE. * EXT .ENTR * * NUMBR BSS 1 ADDR BSS 1 * FREE. NOP JSB .ENTR DEF NUMBR LDA NUMBR,I AND MASKL ALF,ALF CLB ADA M60 MPY D10 STA 1 LDA NUMBR,I AND B377 ADA M60 ADA 1 CMA,INA STA NUMBR LDB ADDR,I LOOP1 LDA M16 STA CNTR CLA,INA LOOP2 ISZ NUMBR JMP *+4 XOR 1,I STA 1,I JMP FREE.,I ISZ CNTR JMP *+3 INB JMP LOOP1 RAL JMP LOOP2 * CNTR BSS 1 M16 DEC -16 M60 OCT -60 D10 DEC 10 B377 OCT 377 MASKL OCT 177400 * END ASMB,R,L HED LU.CL ROUTINE * NAME: LU.CL * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 LU.CL,8 92002-16006 760702 ENT LU.CL * EXT LULU.,.ENTR,$LUSW,.DRCT,EXEC * * THE FOLLOWING ROUTINE GOES THROUGH THE $LUSW * TABLE AND CLOSES ALL SPOOL LU'S. * * LU.CL NOP JSB .ENTR DEF LU.CL JSB .DRCT DEF $LUSW STA ADDR LDB 0,I CMB,INB STB CNTR LOOP2 ISZ ADDR LDA ADDR,I SSA JMP LOOP1 * ALF,ALF GET THE DIRECT LU AND B77 INA STA LUNO JSB EXEC DEF *+5 DEF D23 DEF SMPA DEF D4 DEF LUNO LOOP1 ISZ CNTR JMP LOOP2 * JSB LULU. ALL CLOSED NOW CLEAR THE TABLE DEF *+2 DEUF ZERO ZERO NOP IGNOR ERROR RETURN JMP LU.CL,I RETURN * D4 DEC 4 D23 DEC 23 B77 OCT 77 ADDR BSS 1 CNTR BSS 1 LUNO BSS 1 SMPA ASC 3,SMP * END ASMB,R,L HED AVAIL ROUTINE * NAME: AVAIL * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 AVAIL,8 92002-16006 741231 ENT AVAIL,.LUAV * EXT .ENTR,$LUAV * ADDR NOP MASK NOP FNUM NOP * AVAIL NOP JSB .ENTR DEF ADDR LDA M5 STA SAVE1 CLA,INA STA FNUM,I LOOP1 LDB M16 STB SAVE2 LOOP2 STA MASK,I AND ADDR,I SZA,RSS JMP HAVIT ISZ FNUM,I LDA MASK,I RAL ISZ SAVE2 JMP LOOP2 ISZ ADDR ISZ SAVE1 JMP LOOP1 CLA STA FNUM,I JMP AVAIL,I HAVIT LDA MASK,I IOR ADDR,I STA ADDR,I JMP AVAIL,I * SAVE1 BSS 1 SAVE2 BSS 1 M5 DEC -5 M16 DEC -16 D2 DEC 2 DLUAV DEF $LUAV * .LUAV NOP LDA $LUAV GET THE TABLE COUNT SZA,RSS IF ZERO, JMP EX JUST EXIT * STA SAVE1 SET THE COUNTER LDA .LUAV,I GET THE PRAM ADDRESS STA AVAIL AND SAVE IT LDB DLUAV GET THE TABLE ADDRESS RBL,CLE,SLB,ERB MAKE DIRECT LDB B,I GET ADDRESS INB STEP TO FIRST WORD AVLOP LDA B,I GET THE ENTRY AND B77 CPA AVAIL,I HERE? JMP EX YES GO EXIT * ADB D2 NO STEP TO NEXT ENTRY ISZ SAVE1 IS THERE ONE?  JMP AVLOP YES GO TRY IT * CLA MAKE OK EXIT EX ISZ .LUAV STEP TO RETURN ADDRESS JMP .LUAV,I AND RETURN * B77 OCT 77 A EQU 0 B EQU 1 END ASMB,R,L,C HED READ ROUTINE * NAME: READ * SOURCE: 92002-18006 * RELOC: 92002-16006 * 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 READ.,7 92002-16006 740801 ENT READ. EXT %READ,.ENTR * * * READ. IS AN INTERFACE ROUTINE TO CALL THE * READS ROUTINE FROM FORTRAN. * * THE CALL IS: * * CALL READ.(LU,BUF,RQLN,RTNLN) * * W H E R E: * * LN IS THE LOGICAL UNIT. * BUF IS THE USER'S BUFFER * RQLN IS THE REQUEST LENGTH IN WORDS. * RTNLN IS THE RETURN LENGTH IN WORDS. * * ON END OF FILE RTNLN IS SET TO -1. * * LU NOP BUF NOP LN NOP L NOP READ. NOP JSB .ENTR GET PARAMETERS DEF LU LDA LN,I SET LENGTH CMA,INA TO NEGATIVE ALS CHARACTERS STA LN AND STORE JSB %READ CALL READS ROUTINE DEF *+5 NORMAL RETURN DEF LU,I LU DEF BUF,I BUFFER DEF LN LENGTH CCB,RSS EOF RETURN - SET TLOG TO -1 INB NORMAL RETURN ROUND UP BRS CONVERT TO WORDS STB L,I STORE IN USER AREA JMP READ.,I RETURN END ]0.**0SPL,L,O ! NAME: FID. ! SOURCE: 92002-18006 ! RELOC: 92002-16006 ! PGMR: G.A.A. ! DATE: 740801 ! ! *************************************************************** ! * (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 FID.(8) 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$ SPL,L,O ! NAME: MSC. ! SOURCE: 92002-18006 ! RELOC: 92002-16006 ! PGMR: G.A.A. ! DATE: 740801 ! ! *************************************************************** ! * (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 MSC.(8) ! THIS ROUTINE CHECKS THE PASSED PARAMETER AGAINST THE ! SYSTEM MASTER SECURITY CODE ! LET D.RIO BE SUBROUTINE,EXTERNAL LET D.SDR BE INTEGER,EXTERNAL MSC.: FUNCTION(LST)GLOBAL ! RETURNS 1 IF GOOD 0 IF BAD D.RIO(1) !READ THE DIRECTORY OF DISCS IFNOT [T_$(@D.SDR+126)] THEN GO TO GOOD IF $(@LST+1)=T THEN [GOOD: RETURN 1] RETURN 0 END END END$ SPL,L,O ! NAME: LOCK. ! SOURCE: 92002-18006 ! RELOC: 92002-16006 ! 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 LOCK.(8)"92002-16006 771118" ! ! THIS ROUTINE OBTAINS A LOCK AND RELEASES IT ON THE ! GIVEN DISC LET MSS.,EXEC,RMPAR BE SUBROUTINE, EXTERNAL LET DS.DF,D. BE INTEGER,EXTERNAL LET BREG(5) BE INTEGER INITIALIZE A,B,XEQT TO 0,1,1717K ! ! LOCK.:SUBROUTINE(DSID,RQ)GLOBAL,FEXIT !ROUTINE TO REQUEST AND ! RELEASE DISC LOCKS LOCK: EXEC(23,D.,$XEQT,0,DSID,0,RQ) !CALL D.RTR TO GET THE LOCK RMPAR(BREG) IF BREG(1) THEN[MSS.(BREG);FRETURN]! IF ERROR THEN ERROR RETURN DS.DF_0 ! CORE COPY IF ANY IS WRONG NOW RETURN! ELSE GO NORMAL RETURN END END END$ SPL,L,O ! NAME: FM.UT ! SOURCE: 92002-18006 ! RELOC: 92002-18006 ! 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 FM.UT(8) "92002-16006 781103 REV.1901" ! LET EXEC,MSS.,RMPAR BE SUBROUTINE,EXTERNAL LET D.RIO,DR.RD,DR.SU BE SUBROUTINE LET FM.AB BE LABEL,EXTERNAL LET MSC. BE FUNCTION LET IFLG. BE INTEGER,EXTERNAL LET D.SDR,PK.DR BE INTEGER(128),GLOBAL LET DS.LU,D.LT,D.LB BE INTEGER,GLOBAL LET D. BE INTEGER,EXTERNAL LET DS.DF,DS.F1 BE INTEGER,GLOBAL LET DT(5) BE INTEGER INITIALIZE DS.DF,DS.F1 TO 0,0 LET READI BE CONSTANT(1 ) LET XEQT BE CONSTANT(1717K) LET TEMP BE CONSTANT(1721K) LET PRC BE CONSTANT(74000K) LET TATSD BE CONSTANT(1756K) LET WRIT BE CONSTANT(2 ) LET A BE CONSTANT (0) LET B BE CONSTANT (1) ! ! CHANGE 781103 GLM TO SEARCH ONLY CARTRIDGE DIRECTORY INFORMATION ! I.E., DON'T SCAN MASTER SECURITY CODE WHEN ! LOOKING FOR A DISC. ! ! D.RIO:SUBROUTINE(RCODE) GLOBAL !READ DISC DIRECTORY IF DS.DF THEN[IF RCODE=READI THEN RETURN]!IF IN DO[TRAK_$TATSD-1;T_0]!PRESET FOR DIRECT ACCESS IFNOT IFLG. THEN[IF RCODE=WRIT THEN \!CAN NOT USE DIRECT CALL [DR.SU(D.SDR,-65,100000K,7);GOTO DIR02]]!USE D.RTR DIR0: EXEC(RCODE,74002K,D.SDR,128,TRAK,0)!WRIT/READ THE BLOCK BREG_$B !IF TLOG#128 THEN ERR IF BREG#128 THEN [MSS.(1001,2);GOTO FM.AB] DIR02:DS.DF_1 !SET IN CORE FLAG AND 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. FEXIT2 IS TAKEN IF THE ! DISC CANNOT BE FOUND OR IF THE END ! OF THE DIRECTORY IS REACHED. ! ! NOABT _ 100000K ! IF DISID=DS.F1 THEN[IF RCOD=WRIT THEN[IFNOT BLK THEN\ GOTO DIRR2];GOTO DRRD1] D.RIO(READI) IF DISID<0 THEN[DLU_-DISID;T_0], \ ELSE[DLU_DISID;T_2] FOR I_0 TO 120 BY 4 DO[IF$(@D.SDR+I+T)=DLU\ *781103* THEN GOTO DIRR0] EXITF:FRETURN ! EREX: MSS.(-1006,$DS.LU) GOTO FM.AB ! ! THE DISID HAS BEEN FOUND SO READ IN BLK0 DIRR0:D.LB_[D.LT_[DS.LU_@D.SDR+I]+1]+1 ! SET POINTERS DIRR6:TX_[IF $DS.LU=2 THEN 14 ,ELSE 0] IF RCOD=WRIT THEN[IFNOT BLK THEN GO TO DIRR2] EXEC(NOABT+READI,PRC+$DS.LU ,PK.DR,128,$D.LT,TX) GOTO EREX !DRIVER REJECTED CALL. DO[BREG_$B;IF BREG#128 THEN[MSS.(1001,$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) !SET NO. OF SECTORS ! IF (BLK=0) AND (RCOD=READI) THEN GO TO EXIT ! CALCULATE THE SECTOR ADDRESS DRRD1:TR_(BLK*14+TX)/DS.SC !COMPUTE THE SECTOR ADDRESS T_$1 !SET IN T TR_TR/7 !RELATIVE TRACK TO TR IF (TR+DISNT)> -1 THEN GO TO EXITF TR_$D.LT-TR !SET THE TRACK ADDRESS IN TR ! ! READ/WRITE IFNOT IFLG. THEN[IF RCOD =WRIT THEN[\ DR.SU(PK.DR,DISID,BLK,9);GOTO EXIT ]]!USE D.RTR IF NEEDED ! DRRD4:EXEC(NOABT+RCOD,PRC+$DS.LU,PK.DR,128,TR,T) GOTO EREX !DRIVER REJECTED CALL. BREG_$B !TEST FOR ERRORS IF BREG#128 THEN[MSS.(1001,$DS.LU); GOTO FM.AB] EXIT: RETURN !RETURN END ! DR.SU:SUBROUTINE(BUF,ID,RS,CD) ! THIS ROUTINE WRITES ON A DIRECTORY SECTOR BY: ! CALLING THE SYSTEM FOR ONE TRACK ! WRITING THE SECTOR THERE ! PASSING THE TRACK TO D.RTR ! RETURNING THE TRACK ! EXEC(4,1,TR,LU,FLG)!GEWT TRACK DRSU0:EXEC(2,LU,BUF,128,TR,0)!WRITE THE SECTOR DO[BREG_$B; IF BREG#128 THEN[MSS.(1001,LU);GO TO FM.AB]]!ERRORS?? ! DRSU2:EXEC(23,D.,$XEQT,(TR-<6)+LU,ID,RS,CD)!CALL D.RTR TO WRITE THE SEC EXEC(5,1,TR,LU)!RETURN THE TRACK RMPAR(DT) IF DT(1) THEN [MSS.(DT);GO TO FM.AB]! IF ERROR ABORT RETURN END END END$ SPL,L,O ! NAME: CREA. ! SOURCE: 92002-18006 ! RELOC: 92002-16006 ! PGMR: G.A.A. ! DATE: 740801 ! ! *************************************************************** ! * (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 CREA.(8) LET CLOS.,CREAT,IER. BE SUBROUTINE,EXTERNAL LET .E.R. BE INTEGER,EXTERNAL CREA.:SUBROUTINE(DCBR,LUR,PPLIS) GLOBAL,FEXIT CLOS.(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$ SPL,L,O ! NAME: CK.SM ! SOURCE: 92002-18006 ! RELOC: 92002-16006 ! PGMR: G.A.A. ! DATE: 740801 ! ! *************************************************************** ! * (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 CK.SM(7) "92002-16006 REV. 1805 771205" ! CK.SM:SUBROUTINE(BF,TYP)GLOBAL,FEXIT !CHECK;~SUM 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 OR TT<0 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$ ASMB,R,L HED CHECK ID ROUTINE * NAME: CK.ID * SOURCE: 92002-18006 * RELOC: 92002-16006 * * *************************************************************** * * (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 CK.ID,7 92002-16006 REV.1826 780403 ENT CK.ID EXT .ENTR,$OPSY * * THIS ROUTINE VALIDATES AN ID SEGMENT ADDRESS. * * CALLING SEQUENCE: JSB CK.ID * DEF *+2 * DEF ID ID SEGMENT ADDRESS * * RETURN: E=0 VALID ID SEGMENT ADDRESS * E=1 INVALID ID SEGMENT ADDRESS * ID NOP CK.ID NOP JSB .ENTR DEF ID LDA ID,I FETCH ID SEGMENT ADDRESS SZA,RSS ZERO? JMP CKID1 YES LDB $OPSY OP SYSTEM IDENTIFIER ERB,ERB GET MAPPED BIT TO E LDB KEYWD MAKE SURE THE ADDRESS POINTS STB IADDR TO A VALID ID SEGMENT NEXT SEZ MAPPED SYSTEM? JMP XLOAD YES, CROSS LOAD OF IDSEG ADDRESS LDB IADDR,I NO, DIRECT LHOAD OF IDSEG ADDRESS TEST CPB 0 DOES IT MATCH THIS ONE? JMP CKID2 YES, ITS VALID ISZ IADDR NO, TRY THE NEXT ONE SZB END OF KEYWORD BLOCK? JMP NEXT NO, CONTINUE CKID1 CCE,RSS INVALID ID SEGMENT ADDRESS CKID2 CLE VALID ID SEGMENT ADDRESS JMP CK.ID,I RETURN * XLOAD XLB IADDR,I NEXT IDSEG ADDR FROM KEYWORD BLOCK JMP TEST CONTINUE * KEYWD EQU 1657B IADDR BSS 1 * END ASMB,R,L,C HED "IDSGA" FTN/SPL FUNCTION TO FIND IDSEG ADDRESS OF PROG * SOURCE: 92002-18008 * RELOC: 92002-16008 * PGMR: D.L.B. * * *************************************************************** * * (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 ID.A,6 92002-16008 REV.1826 780403 ENT ID.A ENT IDSGA EXT .ZPRV,$OPSY * CALLED: * IDSEG = IDSGA(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 BELIEVE THAT THIS ROUTINE IS COMPATABLE WITH ID.A) * NOTE: IF NAME IS NULL THEN FIND BLANK IDSEG ADDRESS. SPC 1 IDSGA NOP ENTRY FTN CALLING SEQUENCE ID.A EQU IDSGA JSB .ZPRV DO THE $LIBR THING DEF LIBX ISZ IDSGA AVOID .ENTR,.DFER LDB IDSGA 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 ADD%RESS 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 $OPSY OP SYSTEM IDENTIFIER ERB MOVE MAPPED BIT FOR SLA STB STYPE SAVE FOR LOADA ROUTINE 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 LDB POINT GET ID SEGMENT ADDRESS JSB LOADA OF NEXT PROGRAM STA B CCE,SZB,RSS CHECK IF LAST ENTRY JMP ENDTA YES, NOT FOUND PROGRAM ADB D12 POINT TO PROGRAM NAME AREA JSB LOADA GET CHARS 1 & 2 CPA NAME,I EQUAL ? INB,RSS YES, CHECK NEXT 2 JMP LOOP NO, TRY NEXT PROGRAM JSB LOADA GET CHARS 3,4 CPA NAME+1,I EQUAL? INB,RSS YES, BUMP AGAIN JMP LOOP NO, TRY NEXT PROGRAM JSB LOADA GET LAST CHAR AND OM400 MASK TO 5TH CHAR CPA NAME+2 RSS FOUND! JMP LOOP TRY NEXT PROG LDB POINT JSB LOADA RETURN A=ID SEGMENT ADDRESS CLB,CLE ENDTA ISZ IDSGA SET RETURN POINT E=FOUND FLAG LIBX JMP IDSGA,I P+3 DEF IDSGA FOR JSB $LIBX * LOADA NOP DOES XLA B,I IF MAPPED SYSTEM LDA STYPE OP SYSTEM IDENTIFIER (AFTER ERB) SLA MAPPED SYSTEM? JMP MAPSY YES, DO CROSS-MAP LOAD LDA B,I NO, DO DIRECT LOAD JMP LOADA,I RETURN MAPSY XLA B,I CROSS-MAP LOAD (2-WD INSTRUCT.) JMP LOADA,I RETURN SPC 1 NAME REP 3 NOP POINT NOP STYPE NOP OM400 OCT -400 D12 DEC 12 KEYWD EQU 1657B B EQU 1 END SPL,L,O ! NAME: CNT. ! SOURCE: 92002-18006 ! RELOC: 92002-16006 ! 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 CNT.(8) "92002-16006 760520" ! ! ! THE FOLLOWING IMPLEMENTS THE CONTROL COMMAND. ! ! :CN [[[,NAMR][,FUNCTION][,SUB-FUNCTION]]] ! LET OPEN., \OPEN FILE OR LU FCONT, \SEND CONTROL FUNCTION EXEC \SYSTEM I/O BE SUBROUTINE,EXTERNAL ! LET O.BUF, \DCB BUFFER N.OPL \SUB-PARAMETER STORAGE 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.(O.BUF,$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] #<:6THEN [ \END OF TABLE? PRMER: ERR _ 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(O.BUF,ERR,FUNC,$SUBFN) !SEND THE CONT. FUNC. IF ERR = -12 THEN ERR _ 0 RETURN DEFLT: PTR _ @O.BUF + 3 !FUNCTION NOT SUPPLIED. CALL EXEC(100015K,$PTR,EQ5,NAMR,FUNC)!GET DEVICE TYPE. GO TO ERR20 !BAIL OUT IF ERROR ( NEVER HAPPEN) IF [EQ5 _ EQ5 AND 37400K] > 7000K THEN [ \IF TYPE > 16 RWCD: FUNC_FTAB1; GOTO SUBFU ] !USE REWIND IF EQ5 = 2400K THEN[ \IF DVR05 CHECK IF [FUNC _ FUNC AND 7] = 1 THEN GO TO RWCD; \IF CASSET USE REWIND IF FUNC = 2 THEN GO TO RWCD] !IF CASSET USE REWIND FUNC_$(PTR+1) !ELSE USE DEFAULT EOF GO TO SUBFU ! ERR20: ERR _ 20; RETURN !ILLEGAL LU ERROR. END END END$ ;H< 3] 92002-18007 1926 S 0222 &D.RTR              H0102 DASMB,R,L,C,Q HED RTE FILE MANAGER DIRECTORY ROUTINE **************** * NAME: D.RTR * SOURCE: 92002-18007 * RELOC: 92002-16007 * 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 D.RTR,2,1 92002-16007 REV.1926 790502 EXT EXEC,PRTN,$OPSY,P.PAS SUP * RTE FMP DIRECTORY ROUTINE NOV/72**GAA * MODIFIED TO REUSE DISC SPACE MAR/76**GAA * MODIFIED TO USE RTE-IV TABLE AREA 2 OCT/77**BL * MODIFIED TO TRUNCATE TYPE 6 FILES JAN/78**GLM / * CORRECTLY * MODIFIED TO MAKE ALL I\O REQUESTS APR/78**GLM * WITH "NO-ABORT" * MODIFIED TO PREVENT CREATION OF APR/78**GLM * ZERO LENGTH FILES * MODIFIED TO PREVENT THE REUSE OF NOV/78**GLM * TYPE ZERO DIRECTORY ENTRIES * MODIFIED TO CORRECTLY CREAT FILES MAY/79**GLM * ON MULTI-DISC SEARCHES. * * * 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. 1,ID CALLER'S ID SEGMENT ADDRESS WITH SIGN BIT SET * P2. E,NAME(1,2) E(BIT 15) INDICATES EXCLUSIVE OPEN IF SET * P3. 0,NAME(3,4) * P4. 0,NAME(5,6) * P5. -LU,+CARTRIDGE LABEL,0 IF ZERO SEARCH ALL MOUNTED CARTRIDGES * * 2. CLOSE * P1. ID CALL=ER'S ID SEGMENT ADDRESS * P2. 0,-(NO. SECTORS TO BE DELETED),+ PURGE EXTENTS ONLY * P3. TR,LU * P4. OFFSET,SECTOR / DIRECTORY ADDRESS * P5. 0 INDICATES CLOSE * * 3. CREAT * P1. ID * P2. TR,LU DATA TRACK ADDRESS * P3. -LU,+CARTRIDGE,0 SEE 1.P5. * P4. * P5. 1 INDICATES CREAT * * 4. CHANGE NAME * P1. ID * P2. TR,LU DATA TRACK ADDRESS * P3. TR,LU \ * P4. OFFSET,SECTOR \ DIRECTORY ADDRESS OF FILE BEING RENAMED * P5. 2 INDICATES NAME CHANGE CALL * * 6. SET,CLEAR LOCK ON DISC * P1. ID * P2. * P3. -LU,+CARTRIDGE (0 NOT LEGAL) DISC TO BE LOCKED * P4. * P5. 3 FOR SET 5 FOR CLEAR * * 7. GENERATE,PACK,UPDATE CALL * P1. ID * P2. TR,LU DATA TRACK ADDRESS * P3. -LU,+CARTRIDGE (0 NOT LEGAL) DISC TO BE UPDATED * P4. S,#SEC/TRACK S(BIT 15)=1 IF DISC DIRECTORY UPDATE * P5. 7 INDICATES GENERATE CALL. * * 8. EXTENSION OPEN * P1. ID * P2. EXTENSION NUMBER * P3. TR,LU \ * P4. OFFSET,SECTOR \DIRECTORY ADDRESS OF MASTER ENTRY * P5. 6,8 INDICATES EXTENSION REQUEST (READ,WRITE) * * 9. PACK * P1. ID * P2. TR,LU DATA TRACK ADDRESS * P3. -LU,+CARTRIDGE SEE GENERATE * P4. RELATIVE DIRECTORY SECTOR (1 ONLY) TO BE CHANGED * P5. 9 SKP * DATA TRACK FORMAT FOR CREAT AND CHANGE NAME * 1. NAME(1,2) \ * 2. NAME(3,4) > OR NEW NAME * 3. NAME(5,6) / * 4. TYPE * 5. * 6. * 7. #SECTORS REQUESTED OR -1 FOR REST OF DISC * 8. RECORD SIZE (TYPE 2 FILES) * 9. SECURITY CODE * * * 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 * WWR4. TR(LU IF TYPE 0)/ FILE ADDRESS ON OPEN & CREATE CALLS * R5. #SEC/TR,SECTOR / * * IF R1=-99 (EXEC REJECTED I\O REQUEST) R2 & R3 = ERROR CODE * RETURNED BY EXEC * * 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 * -99 EXEC REJECTED AN I\O REQUEST *780413) * * -101 ILLEGAL PARAMETERS IN CALL * -102 ILLEGAL CALL SEQUENCE (LOCK NOT REQUESTED FIRST) SKP BUF BSS 128 CNT NOP DEST NOP PRAMA DEF P1 N5 DEC -5 .20 DEC 20 P1 NOP P2 NOP P3 NOP P4 NOP P5 NOP SPC 2 BEGIN LDA PRAMA PARAMETER DESTINATION ADDR STA DEST SAVE IT LDA N5 PARAMETER COUNT STA CNT LDA $OPSY FETCH SYSTEM IDENTIFIER ERA MOVE "MAPPED" BIT TO SLA STA STYPE SAVE FOR LOADA ROUTINE LOOP JSB LOADA GET NEXT PARAMETER STA DEST,I SAVE IN P1 TO P5 ISZ DEST BUMP DESTINATION ADDR INB BUMP TO NEXT PARAMETER ISZ CNT BUMP PARAMETER COUNT JMP LOOP SPC 1 LDA P1 GET THE FIRST PRAM RAL,CLE,ERA LIST; CLEAR POSSIBLE SIGN BIT STA ID SAVE ID SEG ADDRESS PASSED IN CALL * LDB XEQT GET ID ADDRESS ADB .20 ADVANCE TO FATHER INFO JSB LOADA AND FETCH IT RAL POSITION FATHER WAIT BIT TO SIGN SSA,RSS CONTINUE ONLY IF FATHER IS WAITING JMP EXIT2 NOT WAITING--ILLEGAL CALL * RAR REPOSITION ID# OF FATHER AND B377 ISOLATE IT CCB B=-1 ADB A COUNT FROM 0(USE B FOR LOADA ROUTINE) ADB KEYWD ADD TO TABLE OF ID SEGS JSB LOADA FETCH ID SEG ADDR OF CALLER CPA ID MUST MATCH VALUE PASSED IN P1 CLB,RSS OK JMP EXIT2 --NOPE --ERROR (BAD CALL) * STB FIRST CLEAR THE FIRST FLAG STB TMP1 LDA ABUF 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 ABUF. 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 P5 GET THE ID -BIT 15 INDICATE DISC LDB P1 ID IN P5 SSB ID IN P5? JMP LOCK0 YES; SKIP CCE,SLA,RSS NO; P5 IS FUNCTION EVEN? JMP LOCK3 YES; GO EXTRACT LU LDA P3 NO; LU IS IN P3 LOCK0 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 JSB RDPS READ THE PARAMETER SECTOR LDA TMP2 SET THE FOUND BIT IN E IF CMA,CLE,INA A ZERO ID LDB DIRAD GET CURRENT DIRECTORY ADD. LOCK2 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 * LOCK3 LDA P3 LU AND TRACK IN P3 AND B77 MASK TO LU STA TMP2 SAVE LU STA TMP1 *790501* STA B SAVE LU IN B FOR TEST XOR P3 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 * 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 F# SZA,RSS MULTI-DISC SEARCH JMP NEXT CONTINUE JMP EX13 ELSE EXIT LOCKED DISC SPC 2 DECOD CCA SET THE NONE FOUND YET STA R1 FOR REUSABLE DISC SPACE ROUTINE LDA P1 IF OPEN SSA REQUEST JMP OPEN GO OPEN LDA P5 ELSE SSA CHECK REQUEST CODE JMP EX101 NEGATIVE - EXIT ADA N10 SSA,RSS JMP EX101 GREATER THAN 9 - EXIT ADA TABAD INDEX INTO THE FUNCTION JMP A,I GO EXECUTE THE FUNCTION SPC 2 TABAD DEF TABA+10 TABA JMP CLOSE 0 JMP CREAT 1 (JMP CNAM 2 JMP RLOCK 3 JMP EX101 4 JMP ULOCK 5 JMP EXOPN 6 JMP GEN 7 JMP EXOPN 8 JMP PACK 9 SKP * * RDPS READ THE DISC DIRECTORY * RDPS OCT -1 JSB WCSR WRITE CURRENT SECTOR BLOCK LDA .2 A_2 *780413* STA DRLU SET FOR LU2 - SYS DISC CCA COMPUTE LAST TRACK ADA TATSD ADDRESS AND STA TRACK SET CLA SET SECT ADDRESS TO STA SECT ZERO JSB RWSUB READ THE BLOCK JMP RDPS,I RETURN 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 LDA DS1 RESET REQUEST CODE TO *780413* STA RW READ (NO-ABORT) JMP WCSR,I AND EXIT (A=1) SPC 2 DS1 OCT 100001 RW NOP DRLU NOP SKP * * RWSUB ROUTINE TO READ OR WRITE A TWO-SECTOR BLOCK * RWSUB NOP DLD RW FETCH THE NEW POINTERS ADB PRC 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 JMP ERR99 EXEC REJECTED CALL -- EXIT *780413* 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 SKP OPEN DLD P3 SET NAME WORDS 2 AND 3 DST NAME+1 INTO THE NAME BUFFER LDA P2 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 CPB .7 THEN NO ROOM SO JMP EX8 EXIT LDA P2 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 P1 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 OPEN6 LDA #SEC,I ELSE SEND BACK THE FILE SIZE CREX JSB RPRM SET THE RETURN PRAMS EXIT JSB WCSR WRITE THE SECTOR JSB PRTN PASS THE RETURN PRAMS DEF *+2 AND DEF R1 THEN EXIT2 JSB EXEC COMPLETE (SERIALLY REUSABLE) DEF *+4 DEF .6 DEF .0 DEF N1 N1 DEmZC -1 .0 NOP PP SKP * * EXTENSION OPEN ROUTINE * EXOPN JSB DIRCK GO READ IN THE MASTER DIRECTORY ENTRY CLA CLEAR THE STA ID OPEN FLAG WORD LDA P2 SET THE SZA,RSS IF AFTER THE MAIN THEN JMP OPEN4 WE HAVE IT ALREADY * AND B377 CHECK IF EXTENT>255? CPA P2 YES ? NO? ALF,SLA,ALF NO EXTENSION NO. FOR POSSIBLE JMP EX6 YES GO EXIT ERROR -6 * 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 P2 THIS IT? JMP OPEN4 YES SO GO RETURN THE PRAMS CSER LDA TYPE NO SO CONTINUE JMP NSHR4 THE SEARCH SPC 1 EXOPT LDB P5 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 .10 DEC 10 .8 DEC 8 8B .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 #SECT 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 CPA .2 IF LU=2 CLA,RSS USE ZERO LDA N14 ELSE -14 (UDAD ADDS 14) STA SECT SET THE SECTOR JMP SETDR,I RETURN N14 DEC -14 SKP ll * N.SHR DIRECTORY SEARCH ROUTINE * TARGET NAME IN NAME UNL PRC OCT 74000 LST * RETURNS: * P+1 END OF DIRECTORY A=NEXT ADDR. (IF A=0 END OF SPACE) * 7 P+2 FOUND RETURN A=ENTRY ADDR. * N.SHR NOP NSHR 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 LDB A,I IF PURGED ENTRY INB,SZB,RSS THEN JMP CKRUS CHECK IF REUSABLE * NSHR2 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 ADA .13 NO; SET FOR NEXT ENTRY NSHR5 ISZ COUN1 DONE WITH BLOCK? JMP NSHR1 NO; DO NEXT ENTRY * JMP NSHR YES; GO READ NEXT BLOCK * NSHR3 ADB N.SHR FOUND - STEP RETURN ADDRESS ADA N3 ADJUST TO START OF ENTRY JMP B,I RETURN * * *781103* CKRUS ADA .3 TO BE REUSABLE IT MUST NOT BE LDB A,I TYPE ZERO OR SIX. (FETCH TYPE) ADA .3 BUMP (A) TO SIZE LOCATION SZB CHECK FOR TYPE ZERO CPB .6 OR TYPE 6 CCB,RSS NOT REUSABLE * *781103* LDB A,I MUST BE SAME SIZE ADA .10 SET A FOR FAILURE * *781130* * SSB IF TYPE 0 OR 6 DIRECTORY ENTRY, JMP NSHR5 CAN'T REUSE. CONTINUE SEARCH * * *781130* * CPB NAME+6 SAME SIZE? JMP CKRU1 YES GO CHECK FURTHER * JMP NSHR5 NO CONTINUE SEARCH * CKRU1 LDB R1 IF ALREADY Ga<:6OT ONE SSB,RSS THEN JUST JMP NSHR5 CONTINUE * LDB TRACK ELSE SAVE THE DIRECTORY STB R1 ADDRESS (MUST SAVE A FOR LDB SECT CONTINUATION OF SCAN) STB R2 R1,R2 = DISC ADDRESS STA R3 R3=OFFSET +16 JMP NSHR5 CONTINUE THE SCAN SKP * 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 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 #SECT 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 SKP * <* 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 * UDAD NOP JSB WCSR WRITE CURRENT BLOCK LDA .14 A_14 ADA SECT ADD 7 TO THE SECTOR CLB PREPARE FOR DIVIDE DIV #SECT 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 RETURN SPC 2 LTR NOP NXSCA DEF BUF+5 SKP * 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 JMP DPMM,I 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 SKP * * 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 STA RWSUB SAVE ID ADDRESS IN TEMP DORM2 JSB LOADA CPA RWSUB THIS ONE? JMP DORM3 YES CONTINUE INB NO TRY THE NEXT ONE SZA IF END THEN JMP DORM2 CCE JMP DORM1 NOT VALID GO CLEAR FLAG DORM3 ADA .8 ADDRESS OF SUSPEND POINT STA B USE B FOR LOADA ROUTINE JSB LOADA FETCH POINT OF SUSPENSION CMA,CLE,INA,SZA,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 JMP CREX SPC 2 .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 * * * SPC 10 STYPE NOP * LOADA NOP LDA STYPE FETCH OP SYSTEM IDENTIFIER W(AFTER ERA) SLA MAPPED ? JMP MAPP YEP LDA B,I NOPE--DO A DIRECT LOAD JMP LOADA,I * MAPP XLA B,I CROSS LOAD B,I * NOTE: THIS IS A 2 WORD INST. JMP LOADA,I RETURN SKP CREAT JSB RDPAS READ THE SKELETON DIRECTORY LDA ID SET UP EXCLUSIVE OPEN FLAG IOR SIGN ADD THE EXCLUSIVE BIT STA ID SAVE IT CLA CLEAR THE EXTENT FLAG STA GSEC SAVE IT FOR THE DIRECTORY LDA ABUF MOVE IT JSB MOVE1 THE SAVE AREA JSB SETDR SET TO READ THE DIRECTORY JSB N.SHR SEARCH FOR THE NAME CREA0 CCE,RSS NOT FOUND SKIP JMP EX2 FOUND - TAKE DUP NAME EXIT * LDB R1 WAS A REUSABLE ENTRY FOUND? SSB,RSS WELL! JMP RUSE YES GO SET IT UP. * SZA ELSE IF DIRECTORY NOT FULL 790501 JMP CRE.0 CONTINUE. 790501 * LDA TMP1 DIR IS FULL. IF MULTI-DISC 790501 SZA SEARCH, TRY NEXT DISC. 790501 JMP EX14 ELSE EXIT ERROR 14 790501 JMP NEXT TRY NEXT DISC. 790501 * * CRE.0 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 CLDA 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 * 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 * CLEAR STA DIRA,I NO CLEAR THE ENTRY FROM BUFFER *780413* LDA GSEC IF EXTENT CREAT SZA,RSS THEN SKIP TO ERROR EXIT JMP NEXT ELSE TRY NEXT DISC JMP EX6 NO ROOM FOR EXTENT EXIT * 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 .3 DEC 3 CCE MOVE NEW JSB DPMM NEXT TRACK AND SECT WORDS ISZ WCS IN - SET TO WRITE JMP EXIT AND EXIT * 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 #SECT 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 CLEAR CLEAR THIS ENT AND TRY NEXT DISC*780413* JMP CREA7 GO WRAP IT UP * MAXSZ OCT 77776 MAX NUMBER OF SECTORS IN A FILE SKP *WE HAVE A REUSABLE ENTRY IN THE DIRECTORY AND WE NEED IT *SO THE DIRECTORY BLOCK IS READ BACK IN (IF REQURED) AND *THE ENTRY IS SET UP. * RUSE STB TRACK B HAS TRACK FROM EXISTANCE TEST LDB R2 GET THE SECTOR AND STB SECT SET IT JSB RWSUB READ THE BLOCK TO CORE IF REQUIRED LDA N16 GET THE OFFSET (IT WAS SAVED +16) ADA R3 AND SET UP THE ADDRESSES JSB SETAD LDA TRAKA,I SET THE FILE ADDRESSES STA NAME+4 IN THE ENTRY LDA SECTA,I AND B377 PURGE POSSIBLE EXTENT FLAG ADA GSEC ADD IN POSSIBLE NEW EXTENT FLAG STA NAME+5 LDA DIRA MOVE THE ENTRY INTO THE BUFFER CCE JSB MOVE1 LDA ID SET POSSIBLE OPEN FLAG STA FLAGA,I IN THE ENTRY ISZ WCS SET THE WRITE FLAG JMP OPEN6 AND GO EXIT (AFTER THE WRITE) * * * 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 BSS 3 WORDS JMP MO"VE2,I RETURN SPC 2 GTRK NOP GLU NOP GSEC NOP G#SEC NOP SKP GEN JSB TESTL TEST LEGALITY OF CALL JSB SETDR SET UP TO ACCESS THE DIRECTORY JSB RDPAS READ THE PASSED DATA GEN2 JSB UDAD UPDATE DIRECTORY ACCESS JMP CREX END GO EXIT CLE SET E FOR DPMM CALL ISZ FIRST FIRST SECTOR? RSS NO; SKIP JSB DPMM YES; GO EXTRACT THE DISC PRAMS ISZ WCS SET TO WRITE JSB WCSR WRITE THE SECTORS LDA BUFA,I IF A ZERO SECTOR SZA,RSS THEN JMP GEN2 ALL THE REST MUST BE ZERO ALSO. * JMP RDPA2 GO GET THE NEXT BLOCK SPC 2 TESTL NOP LDA B,I GET THE LOCK LDB TMP1 IF LOCKED CPA ID TO CALLER SZB,RSS AND CORRECT DISC SPEC SKIP JMP EX102 ELSE TAKE ERROR EXIT JMP TESTL,I SPC 5 * * RDPAD READ THE PASSED DATA * RDPAS NOP LDA P2 GET THE ADDRESS AND B77 ISOLATE THE LU STA GLU AND SET XOR P2 ISOLATE THE TRACK ALF,RAL ROTATE TO RAL,ALF LOW A STA GTRK AND SET LDA P4 GET THE #SECTORS/TRACK RAL,CLE,ERA ELIMINATE THE SIGN STA G#SEC AND SET CLA SET FOR SECTOR STA GSEC ZERO RDPA2 STA LDRLU SHOW THE BLOCK NOT IN CORE JSB EXEC READ THE SECTORS DEF GRTN DEF DS1 *780413* DEF GLU BUFA DEF BUF DEF .128 DEF GTRK DEF GSEC GRTN JMP ERR99 EXEC REJECTED CALL -- EXIT *780413* CPB .128 DISC ERROR? RSS NO; CONTINUE JMP EX1 YES; TAKE DISC ERR EXIT LDA GSEC UPDATE THE ADA .2 DISC ADDRESS CPA G#SEC END OF TRACK? CLA YES - USE 0 SECT. STA GSEC SET SECTOR CLE,SZA,RSS IF E|{OT ISZ GTRK STEP TRACK ADDRESS JMP RDPAS,I RETURN SKP SPC 5 LOCK5 LDA P4 END OF DIRECTORY LDB P5 IF GEN CALL CPB .7 AND SSA,RSS SIGN BIT SET SKIP JMP EX6 ELSE - NOT FOUND EXIT JSB RDPAS NEW DIRECTORY FOR DISCS - READ JMP EXIT3 GO WRITE AND EXIT SPC 3 PACK JSB TESTL TEST LEGALITY OF CALL JSB SETPR SET UP THE DISC PARAMETERS LDA P4 GET RELATIVE DOUBLE SECT CMA,INA,SZA,RSS SET NEGATIVE IF ZERO JMP PACK2 SKIP STA COUN1 SET COUNT PACK1 JSB UDAD BUMP ADDRESS JMP EX101 END OF DIRECTORY EXIT ISZ COUN1 STEP COUNTER; DONE? JMP PACK1 NO; GO BUMP AGIN PACK2 JSB RDPAS YES; READ THE NEW SECT. EXIT3 ISZ WCS SET WRITE FLAG EXIT4 CLA AND TAKE JMP CREX ACCEPT EXIT SPC 2 66 ID NOP TMP1 NOP TMP2 NOP DIRAD NOP TRACK NOP SECT NOP WCS NOP ALU NOP DITR 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 JSB RDPS LOCK GRANTABLE; READ DISC LDA ID DIRECTORY AND D CCB SET ADB DIRAD THE ROCK5 STA B,I LOCK JMP EXIT3 EXIT SPC 5 ULOCK CLA UNLOCK - CLEAR JMP ROCK5 AND GO SET IT SPC 2 ERR99 DST R2 SAVE ERROR CODE *780413* CLA CLEAR SOME FLAGS *780413* STA RDPS SO NEXT ENTRY *780413* STA WCS WILL BE CLEAN *780413* STA LDRLU *780413* LDA N99 FETCH ERROR CODE *780413* STA R1 AND SAVE FOR EXIT *780413* JMP EXIT GET OUT *780413* * EX101 LDA N102 INA,RSS EX102 LDA N102 JMP CREX SPC 2 N99 DEC -99 N102 DEC -102 .16 DEC 16 B377 OCT 377 N7 DEC -7 SKP CNAM JSB RDPAS CHANGE NAM - READ NEW NAME LDA ABUF MOVE IT TO JSB MOVE2 LOCAL SAVE AREA LDA ABUF 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 P1 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 P4 GET THE PASSED AND B377 SECTOR STA SECT AND SET IT XOR P4 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 2 CLOS2 CLA FOUND; CLEAR THE STA FLAGA,I FLAG LDA P2 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 O SUM LSR 16 EXTEND TO A DIV #SECT 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 SKP 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? CCA,RSS YES SO TRY AGAIN JMP B,I RETURN * STA R1 AFTER WE CLEAR THE FOUND FLAG JMP CSER CONTINUE THE SEARCH SPC 2 LAST? NOP * 780106 GLM 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 SKP PURGE CCA PURG0 STA DIRA,I SET PURGE FLAG LDB TYPE,I IF TYPE SIX FILE 780106 GLM CPB .6 THEN TREAT " " RSS AS NOT LAST " " 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 PB@ 7 SSA,RSS OK? JMP EREX NO NUMBER TO BIG * LDB PRAM,I GET PRAM AND ADB .40 CACULATE THE ADDRESS OFFSET JMP PADD GO SET IT UP AND DO THE 'CA' * * EXOK LDA TDES,I AH - SWEET SUCCESS STA DESTT,I SET NEW PRAM IN DESTINATION ISZ TDES LDB N.OPL IF A CPB "P" P CACULATE JMP PSET GO RESET TO RIGHT THING * ISZ DESTT AND JSB .DFER THEN DESTT NOP TDES NOP EXP CLA,RSS EREX LDA BADPM ERROR EXIT STA ERR,I SET ERROR CODE JMP CA..,I EXIT * * PSET LDA TDES,I GET THE VALUE WORD STA DESTT,I AND SET FOR P JMP EXP GO EXIT * DES NOP DGLOB DEF G0.. BADPM DEC 56 ASR ASR 16 LDB LDB B,I ADA ADA B,I IOR IOR B,I AND AND B,I XOR XOR B,I DIV OCT 100400 MPY OCT 100200 "A" OCT 40400 "X" OCT 54000 "O" OCT 47400 "P" ASC 1,P P BLANK FOR P TEST MINUS OCT 26400 PLUS OCT 25400 "/" OCT 27400 TIMES OCT 25000 C377 OCT 177400 .3 DEC 3 .9 DEC 9 .5 DEC 5 .36 DEC 36 .40 DEC 40 N3 DEC -3 N43 DEC -43 A EQU 0 B EQU 1 ORG * END ASMB,R,L,C * NAME: C.TAB * SOURCE: 92002-18008 * RELOC: 92002-16008 * 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 C.TAB,8 92002-16008 760720 ENT C.TAB * * SET UP SEGMENT AND ROUTINE NUMBERS. * R0 EQU 0 R1 EQU 400B R2 EQU R1+R1 R3 EQU R2+R1 R4 EQU R3+R1 R5 EQU R4+R1 R6 EQU R5+R1 R7 EQU R6+R1 R8 EQU R7+R1 R9 EQU R8+R1 R10 EQU R9+R1 SPC 2 S0 EQU 60B S1 EQU S0+1 S2 EQU S0+2 S3 EQU S0+3 S4 EQU S0+4 S5 EQU S0+5 S6 EQU S0+6 S7 EQU S0+7 S8 EQU S0+8 S9 EQU S0+9 * * THIS IS THE COMMAND DISPATCH TABLE FOR THE FMGR PROGRAM * EACH COMMAND ID IS FOLLOWED BY ITS ADDRESS. * FOR ROUTINES IN THE HOME SEGMENT THIS IS AN ADDRESS (DEF XX) * FOR ROUTINES IN OTHER SEGMENTS IT IS THE ASCII SEGMENT * SUFFIX IN THE LOW HALFw OF THE WORD AND THE ROUTINE * NUMBER IN THAT SEGMENT IN THE HIGH HALF OF THE WORD. * .PARS BREAKS THESE APART BY THE ADDRESS BEING 0< ADD < 10000B * FOR SEGMENT ADDRESS. * * COMMANDS WITH THE SIGN BIT SET INDICATE THAT THE COMMAND * NEED NOT SATISFY ALL THE SYNTAX RESTRICTIONS IMPOSED ON * OTHER COMMANDS. * SPC 2 C.TAB EQU * NOP DEF TR.. ASC 1,PK ABS S0+R0 ASC 1,CR ABS S0+R1 ASC 1,EX EXT EE.. DEF EE.. ASC 1,TR EXT TR.. DEF TR.. ASC 1,MR EXT MR.. DEF MR.. ASC 1,SE EXT SE.. DEF SE.. ASC 1,IF EXT IF.. DEF IF.. ASC 1,AB EXT AB.. DEF AB.. ASC 1,CA EXT CA.. DEF CA.. OCT 142120 "DP" WITH SIGN BIT SET EXT DP.. DEF DP.. OCT 125052 "**" WITH SIGN BIT SET DEF COMM OCT 125000 "*" WITH SIGN BIT SET DEF COMM OCT 125040 "*" WITH SIGN BIT SET DEF COMM ASC 1,IN ABS S2+R1 ASC 1,MC ABS S2+R2 ASC 1,DC ABS S2+R3 ASC 1,PU ABS S2+R4 ASC 1,CS ABS S3+R0 ASC 1,DL ABS S3+R1 ASC 1,CO ABS S4+R0 ASC 1,ST ABS S4+R1 ASC 1,DU ABS S4+R2 ASC 1,LL ABS S4+R3 ASC 1,LO ABS S4+R4 ASC 1,SV ABS S4+R5 ASC 1,RP ABS S5+R0 OCT 151125 "RU" WITH SIGN BIT ABS S5+R1 ASC 1,TL ABS S5+R2 OCT 150101 "PA" WITH SIGN BIT ABS S5+R3 OCT 152105 "TE" WITH SIGN BIT ABS S5+R4 OCT 140516 "AN" WITH SIGN BIT ABS S5+R5 ASC 1,CN ABS S5+R6 ASC 1,JO ABS S6+R0 ASC 1,EO ABS S6+R1 ASC 1,LG ABS S6+R2 ASC 1,LS ABS S6+R2 ASC 1,RT ABS S6+R2 ASC 1,OF ABS S6+R3 ASC 1,RN T<TRN ABS S6+R4 ASC 1,?? ABS S7+R1 OCT 151531 ASC SY WITH SIGN BIT SET ABS S7+R2 ASC 1,SP ABS S8+R0 ASC 1,MS ABS S8+R1 ASC 1,SA ABS S8+R2 ASC 1,LU ABS S9+R0 ASC 1,CL ABS S9+R1 ASC 1,LI ABS S9+R2 NOP * * COMM NOP LDA COMM,I JMP 0,I END TASMB,R,L,C HED FMGR ERROR EXPANDER MODULE PART OF RTE FMP * NAME: ??.. * SOURCE: 92002-18008 * RELOC: 92002-16008 * 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 ??..,8 92002-16008 REV.2001 791025 ENT ??.. EXT EXEC,TMP.,WRITF,O.BUF,.ENTR,.R.E.,.E.R. EXT CAM.O,IER.,BUF.,IFLG. EXT FM.AB,OPEN. SUP N NOP LST NOP SPC 1 ??.. NOP ENTRY POINT JSB .ENTR GEN PRAMS DEF N SPC 1 LDB .R.E. GET ERROR PRAM ASR 16 EXTEND THE SIGN BIT DIV .1000 DIVIDE 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 * CPA N99 CHECK FOR SPECIAL ERROR *780512* JMP PN99 GO PRINT IT *780512* * CPA N103 YES -- ANOTHER SPECIAL *791025* JMP PN103 * CPA N101 TREAT 101 RSS AND CPA N102 102 JMP ICK SPECIALLY 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 RN TABLE PRINT LDA N GET N ALS DOUBLE ADA TBAD ADD TABLE ADDRESS PR LDB A,I GET MESSAGE ADDRESS STB MSAD SET AS POINTER INA GET LDB A,I MESSAGE STB A LENGTH CMA,INA SET FOR STA N MOVE ADB .2 AND STB LST OUTPUT DLD FMGR SET FMGR BF DST BUF. AT LDA BUF.D HEAD RSS LDA A,I OF RAL,CLE,SLA,ERA MESSAGE JMP *-2 GET ADA .2 BUFFER ADDRESS AND MOVE LDB MSAD,I MOVE STB A,I MESSAGE INA TO ISZ MSAD THE ISZ N BUFFER JMP MOVE JSB EXEC PRINT DEF FMRTN ON DEF .2 LOG DEF CAM.O BUF.D DEF BUF. DEVICE DEF LST FMRTN LDA IFLG. IF INIT SZA THEN JMP ??..,I RETURN LDB .R.E. IF STA .R.E. CPB .60 60 JMP FM.AB THE ABORT JMP ??..,I ELSE, RETURN SPC 3 N99 DEC -99 DN99 DEF DFN99 PN99 LDA DN99 FETCH ADDR OF ERROR *780512* JMP PR * PN103 LDA DN103 FETCH ADDR OF ERROR *791025* JMP PR * DN103 DEF DF103 SPC 3 ICK SZB IF NOT REAL JMP UDF THEN UNDEFINED LDB ER1+1 FIX CPA N102 MESSAGE INB AND STB EM101+1 THEN LDA DF101 GO JMP PR PRINT IT SPC 2 UDF LDA DFUDF PICK UNDEFINED JMP PR AND SEND IT. SPC 3 ALL LDA IFLG. SZA JMP FMRTN LIST ALL LDA TMP.D RSS POSSIBLE LDA A,I ERROR RAL,CLE,SLA,ERA CODES. JMP *-2 GET PARAMETER ADA .3 ADDRESS STA LST AND JSB OPEN. OPEN DEF OPRTN LIST DEF O.BUF FILE TMP.D DEF TMP. DEF LST,I DEF .0 OPRTN DLD PTRS SET THE DST CPTRS POINTERS FOR LENGTH/BUFFER AD WRIT JSB WRITF WRITE DEF WRRTN THE DEF O.BUF MESSAGE DEF .E.R. ON CPTRS NOP THE NOP LIST WRRTN JSB IER. DEVICE DEF *+1 CHECK FOR ERRORS LDA CPTRS+1,I IF CURRENT LENGTH SSA NEGATIVE THEN JMP FMRTN DONE - RETURN. ISZ CPTRS ISZ CPTRS STEP THE ISZ CPTRS+1 ISZ CPTRS+1 BUFFER AND LENGTH POINTERS JMP WRIT ELSE GO WRITE NEXT MESSAGE SPC 3 .1000 DEC 1000 .99 DEC 99 N101 DEC -101 N102 DEC -102 N103 DEC -103 .2 DEC 2 .3 DEC 3 .60 DEC 60 SPC 1 A EQU 0 B EQU 1 MSTN EQU 26 MOST NEGATIVE ERROR CODE HLOW EQU 23 MOST POSITIVE OF LOW GROUP LHIG EQU 47 LOWEST OF HIGH GROUP HHIG EQU 62 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. SPC 1 BFPT NOP MSAD NOP DFUDF DEF *+1 DEF UDN ABS LUDN FMGR ASC 2,FMGR TBAD DEF MS00 PTRS DEF LSHED,I DEF LSHED+1 ER101 DEF EM101 ABS L101 EM101 ASC 19,-10* INTERNAL VALIDITY CHECK FAILED SE ASC 7,ND BUG REPORT! L101 EQU *-EM101 UDN ASC 6, NOT DEFINED LUDN EQU *-UDN LSHED DEF HEAD THIS LIST ABS LHEAD IS IN DEF BLNK THE ABS LBLNK ORDER DEF HD2 OF ABS LHD2 PRINTING DEF BLNK AND ABS LBLNK ALSO DF103 DEF EM103 ABS LM103 DFN99 DEF ERM99 ABS LM99 DEF ERM26 ABS LM26 DEF ERM25 ABS LM25 DEF ERM24 ABS LM24 DEF ERM23 ABS LM23 DE.F ERM22 ABS LM22 DEF ERM21 ABS LM21 DEF ERM20 ABS LM20 DEF UDN ABS LUDN DEF UDN ABS LUDN DEF ERM17 NUMERICAL ABS LM17 ORDER DEF ERM16 ABS LM16 DEF ERM15 ABS LM15 DEF ERM14 ABS LM14 DEF ERM13 ABS LM13 DEF ERM12 ABS LM12 DEF ERM11 ABS LM11 DEF ERM10 ABS LM10 DEF ERM9 ABS LM9 DEF ERM8 ABS LM8 DEF ERM7 ABS LM7 DEF ERM6 ABS LM6 DEF ERM5 ABS LM5 DEF ERM4 ABS LM4 DEF ERM3 ABS LM3 DEF ERM2 ABS LM2 DEF ERM1 ABS LM1 MS00 DEF ER0 ABS L0 DEF ER1 ABS L1 DEF ER2 ABS L2 DEF ER3 ABS L3 DEF ER4 ABS L4 DEF ER5 ABS L5 DEF ER6 ABS L6 DEF ER7 ABS L7 DEF ER8 ABS L8 DEF ER9 ABS L9 DEF ER10 ABS L10 DEF ER11 ABS L11 DEF ER12 ABS L12 DEF ER13 ABS L13 DEF ER14 ABS L14 DEF ER15 ABS L15 DEF ER16 ABS L16 DEF ER17 ABS L17 DEF ER18 ABS L18 DEF ER19 ABS L19 DEF ER20 ABS L20 DEF ER21 ABS L21 DEF ER22 ABS L22 DEF ER23 ABS L23 DEF ER47 ABS L47 DEF ER48 ABS L48 DEF ER49 ABS L49 DEF ER50 ABS L50 DEF ER51 ABS L51 DEF ER52 ABS L52 DEF ER53 ABS L53 DEF ER54 ABS L54 DEF ER55 ABS L55 DEF ER56 ABS L56 DEF ER57 ABS L57 DEF ER58 ABS L58 DEF ER59 ABS L59 DEF ER60 ABS L60 DEF ER61 ABS L61 DEF ER62 ABS L62 DF101 DEF ER101 EO:5F RECORD DEC -1 .0 NOP END OF THE LIST * ERROR TABLE -CODES ARE ENTERED IN ANY ORDER. ER0 ASC 5, 000 BREAK L0 EQU *-ER0 ERM1 ASC 8, -01 DISC ERROR LM1 EQU *-ERM1 ERM2 ASC 12, -02 DUPLICATE FILE NAME LM2 EQU *-ERM2 ERM3 ASC 11, -03 BACKSPACE ILLEGAL LM3 EQU *-ERM3 ERM4 ASC 19, -04 MORE THAN 32767 RECORDS IN A TYPE ASC 4, 2 FILE LM4 EQU *-ERM4 ERM5 ASC 13, -05 RECORD LENGTH ILLEGAL LM5 EQU *-ERM5 ERM6 ASC 18, -06 CR OR FILE NOT FOUND OR NO ROOM LM6 EQU *-ERM6 ERM7 ASC 14, -07 BAD FILE SECURITY CODE LM7 EQU *-ERM7 ERM8 ASC 16, -08 FILE OPEN OR LOCK REJECTED LM8 EQU *-ERM8 ERM9 ASC 19, -09 ATTEMPT TO USE APOSN OR FORCE TO ASC 8,1 A TYPE 0 FILE LM9 EQU *-ERM9 ERM10 ASC 13, -10 NOT ENOUGH PARAMETERS LM10 EQU *-ERM10 ERM11 ASC 9, -11 DCB NOT OPEN LM11 EQU *-ERM11 ERM12 ASC 11, -12 EOF OR SOF ERROR LM12 EQU *-ERM12 ERM13 ASC 8, -13 DISC LOCKED LM13 EQU *-ERM13 ERM14 ASC 10, -14 DIRECTORY FULL LM14 EQU *-ERM14 ERM15 ASC 9, -15 ILLEGAL NAME LM15 EQU *-ERM15 ERM16 ASC 26, -16 ILLEGAL TYPE OR SIZE (SIZE=0 OR > 16383 BLOCKS) LM16 EQU *-ERM16 ERM17 ASC 19, -17 ILLEGAL READ/WRITE ON TYPE 0 FILE LM17 EQU *-ERM17 ERM20 ASC 11, -20 ILLEGAL ACCESS LU LM20 EQU *-ERM20 ERM21 ASC 14, -21 ILLEGAL DESTINATION LU LM21 EQU *-ERM21 ERM22 ASC 14, -22 NO AVAILABLE SPOOL LU'S LM22 EQU *-ERM22 ERM23 ASC 15, -23 NO AVAILABLE SPOOL FILES LM23 EQU *-ERM23 ERM24 ASC 14, -24 NO MORE BATCH SWITCHES LM24 EQU *-ERM24 ERM25 ASC 10, -25 NO SPLCON ROOM LM25 EQU *-ERM25 ERM26 ASC 23, -26 QUEUE FULL OR MAX PENDING SPOOLS EXCEEDED LM26 EQU *-ERM26 ERM99 ASC 22, -99 DIRECTORY MANAGER EXEC REQUEST ABORTED LM99 EQU *-ERM99 EM103 ASC 20,-103 DIRECTORY CORRUPT OR NOT SUPPORTED LM103 EQU *-EM103 SPC 1 ER1 ASC 14, 001 DISC ERROR-LU REPORTED L1 EQU *-ER1 ER2 ASC 11, 002 INITIALIZE LU 2! L2 EQU *-ER2 ER3 ASC 11, 003 INITIALIZE LU 3! L3 EQU *-ER3 ER4  ASC 18, 004 ILLEGAL RESPONSE TO 002 OR 003 L4 EQU *-ER4 ER5 ASC 18, 005 REQUIRED TRACK NOT AVAILABLE - ASC 15,RELATIVE TAT POSITION REPORTED L5 EQU *-ER5 ER6 ASC 10, 006 FMGR SUSPENDED L6 EQU *-ER6 ER7 ASC 10, 007 CHECKSUM ERROR L7 EQU *-ER7 ER8 ASC 11, 008 D.RTR NOT LOADED L8 EQU *-ER8 ER9 ASC 13, 009 ID-SEGMENT NOT FOUND L9 EQU *-ER9 ER10 ASC 8, 010 INPUT ERROR L10 EQU *-ER10 ER11 ASC 18, 011 DO OF,XXXXX,8 ON NAMED PROGRAMS L11 EQU *-ER11 ER12 ASC 16, 012 DUPLICATE DISC LABEL OR LU L12 EQU *-ER12 ER13 ASC 11, 013 TR STACK OVERFLOW L13 EQU *-ER13 ER14 ASC 20, 014 REQUIRED ID-SEGMENT OR ID-EXTENSION ASC 5, NOT FOUND L14 EQU *-ER14 ER15 ASC 10, 015 LS TRACK REPORT L15 EQU *-ER15 ER16 ASC 20, 016 FILE MUST BE AND IS NOT ON LU 2 OR ASC 1,3 L16 EQU *-ER16 ER17 ASC 16, 017 ID SEGMENT NOT SET UP BY RP L17 EQU *-ER17 ER18 ASC 12, 018 PROGRAM NOT DORMANT L18 EQU *-ER18 ER19 ASC 19, 019 FILE NOT SET UP BY SP ON CURRENT ASC 3,SYSTEM L19 EQU *-ER19 ER20 ASC 11, 020 ILLEGAL TYPE 0 LU L20 EQU *-ER20 ER21 ASC 14, 021 ILLEGAL DISC SPECIFIED L21 EQU *-ER21 ER22 ASC 10, 022 COPY TERMINATED L22 EQU *-ER22 ER23 ASC 14, 023 DUPLICATE PROGRAM NAME. L23 EQU *-ER23 SPC 2 ER47 ASC 12, 047 SPOOL SETUP FAILED L47 EQU *-ER47 ER48 ASC 14, 048 GLOBAL SET OUT OF RANGE L48 EQU *-ER48 ER49 ASC 20, 049 CAN'T RUN RP'ED PROG. OR PARTITION ASC 5,TOO SMALL L49 EQU *-ER49 ER50 ASC 13, 050 NOT ENOUGH PARAMETERS L50 EQU *-ER50 ER51 ASC 17, 051 ILLEGAL MASTER SECURITY CODE L51 EQU *-ER51 ER52 ASC 8, 052 ILLEGAL LU. L52 EQU *-ER52 ER53 ASC 14, 053 ILLEGAL LABEL OR ILABEL L53 EQU *-ER53 ER54 ASC 11, 054 DISC NOT MOUNTED L54 EQU *-ER54 ER55 ASC 11, 055 MISSING PARAMETER L55 EQU *-ER55 ER56 ASC 9, 056 BAD PARAMETER L56 EQU *-ER56 ER57 ASC 16, 057 BAD TRACK NOT IN FILE AREA L57 EQU *-ER57 ER58 ASC 16, 058 LG AREA $*($EMPTY OR TOO SMALL! L58 EQU *-ER58 ER59 ASC 16, 059 REPORTED TRACK UNAVAILABLE L59 EQU *-ER59 ER60 ASC 19, 060 DO YOU REALLY WANT TO PURGE THIS ASC 9,DISC? (YES OR NO). L60 EQU *-ER60 ER61 ASC 18, 061 DO A "DC" AND A "MC" ON THIS CR. L61 EQU *-ER61 ER62 ASC 12, 062 MORE THEN 31 DISCS. L62 EQU *-ER62 SPC 2 HEAD ASC 9, FMGR ERROR CODES LHEAD EQU *-HEAD HD2 ASC 9, ERROR MEANING LHD2 EQU *-HD2 BLNK ASC 1, LBLNK EQU *-BLNK ORG * PROGRAM LENGTH END $*SPL,L,O ! NAME: FM.CM ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 FM.CM(8) "92002-16008 REV.2001 791019" ! ! MODIFIED: 780413 TO SAVE SECURITY CODE IN TRANSFER ! STACK. (GLM) ! ! 780414 TO CLEAR .E.R. IF LU PASSED TO OPEN. ! WAS OK. (GLM) ! 790502 TO NOT STACK LOG DEVICE IF OPEN OF NEW ! LOG DEVICE FAILS AND WE ARE CURRENTLY ! GETTING INPUTS FROM THE LOG DEVICE. (GLM) ! ! 791019 TO SET THE RECORD COUNTER TO 1 FOR SPECIAL ! TYPE ZERO OPEN REQUESTS. (GLM) ! ! LET EXEC BE SUBROUTINE,EXTERNAL LET CLOSE,OPEN BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET FM.ER,OPEN.,CLOS.,\ IER. BE SUBROUTINE LET CLO BE SUBROUTINE,DIRECT LET IFBRK BE FUNCTION,EXTERNAL LET LURQ BE FUNCTION,EXTERNAL LET RQLU BE FUNCTION,DIRECT LET BRKF. BE INTEGER,GLOBAL LET LCKFL,WATMS(8),WATM BE INTEGER INITIALIZE BRKF. TO 0 INITIALIZE LCKFL,WATMS TO 0,"WAITING FOR LU " LET MSS. BE SUBROUTINE LET JER. BE SUBROUTINE,DIRECT LET EC.HO,CONV. BE SUBROUTINE LET ILOG BE FUNCTION,DIRECT LET CAMS.(60) BE INTEGER,GLOBAL !TRANSFER STACK *780413* LET C.BUX BE INTEGER LET C.BUF(40) BE INTEGER,GLOBAL LET TTY.,N.OPL,I.BUF,O.BUF BE INTEGER,EXTERNAL @ LET .TTY BE FUNCTION,EXTERNAL LET CAM.I BE INTEGER(144),GLOBAL LET CAM.O,ECH.,BUF.(129) BE INTEGER ,GLOBAL LET ECHF.,C.DLM BE INTEGER ,GLOBAL LET .R.E. BE INTEGER ,EXTERNAL LET .E.R. BE INTEGER,GLOBAL !DEFINE THE ERROR WORD LOCATION LET SVCOD BE INTEGER LET P.TR BE INTEGER ,GLOBAL LET TMP. BE INTEGER,GLOBAL LET LST(2) BE INTEGER LET SVCO,CREF BE INTEGER LET S,LSSC,SCOD,NFA,ECH,LSDIS BE INTEGER LET FM.AB BE LABEL,EXTERNAL LET XEQT BE CONSTANT (1717K) LET FM(2),MS1,MS2 BE INTEGER INITIALIZE C.BUX TO " :" INITIALIZE FM , MS1,MS2 TO "FMGR 000" LET A BE CONSTANT(0) LET B BE CONSTANT(1) INITIALIZE P.TR TO @CAMS. LET NO.RD,ACTV.,CAD. BE INTEGER,EXTERNAL LET STWD BE CONSTANT (100015K) ! MSS.: SUBROUTINE(ER,NX)GLOBAL LET ER,NX BE INTEGER ! ! MESSAGE FORMAT: ! FMGR XXX ! ! MESSAGE ERROR WORD FORMAT ! THE THOUSANDS DIGIT IS USED AS FOLLOWS: ! IF ONE OR THREE THEN TWO MESSAGES ARE TO BE PRINTED ! ! IF ZERO OR TWO THEN ONLY ONE MESSAGE IS PRINTED ! ! IF ZERO OR ONE THEN SEND THE INPUT DEVICE TO THE LOG UNIT ! IF 2 OR 3 LEAVE THE LOG AND INPUT DEVICES AS IT IS ! IFNOT [NO_ER] THEN BRKF._1 !SAVE ERROR FOR ?? AND ! IF BREAK ERROR SET FLAG S_NO/1000;.R.E._.B. MS1_" " !SET SIGN FOR PLUS IF NO<0 THEN [NO_ -NO;MS1_26400K]!IF NEG SET TO GIVE SIGN S_NO/1000;NO_.B. MSS00:CONV.(NO,MS2,3) !CONVERT THE NUMBER FM.ER([IF S>1 THEN 1,ELSE 2],FM,4) IF S AND 1 THEN [S_S-1;NO_NX; \DO SECOND NUMBER MS1 _ 20040K; GOTO MSS00] RETURN END ! ! COMMAND OUTPUT (ERROR) SUBROUTINE ! FM.ER:SUBROUTINE(SCCOD,BFMS,LN)GLOBAL LET SCCOD,BFMS,LN BE INTEGER ! ! FM.ER PRINTS ONLY !IF SCCOD IS GREATER THAN OR EQUAL TO ! THE SVCOD ENTERED AT TURN ON TIME ! ! IN ADDITION IF THE SCCOD IS IS GREATER THAN 1 CONTROL IS SWITCHED ! TO THE LOG CHANNEL ! IF SCCOD > 1 THEN GO TO EC !ALWAYS PRINT IF 2 OR MORE IF SCCOD 3 THEN RETURN !IF CODE HIGH ENOUGH RETURN ! IF ACTV. THEN [ \IF IN AN ACTIVE IF SVCOD < 3 THEN [ \JOB, AND SV<3, CAD.,NO.RD _ 6; RETURN]] !ABORT THE JOB. IF ILOG() THEN RETURN !IF ON LOG AREADY RETURN OPEN.(CAM.I,CAM.O,0.0,410K)!OPEN THE INPUT TO THE LOG DEVICE RETURN END ! ! OPEN.:SUBROUTINE(DCBRF,LURF,PLIS,OPLST) GLOBAL LET DCBRF,LURF,PLIS,OPLST BE INTEGER DCB14_[DCB9_[DCB7_[DCB6_[DCB5_[DCB4_[DCB3_[DCB2_@DCBRF+2]+1]+1]\ +1]+1]+1]+2]+5 .E.R._20 ! SET ERROR CODE FOR ILLEGAL LU IF LURF < 0 THEN GO TO ABEX !IF LU NEGATIVE ABORT IFNOT @DCBRF=@CAM.I THEN GOTO OPN3 ! NOT INPUT UNIT TTY._0 !SET TTY FLAG TO INDICATE NOT TTY $P.TR_$DCB14 !SAVE RECORD COUNT FOR FILE P.TR_P.TR+1! SET THE NEXT ADDRESS CALL .DFER($P.TR,LURF);P.TR_P.TR+3 !STACK THE NAME OPN3: CLO (DCBRF) !CLOSE THE OLD FILE IF LURF>20000K THEN [ \ IF FILE THEN OPEN(DCBRF,.E.R.,LURF,OPLST,PLIS,$(@PLIS+1)); \OPEN THE FILE IF .E.R. < 0 THEN[ \IF ERROR OPAB: IF @DCBRF=@CAM.I THEN[ \ON COMAND DCB THEN BP_1; \ P.TR_P.TR-ILOG()-4; \BACK PTR (10 IF FROM LOG) BP_0; \ $DCB14_$P.TR;  \AND RESET THE RECORD COUNT IF SVCOD > 3 THEN[ \TR TO LOG NOT ALLOWED SO MSS.(.E.R.);RETURN] \SEND ERROR AND RETURN ] \ ]; \ IER.; \REPORT ERRORS ON OTHERS GO TO OPN2 \SKIP THE ELSE CAUSE ] EXEC(STWD ,LURF,EQT5,NUM,BF) !GET STAT WORD TYPE CODE GO TO OPAB !IF ABORT GO SEND ERROR .E.R._0 !*780414*CLEAR ILLEGAL LU CODE ! ! SET EOF ! EOF_1100K !ASSUME TTY-PRINTER IF [EQT5_EQT5 AND 37400K] > 7000K THEN \IF DRIVER TYPE 17 OR > GO TO EOFCD !USE EOF IF EQT5 = 2400K THEN[ \IF DVR05 AND IF [BF_BF AND 7] = 1 THEN GO TO EOFCD, \SUBCHANNEL 1 OR ELSE[IF BF = 2 THEN[ \2 I.E. CTU EOF EOFCD: EOF_100K;GO TO OPN1]]] IF EQT5=1000K THEN GO TO LEADR !IF PUNCH OR IF (OPLST AND 110K) = 110K THEN[ \OR LEADR SUB FUN SUPPLIED LEADR: EOF_ 1000K] !USE LEADER FUNCTION ! ! OPN1: $DCB2,DCBRF_0 $DCB3_(OPLST AND 3700K) OR LURF $DCB4_EOF OR (LURF AND 77K) $DCB5,$DCB6,$DCB7_100001K IFNOT 77K AND NUM THEN $DCB6_1 !READ ILLEGAL FROM LU ZERO $DCB9_$XEQT $DCB14_1 !SET RECORD COUNT TO 1 OPN2: IF @DCBRF=@CAM.I THEN[ \IF COMMAND DEVICE $P.TR_ PLIS; P.TR_P.TR+1; \*780413* SAVE SEC CODE $P.TR_ -(DCBRF AND 77K);P.TR_P.TR+1] !SAVE THE CR (-LU) IF $DCB2 THEN RETURN !IF NOT TYPE ZERO THEN RETURN IF .TTY($DCB3) OR @DCBRF=@CAM.I \IF INTERACTIVE OR IF THEN GO TO OPN5 !CMND INPUT, SKIP LOCK IFNOT RQLU() THEN GO TO OPN5 !IF LOCKABLE LOCK AND CONTINUE CALL CONV.($DCB3b AND 77K,WATM,2) !PUT LU IN MESSAGE CALL EXEC(2,CAM.O,WATMS,9) !SEND WAIT MESSAGE OPN6: CALL EXEC(12,0,2,0,-5) !TRY EVERY 5 SECONDS CALL JER. !TEST FOR BREAK IF RQLU() THEN GO TO OPN6 !IF NOT NOW WAIT AGAIN OPN5: IF @DCBRF=@O.BUF THEN[\ IF($DCB4 AND 3700K)=1000K THEN[IF OPLST<0 THEN[\ CALL EXEC(3,$DCB4) ]]] !END FILE IF REASONABLE IF @DCBRF=@CAM.I THEN[\ TTY._.TTY($DCB3);GO TO OPN4] IF @DCBRF=@I.BUF THEN \ IF INPUT ON A ZERO [OPN4: EXEC(3,700K+($DCB3 AND 77K))] !THEN SET EOT CONDITION RETURN END ! RQLU: FUNCTION DIRECT RETURN LURQ(100001K,$DCB3,1) END ! ! CLOS.:SUBROUTINE(CLSOP) GLOBAL LET CLSOP BE INTEGER IF @CLSOP THEN[CLO(CLSOP);RETURN]! IF SPECIFIED CLOSE THE FILE CLO(I.BUF)! CLOSE INPUT CLO(O.BUF) ! CLOSE OUTPUT CLO (CAM.I) !CLOSE CAMMAND RETURN! RETURN END ! CLO: SUBROUTINE(DCB)DIRECT !CLOSE SUBROUTINE FOR INTERNAL WORK LET DCB BE INTEGER DCBX9_[DCBX3_[DCBX2_@DCB+2]+1]+6 IF $DCBX9 # $XEQT THEN RETURN !IF NOT OPEN FORGET IT IFNOT $DCBX2 THEN[\ !IF THIS IS A TYPE 0 FILE IFNOT @DCB=@CAM.I THEN[\ AND NOT COMMAND INPUT CALL LURQ(40000K,$DCBX3,1) ]] !CLEAR THE LOCK !NOTE-- BIT 14 IS SET(NO-ABORT) GOTO CL1 !THIS LINE IS REQUIRED FOR ! !THE ABORT RETURN CL1: IF DCB AND 177700K THEN CLOSE(DCB) !IF NOT FAKE CLOSE $DCBX9 _0 !ELSE KILL THE OPEN FLAG RETURN END ! ! EC.HO:SUBROUTINE GLOBAL !TO ECHO COMMANDS IFNOT ECHF. THEN RETURN !IF ALREADY DONE THE RETURN IF ILOG() THEN GO TO ECH0 C.BUX_20072K !(BLANK : )ASSUME BATCH IF iTTY. THEN C.BUX_ 20040K !(2 BLANKS ) IF BAD ASSUMPTION CHANGE IT CALL EXEC(2,CAM.O,C.BUX,ECH.+1) !ECHO THE COMMAND ECH0: ECHF._0 !SET THE ECHOED FLAG RETURN END ! ! ILOG: FUNCTION DIRECT DCB9_[DCB3_[DCB2_@CAM.I+2]+1]+6 !SET UP DCB ADDRESSES IFNOT ($DCB3 XOR CAM.O) AND 77K THEN[IFNOT $DCB2\ THEN [IF$DCB9=$XEQT OR BP=1 THEN RETURN 6]] RETURN 0 END ! IER.: SUBROUTINE GLOBAL IF .E.R. =>0 THEN RETURN ABEX: DO[MSS.(.E.R.);GO TO FM.AB] END ! ! JER.: SUBROUTINE GLOBAL,DIRECT !SUBROUTINE TO CHECK ERRORS IER. ! AND FOR BREAK CONDITION .E.R._0 !SET ERROR CODE FOR BREAK ERROR IF IFBRK THEN GO TO ABEX!IF BREAK CONDITION ,EXIT RETURN !ELSE RETURN END ! ! CONV.:SUBROUTINE (NOO,BUF,NDIG) GLOBAL LET NOO,BUF,NDIG BE INTEGER ! 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[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 ! ! ! ! ! END END$ SPL,L,O ! NAME: PK.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 750416 ! ! MODIFIED 750416 TO NOT MOVE EXTENTS IF THEY ALREADY RESIDE AT ! THE DESTINATION AND ALSO TO CORRECTLY HANDLE FILES TO 32K SECTORS ! *************************************************************** ! * (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* a! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME PK..(8) "92002-16008 REV.2001 791017" ! ! MODIFIED 101779 TO REMOVE TYPE 4 ID SEGMENT CHECK. GLM ! ! PK.. IS THE PACKING ROUTINE FOR THE ! RTE FMGR PROGRAM. ! ! IT PACKS RTE FILES AS FOLLOWS: ! ! 1. IF DISC IS LU2 OR 3 A CHECK IS ! MADE TO INSURE NO CURRENT ID SEGMENTS ! POINT TO FILE TRACKS. ! ! 2. 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.) ! ! 3. AFTER ALL FILES ARE MOVED A NEW DIRECTORY ! IS CREATED PACKING OUT ALL THE PURGED ! ENTRIES AND THIS IS WRITTEN ON THE DISC VIA D.RTR. ! ! 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.,\ IER.,FM.ER,EXEC,READF, \ WRITF,RWNDF \ BE SUBROUTINE,EXTERNAL ! LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! LET COR.A BE PSEUDO,EXTERNAL,DIRECT ! LET D.SDR,PK.DR,DS.LU,O.BUF,\ .R.E.,.IDAD,\ .E.R.,D.,I.BUF,CUSE. BE INTEGER,EXTERNAL ! ! DECLARE INTERNAL SUBROUTINES ! LET TRAK.,SETAD,BADTR\ BE SUBROUTINE ! ! DECLARE ARRAYS ! LET BTL(6) BE INTEGER ! ! DECLARE CONSTANTS ! LET N9 BE INTEGER INITIALIZE N9 TO -9 LET READI BE CONSTANT( 1) LET WRIT BE CONSTANT( 2) LET BKLWA BE CONSTANT(1777K) LET XEQT BE CONSTANT(1717K) LET KEYWD BE CONSTANT(1657K) LET SECT2 BE CONSTANT(1757K) LET SECT3 BE CONSTANT(1756K) LET A oBE 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. PK1: D.RIO(READI) ! AGAIN:DIS_[IF PACK THEN PACK,ELSE -$LUPT] IFNOT DIS THEN RETURN !END OF DISC DIRECTORY CALL JER. !CHECK FOR BREAK LOCK.(DIS,3)?[LU_.R.E.;MSS.(DIS);.R.E._LU;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_@O.BUF]+2]+1]+1]+1 DCB21_[DCB20_[DCB19_[OBUF_[DCB9_[DCB8_[DCB7_[DCB6_ \ DCB5+1]+1]+1]+1]+7]+3]+1]+1 FOR T_DCB TO [TBUF_DCB+32] DO $T_0 !CLEAR THE DCB $DCB_LU $DCB2_1 $DCB6_128 !SET RECORD SIZE $DCB7_100200K !SECURITY FLAG $DCB8_$PKD6 $DCB9_$XEQT !AND OPEN FLAG FOR T_DCB TO DCB9 DO[T1_T+16;$T1_$T] IF LU<4 THEN TRAK.(LU)?[GO TO PK26] ! ! THE DISC IS LOCKED AND WE MAY START ! PACKING - WE MUST HAVE A BUFFER ! AND ITS SIZE. IF WE ARE IN THE ! BACKGROUND USE ALL THE REST OF ! CORE; ELSE USE 0.BUF+32 (256 WDS) ! IF ($($XEQT+14)AND 7)#3 THEN GOTO PK3 PK2: IF[LN_($BKLWA-[COR.A,BUFAD_.IDAD]+1)\ AND 77600K]>256 THEN GO TO PK5 ! 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 ! a 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(O.BUF,.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(O.BUF,.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 CLEAN:BLK,CO_0 PK12: DR.RD(READI,DIS,BLK)?[GO TO PK25] DO[FILCO_0;SETAD] IF BLK THEN GO TO PK16 DO[$PKD5_$NXSEC;$PKD9_$NXTR;$NXSEC_0] NSEC_$SECT2 IF $SECT3 THEN [IF $SECT3<$SECT2 THEN NSEC_$SECT3] $DCB5_-$PKD8*$PKD6+2 NTR_$DCB5/NSEC IF $B THEN NTR_NTR+1 EXEC(4,NTR,$NXTR,$DCB,$DCB8) $DCB6_16 $DCB2_2 RWNDF(O.BUF,.E.R.) IER. PK16: IFNOT $PKD THEN GOTO PK25 IF $PKD+1 THEN[WRITF(O.BUF,.E.R.,$PKD);\ IER.;CO_CO+1] SETAD?[BLK_BLK+1;GOTO PK12] GOTO PK16 ! PK25: FOR T_PKD TO PKD+15 DO $T_0 FOR T_CO TO($DCB5-2)*4 DO[\ WRITF(O.BUF,.E.R.,$PKD);IER.] ! PK15: EXEC(9,D.,$XEQT,($NXTR-<6)+$DCB,DIS,$DCB8,7) DO[AREG_$0;BREG_$1;IF AREG THEN GOTO PK15] DO[.E.R._$BREG;IER.] !CHECK ERRORS PK26: LOCK.(DIS,5)  !UNLOCK DISC EXEC(5,-1) !RETURN TRACKS NXDIS:I.BUF_0 !CLEAR I.BUF INCASE WE EXIT IFNOT PACK THEN [LUPT_LUPT+4;GOTO AGAIN] 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 ! ! TRAK. CHECKS FOR ID SEGMENTS THAT REFERENCE ! FILE MANAGEMENT TRACKS. IF ANY ARE FOUND, THE ! NAME OF THE PROGRAM IS PRINTED, ! AND AN FEXIT IS TAKEN. ! TRAK.:SUBROUTINE(LOGUN) FEXIT LU3_LOGUN AND 1 DO[NSEC,FILCO_0;NTR_($PKD4-<7)] SETAD T_$KEYWD NEXT: DMAN_[NAM3_[NAM2_[NAM1_$T+12]+1]+1]+12 IF $NAM3 AND 20K THEN DMAN_NAM3+5 IF [T2_$NAM3 AND 7]=1 THEN GOTO OK ASSEMBLE["EXT $OPSY"; \CHECK TYPE 4 ONLY IN RTE 4 "LDA $OPSY"; \ "CPA N9"; \ "JMP NEX2"] ! IF T2=4 THEN GOTO OK NEX2: IF (($DMAN-<1)AND 1)#LU3 THEN GOTO OK IF ($DMAN AND 77600K)20000K THEN GO TO ILLU IF $LIS5<1 THEN GO TO ILLU OPEN. (O.BUF,$LIS5,N.OPL,0) !SET DEFAULT EOF CLOS. (O.BUF) !*780414*CLEAN UP LOCK 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 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 NAM.. ($LIS1) IF .A. THEN GO TO ILNAM LOCK.(-2,3)?[RETURN] ! LOCK THE DISC T1_@NAM FOR T_LIS1 TO LIS1+2 DO [$T1_$T;T1_T1+1] SC(1)_N.OPL !SET THE SECURITY CODE ! SETAD $DCB8_$SECT2 IF $SECT3 THEN [IF $SECT3<$SECT2 THEN $DCB8_$SECT3] $DCB5_ -$PKD8*$PKD6+2 NTR_$DCB5/$DCB8 IF .B. THEN NTR_NTR+1 ! EXEC (4,NTR,$DCB3,$DCB,$DCB8) !GET A TRACK ! EXEC (2,$DCB, NAM,128,$DCB3,0) ! WRITE DIRENT ! SCHD: EXEC (23,D.,$XEQT,($DCB3 -<6)+$DCB,-2,0,1)!ENTER ! ! IF [BREG_$.B.]< 0 THEN GO TO EX ! DO[$DCB7_100200K;$DCB4,$DCB15,$DCB13_0;$DCB9_$XEQT] $DCB6_16 !COMPLET DCB $DCB2_2 ! FAKE OUT RWNDF (O.BUF,.E.R.) ! SET UP TO WRITE IER. ! CHECK ERRORS ! SPLC_SP !SET SPACE CODE WRITF(O.BUF,.E.R.,$PKD) ! WRITE DISC WRITF (O.BUF,.E.R., NAM) ! WRITE FILENM SETA: SETAD ! GET NEXT ENTRY IF $PKD = NAM THEN [IF $ PKD1= NAM1\ THEN [IF $PKD2 = NAM2(1) THEN \ GO TO FILL]] WRITF (O.BUF,.E.R., $PKD) IER. IF $PKD THEN GO TO SETA FILL: FOR T_PKD TO PKD15 DO $T_0 UNTIL .E.R.= 5-12 DO[IER.;WRITF (O.BUF,.E.R.,\ $PKD)] CR1: EXEC (23,D.,$XEQT, ($DCB3-<6)+$DCB,-2,$DCB8,7) BREG_$.B. EX: IF BREG < 0 THEN ER _ BREG LOCK.(-2,5) EXEC (5,-1) RETURN ! ILLU: DO[ ER_ 20 ; RETURN] MISPM:DO[ ER_ 55 ; RETURN] ILLPM:DO[ ER_ 56 ; RETURN] ILNAM:DO[ ER_-15 ; RETURN] ! END SETAD:SUBROUTINE ! TO SET PACK ADDRESSES ! IF NEW BLOCK - THEN SET UP. IF ADD=128 THEN[DR.RD(1,-2,BLK);BLK_BLK+1;\ ADD_0] ! PKD15_[PKD8_[PKD6_[PKD2_[PKD1_[PKD_@PK.DR+ADD]+\ 1]+1]+4]+2]+7 ! SET ADDRESSES ! ADD_ADD+16 ! STEP ADDRESS FOR NEXT TIME RETURN ! DONE END END END$ SPL,L,O ! NAME: CN.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 741118 ! ! *************************************************************** ! * (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 CN..(8) ! 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.,I.BUF,N.OPL BE INTEGER,EXTERNAL LET NAMF,IER.,CLOS. BE SUBROUTINE,EXTERNAL CN..: SUBROUTINE (N,LI,E) GLOBAL L5_[L1_@LI+1]+4 CLOS.(I.BUF) NAMF(I.BUF,.E.R.,$L1,$L5,N.OPL,$(@N.OPL+1)) IER. RETURN END END END$ ZXTTZSPL,L,O ! NAME: .PARS ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A.,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 .PARS (8) "92002-16008 REV.2001 791021" ! ! MODIFIED TO HANDLE SUBPARAMETER ERRORS ON SPECIAL CMNDS 101779 GLM. ! ! ! THE PARSE SUBROUTINE AND ITS ROUTINES SCAN AN ASCII ! STRING AND PRODUCES: ! ! A. AN ACTION ROUTINE ADDRESS (CAD.) ! B. A PARAMETER COUNT (NOCM.) ! C. A PARAMETER LIST WITH 4 WORDS FOR EACH PARAMETER: (P.RAM) ! ! 1. TYPE ! (A.) 0 - NULL ! (B.) 1 - NUMBER ! (C.) 1 - SIGNED OR OCTAL NUMBER ! (D.) 3 - ASC STRING ! ! 2. FOR TYPE 1 THE VALUE, ! ELSE FOR TYPE 3 THE FIRST TWO CHARACTERS. ! ! 3. FOR TYPE 3 CHARACTERS 3 AND 4. ! ! 4. FOR TYPE 3 CHARACTERS 5 AND 6. ! ! D. A 10 WORD OPTION LIST AT N.OPL ! OPTIONS MAY APPEAR ON THE FIRST TWO PARAMETERS ! OPTIONS ARE SEPERATED FROM EACH OTHER AND FROM ! THE PARAMETER ITSELF BY COLONS. ! EACH OPTION IS STORED IN N.OPL STARTING AT ! WORD ZERO FOR PRAMETER ONE AND WORD 5 FOR PARAMETER TWO ! THERE MAY BE ONLY FIVE PARAMETERS PER PARAMETER ! THE FIRST TWO PARAMETERS MAY BE ASCII,THE REST ! MUST BE NUMERIC. ! THE INPUT STRING IS TO BE DELIMITED BY COMMAS. ! BLANKS ARE IGNORED UNLESS THEY ARE WITHIN ASCII STRINGS. ! THE FIRST CHARACTER MUST BE ":" IF INPUT IS NOT FROM A TTY. ! ! ! LET TTY., \INTERACTIVE INPUT FLAG N.OPL, \NAMER SUBPARAMETER LIST .E.R., \ADDRESS LESS 1 OF SV CODE P.RAM, \PARAMETER LIST ARRAY NOCM., \NUMBER OF PARAMETERS FOUND G0.., \GLOBAL ARRAY CAD., \COMMAND FOUND (ADDRESS OR INDEX IF IN SEGMENT) ECH., \INPUT COMMAND LENGTH(WORDS) RESET FOR EC.HO C.DLM, \CHARACTER ADDRESS OF FIRST DELIMITER AFTER COMMAND C.TAB, \COMMAND TABLE (SIGN SET ON COMMAND INDICATES SPECIAL) CUSE., \CURRENT SEGMENT SUFFIX CHARACTER C.BUF, \COMMAND BUFFER O.BUF, \OUTPUT DCB, USED AS A WORKING BUFFER SCR. \CHARACTERS 3 AND 4 OF COMMAND (OR 0 IF NONE) BE INTEGER,EXTERNAL LET FM.ER, \PRINT ERROR MESSAGE ROUTINE EC.HO, \ECHO THE COMMAND ROUTINE CNUMD, \NUMBER TO ASCII CONVERSION ROUTINE MSS. \ERROR MESSAGE ROUTINE BE SUBROUTINE,EXTERNAL LET IN.ER BE SUBROUTINE LET COLON BE CONSTANT(72K ) LET BLANK BE CONSTANT(40K ) LET COMMA BE CONSTANT (54K ) LET CHAR0 BE CONSTANT(60K ) LET PSIGN BE CONSTANT(53K) LET MSIGN BE CONSTANT(55K) LET QUES BE CONSTANT( 77K) ! ! ! GETCR: FUNCTION DIRECT .B._PTR !CHARACTER ADDRESS TO B. ASSEMBLE["CLE,ERB"; \CORE ADDRESS TO B,E=U/L 0/1 "LDA 1,I"; \GET THE WORD "ELB"; \ADDRESS BACK TO B "SLB,INB,RSS"; \STEP THE ADDRESS SKIP IF LOW CHAR "ALF,ALF" ] !ROTATE TO LOW IF NEEDED PTR_.B. !RESTORE B TO POINTER .A.,CHAR_.A. AND 377K !ISOLATE THE CHARACTER AND SAVE RETURN .A. !DONE GET OUT END ! PUTCR: FUNCTION DIRECT IF [.B._BUFPT]=LIMIT THEN GO TO EXITF !EXIT IF NO ROOM .A._CHAR !CHAR TO A FOR ASSMBLY ASSEMBLE["CLE,ERB"; \WORD ADD TO B, U/L FLAG TO E "XOR 1,I"; \KEEP OLD HIGH CHAR "AND LOWM"; \IN CASE THIS IS LOW "XOR 1,I"; \NEW CHAR IN LOW A OLD IN HIGH "SEZ,RSS"; \IF UPPER "ALF,ALF"; \ROTATE "STA 1,I"; \STASH IT AWAY "ISZ BUFPT" ] !PUSH BUFFER POINTER BACK TO SPL IF CHAR=BLANK THEN[ \IF FIRST BLANK AFTER IFNOT BF THEN BUFPT_BUFPT-1; \BF SET TO ZERO RETURN 1], \RETURN TRUE FOR ALL BLANKS ELSE [ \NOT A BLANK BF,BFEND_BUFPT; \KEEP TRACK OF HIGHEST NON BLANK RETURN 0 \AND RETURN ZERO ] END ! GETCR.EQ.DELIM:FUNCTION DIRECT ! IF PTR=EOL THEN[ \IF END OF LINE STOPF,CHAR_1; \SET STOP FLAG AND GO TO DELT \EXIT TRUE ] IF GETCR=COLON THEN GO TO DELT !ELSE GET CHAR AND IF CHAR =COMMA THEN GO TO DELT !IF ":" OR "," EXIT TRUE RETURN 0 !EXIT FALSE NOT A DELIMITER ! DELT: RETURN 1 !EXIT TRUE A DELIMITER END ! DIGT: FUNCTION DIRECT IF [CRAC_CHAR-CHAR0] >= 0 THEN[ \IF GREATER THAN "0" IF CRAC < BASE THEN [ \AND LESS THAN BASE ACCUMULATE VAL_VAL*BASE+CRAC; \T NUMBER SET THE FLAG AND T_1; \ RETURN T \RETURN TRUE ] \ ] RETURN 0 !ELSE qRETURN FALSE END ! ! PARSE ROUTINE BEGINS HERE. ! .PARS:SUBROUTINE GLOBAL,FEXIT ! ! THE FOLLOWING IS PASS 1 OF A 2-PASS PARSE. THE PROMPT ! CHARACTER, IF PRESENT, IS REMOVED, GLOBALS ARE TRANSLATED AND ! BLANKS BEFORE AND AFTER DELIMITERS ARE REMOVED. ! BASE_10 LOWM_377K !ESTABLISH CONSTANT FOR PUTCH ACM,STOPF _ 0 !ZERO EOL FLAG AND COMMAND FLAG EF,PTR,CBUFC _[CBUFA_@C.BUF]-<1 !SET CHARACTER ADDRESSES EOL_CBUFC+ECH.+ECH. !END OF LINE FLAG BUFPT,CRONE_[C.DLM_@O.BUF]-<1 !OUT LINE CHAR ADDRESSES LIMIT_CRONE+80 !AND LIMIT ! IFNOT ECH. THEN GO TO START !IF EMPTY LINE GO TO PASS TWO IFNOT TTY. THEN[ \IF NOT INTERACTIVE IF GETCR # COLON THEN GO TO EXITF] !MUST HAVE LEAD ":" INGL: SIGN _ 1; OBUFS,BFEND_BUFPT !SET UP FOR VAL,T,BF_0 !SET BLANK STRIP FLAG PRAMS: IF GETCR.EQ.DELIM THEN GO TO ENDP !LOOP TILL DELIMITER ! IF PUTCR THEN GO TO PRAMS !PASS BLANKS IF CHAR = MSIGN THEN GO TO NGLBL !LOOK FOR NUMERICS IF CHAR = PSIGN THEN GOTO GLBL !GLOBAL PARAMETERS. IF DIGT THEN GOTO GLBL !FOUND A DIGIT. ! ! SCAN TO NEXT DELIMITER IT IS NOT A GLOBAL ! TOEND:UNTIL GETCR.EQ.DELIM DO PUTCR !PASS TILL NEXT PRAM ! ENDP: BUFPT_BFEND !STRIP TRAILING BLANKS IF STOPF THEN GO TO START !IF EOL THEN GO TO PASS 2 PUTCR !ELSE PASS THE DELIMITER GO TO INGL !ELSE GET NEXT PRAM ! ! SIGN PART OF NUMBER DETECTED MIGHT BE GLOBAL ! NGLBL:SIGN_ -1 !IT WAS A "-" SO SET FLAG GLBL: IF GETCR.EQ.DELIM THEN GO TO ENDP !NOT GLOBAL IF DELIMITER IF PUTCR THEN GO TO GLBL !JUST PASS BLANKS  IF DIGT THEN GO TO GLBL !KEEP A TOTAL OF IF CHAR = "G" THEN [ \LOOK FOR GLOBAL GV _ 0; \DESIGNATORS. SETSZ: SZ _ 4; GOTO REPL] IF CHAR = "S" THEN [ \ GV _ -8; GOTO SETSZ] IF CHAR = "P" THEN [ \ GV _ 40; SZ _ 1; \ GOTO REPL] GOTO TOEND !NOT DIGIT OR "S","G","P" ! REPL: IFNOT T THEN GOTO TOEND !CHECK IF WE HAVE UNTIL GETCR.EQ.DELIM DO[ \PASS ANY TRAILING BLANKS IFNOT PUTCR THEN GO TO TOEND] !IF OTHER THEN NOT GLOBAL ! ! HONEST TO GOODIE GLOBAL BUT IS IT IN RANGE?? ! CBUFS_PTR-1 !SAVE IN ADD (REREAD DELIMITER) ADD _ VAL * SIGN * SZ + GV !A REAL GLOBAL. IF ADD < -8 THEN GO TO EXITF !CHECK BOUNDS. IF ADD > 47 THEN GO TO EXITF ADD _ ADD + @G0.. !GET TABLE OFFSET. BUFPT,BFEND_OBUFS !SET OUTBUF BACK ! ! EVALUATE GLOBAL ! IF SZ # 1 THEN [SZ _ $ADD;ADD_ADD+1] !IF NOT "P" SET SIZE IF SZ = 1 THEN[ \IF NUMERIC GLOBAL VAL_$ADD; \CONVERT THE NUMBER IF VAL < 0 THEN[ \IF NEGATIVE MUST SET VAL_ -VAL;CHAR_MSIGN; \POSITIVE AND SEND A "-" PUTCR \ SEND THE "-" ];\ CALL CNUMD(VAL,P.RAM); \CONVERT THE NUMBER ADD_ @P.RAM \SET RESULT ADDRESS ] IF SZ THEN[ \IF THEIR IS A PARAMETER PTR_ADD-< 1;BF,EF_0; \SET TO MOVE IT IN REPEAT 6 TIMES DO [ \ GETCR;PUTCR \MOVE A CHARACTER ] \ ] EF,PTR_CBUFS;GETCR !RESET SOURCE POINTER CHAR GO TO ENDP !GO PROCESS THE DELIMITER ! ! THE SECOND PASS. ! ! INITIALIZE SCAN ! START:BF,CHAR_BLANK !PAD LINE IN CASE ODD CHARS EOL_BUFPT-CRONE+CBUFC !SET EOL FLAG FOR PASS 2. PUTCR !SEND FINAL CHAR. ECH._(BUFPT-CRONE) >- 1 !SET LINE LENGTH IN WORDS. ASSEMBLE["LDA C.DLM"; \SET UP FOR .MVW "LDB CBUFA"; \ "EXT .MVW" ; \ "JSB .MVW"; \MOVE THE BUFFER BACK "DEF ECH."; \ "NOP" ] PTR_CBUFC !SET FOR INPUT IFNOT $(@.E.R.+1) THEN [ \ECHO IF REQUIRED IF C.BUF # "SV" THEN EC.HO \LET SV ECHO ITS OWN ] CAD._@IN.ER STOPF,C.DLM_0 FOR T_ @N.OPL TO @NOCM. DO $T_0 !ZERO THE OPTION LIST LIMIT_([PRAM_@P.RAM]+64) -< 1 !SET PUTCR LIMIT GO TO SCANS !GO START THE SCAN ! GETCH:UNTIL GETCR.EQ.DELIM DO[ PUTCR;GV_CHAR]!MOVE CHARACTERS UNTIL DELIM ! ! A DELIMITER 0 OR COMMA OR COLON - ENCOUNTERED ! VAL,T_0 ! SET UP FOR NUMERIC CONVERSION IF C.DLM THEN GO TO PRMST !IF WE HAVE A COMMAND GO TO PRAM ADD_@C.TAB !MUST BE THE COMMAND SO C.DLM_PTR !SAVE FIRST DELIMITER ADDRESS SCR. _ $PLOC1 ! SAVE CHARS 3,4 ALWAYS DO[ \AND LOOK IT UP IN IF ($ADD AND 77777K)=$PLOC THEN[ \ ACM_$ADD;CAD._$(ADD+1);GO TO RPLOC],\ ELSE [ADD_ADD+2; \FIND THE PROCESSOR IN TABLE IFNOT $ADD THEN GOTO EXITF \ ] \ ] ! ! NOT FIRST SO SET UP THE PARAMETER ! PRMST:CBUFS_PTR-1;POS_BUFPT !SAVOE DELIMITER ADDRESS, END ADD IF BUFPT=CUPAD THEN GOTO NULLS !NULL SO ZERO IT ! ! ATTEMPT NUMERIC CONVERSION ! IF GV = "B" THEN[ \IF OCTAL SET UP BASE_8;POS_POS-1], \BASE AND END OF STRING ELSE \OTHER WISE USE BASE_10 !BASE 10 ! PTR_CUPAD;SIGN_1 !SET FOR LOOP ! ! CONVERSION LOOP ! UNTIL PTR=POS DO THRU CLOOP IF GETCR= BLANK THEN GOTO CLOOP !IGNOR IMBEDED BLANKS IFNOT DIGT THEN [ \IF NOT DIGIT IF PTR=SZ THEN[ \IF FIRST CHAR TEST IF CHAR=MSIGN THEN[SIGN_-SIGN;GO TO CLOOP];\ IF CHAR=PSIGN THEN GO TO CLOOP \ ]; \ GO TO NOTNO \NOT DIGIT OR LEGAL SIGN ] CLOOP: !END OF CONVERSION LOOP ! ! SET TYPE AND NO. IN THE LIST ! IFNOT [$PLOC0_T] THEN GOTO NOTNO !IF NO DIGITS-NOT A NUMBER NULLS:$PLOC_VAL*SIGN !SET THE VALUE IN THE LIST $[REAL]PLOC1_0.0 !ZERO THE EXTRA WORDS ! ! SET UP FOR THE NEXT PARAMETER ! NXPRM:PTR_CBUFS;GETCR !GET THE DELIMITER IFNOT SBSCN THEN GO TO NOTSU !SKIP IF NOT SUB SCAN IF [SUBCO_SUBCO+1]<3 THEN GOTO STPM !SKIP ASC TEST IF FIRST TWO ! !101779 (2001) IF $PLOC0=3 THEN GO TO SKIPP !SUB PRAMETERS ELSE ASC ERROR STPM: IF NOCM.< 3 THEN$(SBSCN+SUBCO)_$PLOC !SET THE SUB PRAM IN THE OP LIST ! IF CHAR=COLON THEN[IF SUBCO=5 THEN GOTO SKIPP ,\ TOO MANY 101779 ELSE GO TO RPLOC] !GO GET NEXT SUB PRAM ! SCANS:SUBCO,SBSCN_0 !ZERO THE SUB SCAN FLAGS ! SCANC:PLOC1_[PLOC_[PLOC0_PRAM+4*NOCM.]+1]+1 !SET THE CURRENT ADDRESSES ! RPLOC:SZ_[CUPAD,BUFPT_PLOC -< 1]+1 !SET ADDRESSES FOR PUTCR IF CUPAD>LIMIT THEN GO TO EXITF !TOO MANY PRAMS? $PLOC0,$PLOC,$PLOC1_0 !SET LIST LOCATIONS TO ZERO IF STOPF THEN GO TO EXIT !IF FINAL DELIMITER EXIT GO TO GETCH !ELSE GET NEXT PRAM ! ! PARAMETER END NOT SUB PRAM ! NOTSU: IF CHAR = COLON THEN [ \CHECK FOR ILLEGAL IF NOCM. > 1 THEN [ \DELIMITER, BUT LET IF ACM > 0 THEN \IT GO THROUGH IN GOTO EXITF,ELSE \CASE OF SPECIALS 101779 [NOCM._NOCM.+1;GOTO SKIP1]],\ ELSE SBSCN _ @TTY. + NOCM.*5] !SET UP SUB-SCAN. ! NOCM._NOCM.+1 !STEP COUNT GO TO SCANC !GO SCAN IT ! ! NOT A LEGAL NUMBER - TRY FOR A NAME ! NOTNO:$PLOC0_3 !ASSUME NAME AND SET UP CHAR_BLANK !SET UP TO BLANK FILL UNTIL BUFPT=>CUPAD+6 DO PUTCR !FILL IT GO TO NXPRM !ASSUME A NAME AND CONTINUE ! ! NORMAL EXIT ROUTINE CLEAR END OF LIST AND CHECK FOR SEG ! EXIT: CHAR_0 UNTIL BUFPT >= LIMIT DO PUTCR !ZAP THE LIST IF CAD.<0 THEN GO TO EXIT1 !IF LOCAL GO EXIT IF CAD.>10000K THEN GO TO EXIT1 !IF LOCAL GO TO EXIT. CHAR,CUSE._(CAD. AND 377K)-<8 ! CAD._((CAD. AND 17400K)-<8) !SET ROUTINE NUMBER IN CAD. EXIT1:.B._ACM !SET ASCII COMMAND IN B FOR MAIN IFNOT CHAR THEN RETURN,ELSE FRETURN ! EXITF:IF ACM<0 THEN GO TO EXIT !IF WE HAVE A SPECIAL THEN EXIT EXITG:IFNOT EF THEN PTR_CBUFS !IF ERROR WHILE PTR WRONG RESET CAD._@IN.ER;CHAR_0;GO TO EXIT1 !ELSE ERROR EXIT ! ! 101779 ! PARSE ERROR ON A SUBPARAMETER. IF SPECIAL CMND, IGNORE EVERYTHING ! UNTIL NEXT COMMA OR END OF LINE IS FOUND. ! SKIPP:IF ACM >= 0 THEN GOTO EXITG !IFNOT SPECIAL, EXIT SKIP1:IF CHAR=COLON THEN [ \FLUSH THE SUB PARMS SKIP2: IFNOT GETCR.EQ.DELIM THEN \ GOTO SKIP2; \SKIP UNTIL NEXT DELIMITER IF STOPF THEN GOTO EXIT, \EXIT IF END OF LINE ELSE GOTO SKIP1] !GO CHECK FOR ANOTHER SUB-P GOTO SCANS !WHEN A COMMA IS FOUND, CONTINUE END ! IN.ER:SUBROUTINE MSS.(10) !FOURCE ECHO AND PRINT ERROR BUFPT_PTR;CHAR_QUES;PUTCR !PLANT A "?" CHAR_BLANK;PUTCR !AND A BLANK PAD FM.ER(1,C.BUF ,(BUFPT-CBUFC)>-1) !WRITE IT OUT RETURN END END END$ SPL,L,O ! NAME: REA.C ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 REA.C(8) "92002-16008 770823" ! READ A COMMAND SUBROUTINE ! LET MSS.,READF,EC.HO,WRITF BE SUBROUTINE,EXTERNAL LET .E.R.,CAM.I,TTY.,ECH.,C.BUF BE INTEGER,EXTERNAL ! REA.C:SUBROUTINE GLOBAL ! IF TTY THEN PROMPT READ1:IF TTY. THEN CALL WRITF(CAM.I,.E.R.,35137K,1) !WRITE ":" ! ! CALL READF(CAM.I,.E.R.,C.BUF,36,ECH.)!READ THE COMMAND ! IF .E.R. < 0 THEN[MSS.(.E.R.-2000);GOTO EY]!IF READ ERROR DO A TR IFNOT ECH. THEN GOTO READ1 EX: IF ECH. <0 THEN[ \IF EOF SET ZERO LENGTH EY: ECH._0] ! ! RETURN END ! END END$ SPL,L,O ! NAME: EE.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 EE..(8) "92002-16008 760512" EE..: SUBROUTINE GLOBAL LET FM.ER,CLOS.,EXEC BE SUBROUTINE,EXTERNAL LET CUSE.,CAD. BE INTEGER,EXTERNAL LET ACTV. BE INTEGER,EXTERNAL LET L.SEG,ABX.. BE LABEL,EXTERNAL IF ACTV. THEN GO TO ABX.. ENDMS_@CUSE.-5 FM.ER(0,$ENDMS,5) CLOS.($0) EXEC (5,-1) CAD. _ 0; CUSE. _ "77" !SET TO GET NEXT JOB GOTO L.SEG !GO LOAD SEGMENT. END END END$ SPL,L,O ! NAME: TR.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A., 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 TR..(8) "92002-16008 REV.1826 780419" ! ! MODIFIED: 780413 TO USE TRANS FILE SECURITY CODES (GLM) ! ! LE GRAND TR ROUTINE ! LET OPEN., \FILE OPEN OR FAKE OPEN READF, \READ RECORD IER., \CHECK ERROR (IN FM.CM) EE.., \FMGR EXIT ROUTINE GLOBS \SET UP GLOBALS 0 BE SUBROUTINE,EXTERNAL ! LET P.TR, \TRANSFER STACK POINTER CAMS., \TRANSFER STACK CAM.I, \COMMAND INPUT DCB .E.R., \ERROR CODE ACTV., \ACTIVE JOB POINTER N.OPL \SUB-PARAMETER STORAGE BE INTEGER,EXTERNAL ! LET FM.AB, \IN FMGR MAIN ABX.. \ BE LABEL,EXTERNAL ! TR..: SUBROUTINE(N,LIS,ERR)GLOBAL !TRANSFER SUBROUTINE DCB14_[DCB2_@CAM.I+2]+12 !ADDRESS OF RECORD COUNT, TYPE ! PLIST_[NFI,NFA_@LIS+1]+3 !GET PARAMETER ADDRESSES. IFNOT $NFA THEN $NFA_$NFA-1 !MAKE UNIFORM BACK UP IF $NFA < 0 THEN [ \IF WE ARE GOING BACK*780413* BADFILE: RC_$([CR_[NFI_[PTR_P.TR+6*($NFA-1)]+1]+3]+2);\PULL GOODIES FROM IF N.OPL < 0 THEN RC_RC+N.OPL; \IF BACK SPACE REQUESTED IF RC < 0 THEN RC_0; \SET IT UP IF PTR+6 < ACTV. THEN GO TO ABX..; \IF TOO FAR ABORT JOB *780419* IF PTR < @CAMS. THEN EE..; \IF PASSED START GO EXIT RS_$[P.TR_PTR]], \LOOKS GOOD LETS BUY IT ELSE [ \GOING FORWARD RC_0; \SET POINTERS FOR RETURN CR,PTR_@N.OPL; \AND THE CALL IF P.TR-@CAMS. > 48 THEN [ \IF TOO DEEP *780413* ERR _ 13; RETURN] \TAKE GAS. ] !LOOKS GOOD , LETS DO IT CALL GLOBS(N-1,$PLIST,1) ? \SET UP GLOBALS. [ERR _ 48; RETURN] !ERROR IN GLOBAL SET. OPEN.(CAM.I,$NFI,$CR ,401K) !OPEN NEW INPUT FILE. IF .E.R.< 0 THEN[ \IF ERROR AND HERE THEN SV>3 Qw N.OPL,$NFA_0;GO TO BADFILE] !MUST REOPEN ORGIONAL FILE $PTR_RS !RESET RECORD COUNT IF RC THEN [ \IF NEEDED. IF $DCB2 THEN[ \(MUST NOT BE TYPE ZERO) UNTIL $DCB14 = RC DO [ \READ AS MANY RECORDS READF(CAM.I,.E.R.,C.BUF,1); \AS NECESSARY FOR IER.]]] !POSITIONING. RETURN END ! END END$ SPL,L,O ! NAME: SA.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 SA..(8)"92002-16008 760621" ! THIS ROUTINE IS TO SAVE LS/LG ROUTINE FOR THE ! RTE FMGR PROGRAM. IT IS ENTERED BY ENTERING ! A COMMAND OF THE FORM: ! ! SA,LS/LG,NAMR !PRAM LOC 1 5 ! ! W H E R E: ! ! SA IS THE COMMAND NAME. ! ! LS/LG IS LS TO SAVE THE LS FILE, ! OR LG TO SAVE THE LOAD & GO FILE. ! ! NAMR IS TO BE THE NEW FILE'S NAME REFERENCE. ! ! ! THE FOLLOWING NAMR PARAMETERS ARE OPTIONAL: ! ! CR IS THE CARTRIDGE TO BE USED TO SAVE ! (ZERO IF NOT GIVEN). ! ! SC IS THE FILE'S SECURITY CODE ! (ZERO IF NOT GIVEN). ! ! TY IS THE FILE'S TYPE (4 FOR LS OR ! 5 FOR LG IF NOT GIVEN). ! ! SZ1 IS THE FILES SIZE ESTIMATE USED FOR LS FILES ONLY ! IF NOT GIVEN THE THE FILE IS ESTIMATED TO FILL ! LESS THAN HALF A TRACK. EXCESS THEN GENERATES AN EXTENT ! IF LESS THAN THE ESTIMATED SIZE IS USED THE ! EXCESS IS RETURNED TO THE SYSTEM ! ! CONSTANT DECLARATIONS ! LET A BE CONSTANT(0 ) LET B BE CONSTANT (1 ) LET XEQT BE CONSTANT (1717K) LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) LET LGOTK BE CONSTANT (1765K) LET LGOC BE CONSTANT (1766K) LET LG BE CONSTANT (46107K) LET LS BE CONSTANT (46123K) ! ! DECLARE THE ERROR WORD LOCATION ! LET .E.R.,N.OPL BE INTEGER,EXTERNAL ! ! ARRAY DECLARATIONS ! LET O.BUF,I.BUF,BUF.,CUSE. BE INTEGER,EXTERNAL ! ! ! SUBROUTINE DECLARATIONS ! LET CREA.,OPEN.,IER.,\ WRITF,LOCF,CLOSE,\ READ.,READF,RWNDF,\ MSS.,EXEC,CK.SM BE SUBROUTINE,EXTERNAL ! LET LSRD,LGRD,READR,\ GET BE SUBROUTINE ! LET IFBRK BE FUNCTION,EXTERNAL LET LG.S BE FUNCTION SA..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL LET NCAM,PLIST,MSNO BE INTEGER LIS5_[LIS1_@PLIST+1]+4 !SET LIST ADDRESSES SZ_[RS _[SC_@N.OPL+5]+2]+1 !SET OPTION LIST ADDRESSES ! IF NCAM<2 THEN[MSNO_50;RETURN] IF $LIS1=LG THEN GO TO SALG IF $LIS1#LS THEN [MSNO_56; RETURN] !NOT LS OR LG SO ABORT CUSE._0 !SHOW SEGMENT NOT IN CORE FOR NEXT TIME OPFL_101000K !SET PUNCH OPTION FLAG DO[T1_4;SIZE_$SECT2/4;RD_@LSRD]!SET UP DEFAULT SIZE SA02: IFNOT $SZ THEN $SZ_SIZE !SET DEFAULT SIZE IF NOT SUPPLIED IFNOT $RS THEN $RS _T1 !SET DEFAULT TYPE TYPE_$RS !SET TYPE FOR LATER CREA.(O.BUF,$LIS5,$SC)?[TYPE_0;\!CREAT THE FILE OPEN.(O.BUF,$LIS5,$SC,OPFL)]!OPEN IF NOT A FILE NAME FIRST_1 LOOP: CALL $RD !READ A RECORD IF IFBRK() THEN [MSS.(0);GO TO ABOR] L_IL IFNOT IL THEN[IFNOT TYPE THEN L_-1] WRITF(O.BUF,.E.R.,BUF.,L) !WRITE IT IF .E.R.= -6 TkHEN[MSS.(.E.R.);GOTO ABOR]!PURGE FILE IER. ! ANY ERRORS? IF IL=>0 THEN GO TO LOOP ! IF NOT EOF CONTINUE ! IFNOT TYPE THEN RETURN LOCF(O.BUF,.E.R.,T,RS) !GET CURRENT POSITION IER. TRUN: CLOSE(O.BUF,.E.R.,$SZ -RS-1)!CLOSE & TRUNCATE IER. EXIT: RETURN !DONE RETURN SALG: TY_0 !SET LOAD & GO FLAG T1_5 !SET DEFAULT TYPE OPFL_101100K !SET THE OPTION FLAG SIZE _(([T_LG.S() ?[MSNO_58;RETURN]]+3)>-1)+T/5 !SIZE ESTIMATE RD_@LGRD !SET THE READ ROUTINE ADDRESS GO TO SA02 !GO DO IT END LSRD: SUBROUTINE READ.(2,BUF.,70,IL) RETURN END ! LGRD: SUBROUTINE BUF1_[BUF_@BUF.]+1 IFNOT FIRST THEN GOTO XFER IBUF4_[IBUF3_[IBUF2_[IBUF_@I.BUF]+2]+1]+1 IBU15 _[IBUF9_[IBUF8_[IBUF7_[IBUF6_[IBUF5_ \ SET UP BUFFER ADDRESSES IBUF4+1 ]+1]+1]+1]+1]+6 $IBUF_[IF $LGOTK<0 THEN 3,ELSE 2] $(IBUF2 )_2 $(IBUF3 )_($LGOTK AND 77600K)-<9 $IBUF4,$IBU15_0 $IBUF7_200K $(IBUF5)_([MXRC_LG.S()]+3) $IBUF6_64 $(IBUF8 )_[IF $IBUF=3 THEN $SECT3,ELSE $SECT2] $(IBUF9 )_$XEQT RWNDF(I.BUF,.E.R.) IER. DO[RC,FIRST,ENFLG_0;READR] XFER: IFNOT ENFLG THEN GOTO LGRD2 IF ENFLG=1 THEN[ENFLG_2;IL_0;RETURN] LGRD1:DO[ENFLG_0;IF ADD#@PLIST THEN READR;IL_-1;\ IF RC>MXRC THEN RETURN] LGRD2:GET(BUF.,1) IFNOT $BUF THEN GO TO LGRD1 GET ( $BUF1 ,[IL_$BUF-<8]-1) CK.SM(BUF.,1)?[GOTO ABORT] IF ( $BUF1 AND 160000K)=120000K THEN ENFLG_1 RETURN ABORT:MSS.(7) ABOR: IFNOT TYPE THEN GO TO EXIT ! IF TYPE ZERO THEN EXIT DO[$(@O.BUF+15)_0;RS_-1;GO TO TRUN] END ! ! GET: SUBROUTINE(DS,NO) ED_@DS+NO-1 FOR I_@DS TO ED DO THRU GET0 $I_$ADD ADD_ADD+1 GET0: IF ADD=ENADD THEN READR RETURN END ! READR:SUBROUTINE DO[READF(I.BUF,.E.R.,PLIST);IER.] ENADD_ZXT[ADD_@PLIST]+64 RC_RC+1 RETURN END ! LG.S: FUNCTION FEXIT LG.SV_((($LGOC AND 77600K)-($LGOTK AND 77600K))\ -<9)*[IF $LGOTK<0 THEN $SECT3,ELSE $SECT2]\ +($LGOC AND 177K) IF LG.SV THEN RETURN,ELSE FRETURN END END END$ ZSPL,L,O ! NAME: MR.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 MR..(8)"92002-16008 760621" ! ! ! ! THIS PORTION OF THE FILE MANAGER RESTORES ! A FILE TO THE SYSTEM LOAD AND GO AREA. ! ! ! THE COMMAND IS: ! ! LG,NAMR ! ! ! W H E R E: ! ! NAMR IS THE FILE NAME WHICH MAY CONTAIN THE: ! CR IS ITS CARTRIDGE ID (OPTIONAL). ! SC IS ITS SECURITY CODE (OPTIONAL). ! ! ! ARRAY DECLARATIONS: ! LET O.BUF,I.BUF,BUF.,N.OPL BE INTEGER,EXTERNAL ! ! DECLARE THE ERROR WORD LOCATION ! LET .E.R. BE INTEGER,EXTERNAL ! LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) LET LGCO BE CONSTANT (1766K) LET LGOTK BE CONSTANT (1765K) ! LET LGMS,LGMS2 BE INTEGER INITIALIZE LGMS,LGMS2 TO "LG, " ! ! ! EXTERNAL SUBROUTINE DECLARATIONS: ! LET CK.SM,READF,OPEN.,\ CNUMD, \ MSS.,EXEC, \ IER. BE SUBROUTINE,EXTERNAL LET JER.,.DFER BE SUBROUTINE,EXTERNAL,DIRECT LET WRLG.,EFLG.,MESSS BE FUNCTION,EXTERNAL ! ! MR..: SUBROUTINE(NCAM,PLIST,MSNO)GLOBAL IFNOT NCAM THEN[MSNO_50;RETURN] OPEN.(I.BUF,$(@PLIST+1),N.OPL,301K) !NON-EXCLUSIVE OPEN IF $LGOTK AND 177K THEN GO TO LG0 !IF LG AREA DEFINED DO IT IFNOT [SZ_$SECT3] THEN SZ_$SECT2 !SET SIZE OF LG DISC FSZ_$([TYP_ @I.BUF+2]+3) !GET FILE DATA FROM DCB IFNOT $TYP THEN [SZ_4;GO TO ASLG] !IF TYPE 0 USE FOUR TRACKS SZ_FSZ/SZ +2 !ELSE 2 PLUS ESTIMATE (GENEROUS) ASLG: CALL .DFER(O.BUF,LGMS) !SET UP MESSAGE CALL CNUMD(SZ,$(@O.BUF+2)) !PUT IN THE NUMBER IF MESSS(O.BUF,10) THEN[ \IF NO LG TRACKS NOTR: MSNO_58;RETURN] !RETURN AN ERROR ! LG0: FLG_0 LG1: READF(I.BUF,.E.R.,BUF.,64,L) !READ A RECORD JER. IF L<1 THEN GOTO LG2 CK.SM(BUF.,1)?[MSNO_7;RETURN] FLG_1 IF WRLG.(BUF.,(BUF.-<8),O.BUF) THEN GO TO NOTR IFNOT($(@BUF.+1) AND 160000K) = 120000K THEN\ GOTO LG1, ELSE[FLG_0;\ IF EFLG.(L) THEN GO TO NOTR; \ GO TO LG1] ! LG2: IF FLG THEN[MSS.(2006);EXEC(7);GOTO LG1] IFNOT L THEN GO TO LG1 RETURN END END END$ SPL,L,O ! NAME: SE.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: A.M.G. ! DATE: 740927 ! ! *************************************************************** ! * (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 SE..(8) ! ! LET G0.. BE INTEGER,EXTERNAL ! LET GLOBS BE SUBROUTINE ! LET PTR,PTR0,PTR1,PTR2 BE INTEGER ! ! SE..: SUBROUTINE(NUM,PLIST,ERR) GLOBAL LET NUM,PLIST,ERR BE INTEGER CALL GLOBS(NUM,PLIST,0) ? [ERR _ 48] RETURN END ! GLOBS: SUBROUTINE(NUMB,GLOBL,IND) GLOBAL,FEXIT LET GLOBL,NUMB,IND BE INTEGER LET G0.. BE INTEGER,EXTERNAL PTR,PTR2 _ @GLOBL IF NUMB > 9 THEN NUMB _ 9 !TOO MANY PARAMETERS? IF NUMB THEN GOTO GLOB2 !IF THERE ARE NONE IF IND THEN GOTO GLOB.2 !AND THIS IS A "SET" PTR1 _ @G0.. + 3 !THEN NULL ALL THE FOR I _ 1 TO 36 DO [ \GLOBALS. $[PTR1 _ PTR1 + 1] _ 0] RETURN GLOB2: PTR _ PTR + 2 !SET POINTERS. PTR1 _ [PTR0 _ @G0.. + 4] + 2 FOR I _ 1 TO NUMB DO [ \MOVE ALL NON-NULL IF $PTR2 = 0 THEN GOTO GLOB3; \PARAMETERS TO THE $[REAL]PTR0 _ $[REAL]PTR2; \GLOBALS IN THE MAIN. $[REAL]PTR1 _ $[REAL]PTR; \ GLOB3: PTR _ [PTR2 _ PTR2 + 4] + 2; \ PTR1 _ [PTR0 _ PTR0 + 4] + 2] RETURN END END END$ SPL,L,O ! NAME: IF.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 IF..(8) "92002-16008 REV.2001 791017" ! ! MODIFIED TO CHECK FOR AN ASCII SKIP VALUE. 101779 GLM. ! ! LET READF,POSNT,IER. BE SUBROUTINE,EXTERNAL LET C.BUF BE REAL,EXTERNAL LET CAM.I,NO.RD,TTY. BE INTEGER,EXTERNAL LET .E.R.,CAD. BE INTEGER,EXTERNAL ! LET ETAB BE CONSTANT (43K) LET LTAB BE CONSTANT (31K) LET GTAB BE CONSTANT (26K) LET FTR BE INTEGER (2) LET DIF,NCOM,P1,P2,MASK,RTABP,REL BE INTEGER LET RTAB BE INTEGER (7) INITIALIZE FTR TO "TR",0 INITIALIZE RTAB TO "LEGEGTLTNEEQ",0 ! ! IF..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER IF TTY. THEN [ERR _ 10; RETURN] !IF TTY, REJECT REQ. NCOM _ [P2 _ [REL _ [P1 _ \SET UP POINTERS. @PLIST - 1] + 6] + 2] + 6 FOR I _ 1 TO 4 DO [ \COMPARE P1 AND P2. IF [DIF _ $[P1 _ P1 + 1] \ - $[P2 _ P2 + 1]] THEN \ GOTO COMP] COMP: DIF _ [IF DIF < 0 THEN \GET APPROPRIATE LTAB, ELSE [IF DIF THEN GTAB, \MASK WORD. ELSE ETAB]] RTABP _ @REL; MASK _ 1 CLOOP: IFNOT $[RTABP _ RTABP + 1] \MATCH RELATION THEN [ERR _ 56; RETURN] !USED IN COMMAND. IFNOT $RTABP = $REL THEN [ \ MASK _ MASK <- 1; GOTO CLOOP] IFNOT (MASK AND DIF) THEN RETURN IFNOT $NCOM THEN $NCOM _ 1 !DEFAULT SKIP IF $(NCOM-1)=3 THEN [ERR_56;RETURN] !ERROR IF SKIP IS ASCII 101779 CALL POSNT(CAM.I,.E.R.,$NCOM) !SKIP INDICATED IF .E.R.= -12 THEN [ \ IF $NCOM<0 THEN RETURN; \ N,$(@PLIST+1)_0; \ CAD.,NO.RD _ 1 ; \ RETURN ] IER. RETURN END END END$ SPL,L,O ! NAME: AB.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: A.M.G, 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 AB..(8) "92002-16008 REV.1826 780420" ! ! MOD:TO CLOSE O.BUF BEFORE CALLING .PARS (O.BUF IS USED BY *780221 ! .PARS AS TEMPORARY STORAGE). *780221 ! ! TO WORK WITH SIX WORDS PER ENTRY IN TRANS STACK *780420 ! ! ! LET REA.C, \READS A COMMAND .PARS, \PARSE ROUTINE TR.., \LE GRAND TR ROUTINE IER., \ERROR CHECK ROUTINE OPEN., \OPEN FOR LIST FILE OPEN CLOS., \CLOSE FOR LIST FILE CLOSE WRITF \FILE WRITE ROUTINE BE SUBROUTINE,EXTERNAL ! LET .DFER \THREE WORD TRANSFER BE SUBROUTINE,DIRECT,EXTERNAL ! LET L.SEG BE LABEL,EXTERNAL ! LET ABX.. BE LABEL,GLOBAL ! LET ACTV., \ACTIVE JOB SWITCH CUSE., \CURRENT SEGMENT LAST CHAR. O.BUF, \OUTPUT DCB NOCM., \NUMBER OF PRAMETERS IN COMMAND J.REC, \JOBFIL RECORD OF SPOOLED JOB CAD., \TABLE OFFSET FOR FUNCTION CALL TMP., \LIST FILE LOCATION P.TR, \COMMAND UNIT STACK POINTER J.NAM, \CURRENT JOB NAME C.BUF, \COMMAND INPUT BUFFER TTY., \INTERACTIVE DEVICE FLAG .E.R., \LOCATION OF SEVERITY CODE -1. ECH., \# OF CHARACTERS IN COMMAND NO.RD \NO-READ FLAG BE INTEGER,EXTERNAL ! LET ABJOB(3),JBNAM(7),ABRT(8),COM BE INTEGER ! INITIALIZE ABJOB,JBNAM TO " JOB XXXXXX ABORTED" INITIALIZE ABRT TO " ABEND OPERATOR " ! ! AB..: SUBROUTINE(N,PLIST,ERR) GLOBAL LET N,PLIST,ERR BE INTEGER IFNOT ACTV. THEN [ERR_10;RETURN] !INPUT ERROR IF NOT IN JOB .DFER(JBNAM,J.NAM) !PUT JOB NAME IN MESSAGE COM _ @ABRT; LN _ 8 !SET UP STANDARD MESSAGE. IF N= -1 THEN [ \IF INTERNAL CALL, SET COM _ @ABJOB; LN _ 10] !UP JOB ABORT MESSAGE. IF N= -2 THEN COM_@PLIST !IF MESSAGE PASSED SET UP CALL OPEN.(O.BUF,TMP.,$(@TMP.+3),0) !OPEN THE LIST FILE CALL WRITF(O.BUF,.E.R.,$COM,LN) !SEND THE OPERATOR ABORT CALL CLOS.(O.BUF) ^ !CLOSE THE LIST FILE *780221 IF P.TR # ACTV. THEN [P.TR_ACTV.+6; \SET P.TR FOR TR *780420 N.OPL_0; \DON'T CONFUSE THE ISSUE CALL TR..(1,0.0,ER)] !SET BACK TO THE JOB FILE IF TTY. THEN [ \IF TTY THEN EOJ: CAD._1;CUSE._"66";GO TO L.SEG] !GO LOAD EOJ IF J.REC > 0 THEN GO TO EOJ !IF JOB IS NOT $(@.E.R.+1)_1 !SET SV CODE TO KILL ECHO RDCOM: CALL REA.C !SPOOLED AND INPUT IFNOT ECH. THEN[ \IF EOF THEN GO TO EOJ ABX..: NOCM._ -2;GO TO EOJ] CALL .PARS !IS NOT FROM A COMCK: IF [COM _ $1] = "EO" THEN GO TO ABRET!EOF,THEN READ IF COM = "JO" THEN GOTO ABRET !COMMANDS UNTIL A GOTO RDCOM !JOB CARD IS FOUND. ! ABRET: NO.RD_ -1;RETURN END ! ! INTERNAL ABORT ROUTINE ! ABT..: SUBROUTINE GLOBAL IF ACTV. THEN CALL AB..(-1) !IF A JOB ACTIVE GO DO ABORT RETURN END END END$ SPL,L,O ! NAME: IN.IT ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 IN.IT(8) "92002-16008 780106" LET OPEN.,D.RIO,DR.RD, CLOS.,MSS.,\ EE.. BE SUBROUTINE,EXTERNAL LET .DFER BE SUBROUTINE,EXTERNAL,DIRECT LET TATPU,SETM3 BE SUBROUTINE LET TTY. BE INTEGER,EXTERNAL LET PK.DR,D.SDR BE INTEGER,EXTERNAL LET FM.AB BE LABEL,EXTERNAEL LET GT.JB BE LABEL,EXTERNAL LET INI1. BE LABEL,EXTERNAL LET I.BUF,TMP.,.R.E.,.E.R.,G0..,NO.RD BE INTEGER,EXTERNAL LET C.BUF,ECH. BE INTEGER,EXTERNAL LET CAM.I,CAM.O,D.LT BE INTEGER,EXTERNAL LET EXEC,IPUT BE SUBROUTINE,EXTERNAL LET FID. BE FUNCTION,EXTERNAL LET .OPSY BE FUNCTION,EXTERNAL,DIRECT !IDENTIFY OP-SYS LET .TTY BE FUNCTION,EXTERNAL LET FM.AB BE LABEL,EXTERNAL LET IFLG. BE INTEGER,EXTERNAL LET D. BE INTEGER,EXTERNAL LET GASP(3),WELCM(2),X16(3) BE INTEGER INITIALIZE GASP TO "GASP " INITIALIZE WELCM,X16 TO "WELCOM",1,6 LET RT BE CONSTANT(51124K) LET RNULL BE CONSTANT(51000K) LET A BE CONSTANT(0 ) LET B BE CONSTANT(1 ) LET READI BE CONSTANT(1 ) LET TAT BE CONSTANT(1656K) LET TATLG BE CONSTANT(1755K) LET TATSD BE CONSTANT(1756K) LET SECT3 BE CONSTANT(1760K) LET XEQT BE CONSTANT(1717K) LET WRIT BE CONSTANT(2 ) LET KEYWD BE CONSTANT(1657K) LET RTCOM BE CONSTANT(1747K) LET RTDRA BE CONSTANT(1750K) LET BGDRA BE CONSTANT(1754K) LET BPA1 BE CONSTANT(1742K) LET XPRIO BE CONSTANT(1726K) LET DSCUN BE CONSTANT(1764K) LET SYSTY BE CONSTANT(1 ) LET EQTA BE CONSTANT(1650K) IN.IT:SUBROUTINE GLOBAL P3 _ [P2 _ [T1,T_@TMP.] + 1] + 1 IF IFLG. THEN GO TO INITL !MID LOOP JUMP ! ! SAVE THE PARAMETERS ! ADD_$XEQT+1 ! SET PARAMETER ADDRESS REPEAT 5 TIMES DO[$T_$ADD;T_T+1;ADD_ADD+1] $(@.E.R.+1),$(@.R.E.+1)_[IF [T_$(P3+d1)]>4 THEN 4,ELSE T] CAM.O_401K !SET OUT PUT LU FOR ERRORS $(T1+8)_0 INITL:PKDR_@PK.DR ! ! IS THE DIRECTORY TRACK ASSIGNED TO D.RTR? ! Y_$KEYWD !SET UP TO SEARCH THE ID SEGS NEXT: D.RTR_$Y !SET CURRENT ADDRESS IF $(D.RTR+12)=D. THEN[\ !CHECK FOR D.RTR IF $(D.RTR+13)=RT THEN[\ IF($(D.RTR+14) AND 177400K)=RNULL\ THEN GO TO FOUND ]] IF $[Y_Y+1] THEN GO TO NEXT ! CHECK FOR NEXT ID SEG IF $TATLG= -1 THEN IPUT(TATLG,TMP.) MSS.(2008) ! D.RTR NOT FOUND GIVE UP GO TO EXITA !TERMINATE ! FOUND:IF $($TAT+$TATSD-1)=D.RTR\ !TRACK ASSIGNED TO D.RTR?? THEN GO TO PLIST !YES GO TO PLIST ! ! FIRST ENTRY AFTER DISC LOAD SO ASSIGN ALL TRACKS TO ME ! T_$TAT-[IF $TATLG= -1 THEN $@TMP.,ELSE $TATLG]-1 ! FOR ADD_$TAT TO T DO[IFNOT $ADD THEN\ ASSIGN IPUT(ADD,$XEQT)] !ALL UNASSIGNED TRACKS ! ALL TRACKS ASSIGNED SO IF TATLG IS -1 ! RESET IT ! IF $TATLG= -1 THEN IPUT(TATLG,TMP.) IFNOT $$XPRIO THEN CALL IPUT($XPRIO,$P2) !RESET PRIORITY ! ! READ THE DISC DIRECTORY ! D.RIO(READI) OPEN.(CAM.I,SYSTY,0.0,410K) !OPEN TO SYSTY ! ! FORM THE KEY SUM ! ! ! NOTE:RTE-IV KEY SUM=(1650B TO 1657B)+(1742B TO 1747B)+(1755B TO 1764B) ! :RTE-II & III KEY SUM= ABOVE LOCATIONS + (1750B TO 1754B) ! ! KSUM_0 FOR ADD_EQTA TO KEYWD DO[KSUM_KSUM+$ADD] FOR ADD_BPA1 TO RTCOM DO[KSUM_KSUM+$ADD] !780106 GLM FOR ADD_TATLG TO DSCUN DO[KSUM_KSUM+$ADD] !780106 GLM ! !780106 GLM ! !780106 GLM ! !780106 GLM ! THE FOLLOWING WORK IS REQUIRED TO SUPPORT !780106 GLM ! RTE-II & III. !780106 GLM ! !780106 GLM IF .OPSY # -9 THEN [\ +Z FOR ADD_RTDRA TO BGDRA DO[KSUM_KSUM+$ADD]] !781006 GLM ! MS003_[GENWD_@D.SDR+125]+2 IF IFLG. THEN GO TO INCH !IF MID OPERATION GO CHECK ! ! WAS A SYSTEM SET UP ON THIS DISC? ! IF KSUM=$GENWD THEN GO TO TATUP !INITIALIZED GO SET UP ! ! NO-FIRST ENTRY- ! SET INITIALIZATION FLAGS ETC. ! INIT0:IFLG._2 !SET UP FOR LU 2 ! ! INIT1:GO TO INI1. ! GO TO MAIN TO CONTINUE ! INCH: IF IFLG.=2 THEN[IF $TATLG+$TATSD THEN SETM3] ! ! INITIALIZED - SET UP THE DISC DIRECTORY ! D.RIO(READI) ! READ THE DISC DIRECTORY $GENWD_KSUM ! SET THE KEYSUM D.RIO(WRIT) ! WRITE IT OUT AGAIN ! ! SET UP THE TRACK ASSIGNMENT TABLE ! ! ! SET UP THE TAT USING THE DISC DIRECTORIES TO ! FIND WHICH TRACKS ARE TO BE ASSIGNED ! TATUP:DO[LU_-2;I_0]!LU2 FIRST TATU1:IF FID.(LU)THEN [IF LU= -2 THEN GO TO INIT0,ELSE GO TO EXITB] IF $SECT3 THEN SETM3 !IF LU3, SEND 003 MESSAGE ADD_[T_$( PKDR +4)]+$TAT+I !SET TAT ADDRESS REPEAT $( PKDR +7)-T TIMES DO \SET TAT TATPU(77776K) !FMP TRACKS REPEAT -$( PKDR +8) TIMES DO \SET TAT TATPU( D.RTR) !DIRECTORY TRACKS ! IF LU= -2 THEN [LU_-3;I_$TATSD;GOTO TATU1] ! ! TAT IS SET UP - RELEASE ALL UNUSED TRACKS ! EXITB:CALL EXEC(5,-1) CALL EXEC(100027K,GASP,-1) GO TO GOGO GOGO: .DFER($P3,X16) !SET UP PRAMS FOR AUTO ON .DFER(TMP.,WELCM) !AND LET IT FALL THROUGH IFLG._0 !IFLG. HAS DONE ITS JOB ! ! PLIST: IFNOT TMP. THEN TMP. _ 1 !DEFAULT INPUT DEVICE. IF TMP. < 0 THEN [ \CHECK IF SCHEDULED TMP._6; \FROM BEM. CAM.O _ SYSTY; GO TO GT.JB] G01._@G0..+1 IF TMP. > 20000K THEN [ \FILE NAME GIVEN. IFNOT $P2 THEN<:6 $P2 _ " "; \REPLACE 0'S W/BLANKS. IFNOT $P3 THEN $P3 _ " "; \REPLACE 0'S W/BLANKS. CAM.O _ SYSTY; TTY. _ 0; \ G0.._3;.DFER($G01.,TMP.); \SET GLOBAL 0G T _ $(T1+4); GOTO PLIS1] G0.._1;$G01._TMP. !SET UP 0G IFNOT [CAM.O _ $P2 ] THEN \ CAM.O _ [IF [TTY. _ .TTY(TMP.)] \ THEN TMP., ELSE SYSTY] T _ $P3 PLIS1: .DFER(I.BUF,TMP.) !SAVE INPUT DEVICE. TMP. _ T IFNOT TMP. THEN TMP. _ 6 OPEN.(CAM.I,I.BUF,0.0,401K) !OPEN INPUT DEVICE. ! CALL EXEC(14,1,C.BUF,40) !IF FILE CHECK FOR PASSED ECH._.B. !STRING IF ECH. THEN [ \IF A STRING AND IF (C.BUF AND 177400K)=35000K THEN[ \IT STARTS WITH A ':' C.BUF_C.BUF+[NO.RD_-15000K]]] !CLEAR THE ':' FOR GO TO FM.AB ! EXITA: CALL EXEC(5,-1) !ERROR EXIT COULD NOT INITIALIZE CALL EXEC(6) !JUST DIE QUICKLY. ! END ! TATPU:SUBROUTINE(ID) IF $ADD#ID THEN[IF $ADD#$XEQT THEN MSS.(1005,ADD-$TAT)\ , ELSE IPUT(ADD,ID)] ADD_ADD+1 !SEND ERROR MESSAGE RETURN END ! SETM3:SUBROUTINE D.RIO(READI) !READ DISC DIRECTORY IFNOT $MS003<0 THEN [ \IF 003 MSG NEVER GIVEN $MS003_$MS003 OR 100000K; \SET MSG 003 FLAG IFLG._3; \SET UP FOR LU 3 D.RIO(WRIT); \WRITE DISC DIRECTORY GO TO INIT1] !SEND MESSAGE RETURN END END END$ <SPL,L,O ! NAME: IN.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 IN..(8) "92002-16008 REV.2001 791018" ! ! 771229 (GLM) -CHANGE TO CORRECTLY INITIALIZE LU3 THE FIRST TIME ! 780413 (GLM) -CHANGE TO CORRECTLY RELEASE LOCK ON ABORT OF INIT. ! 781103 (GLM) -CHANGE TO CORRECTLY HANDLE "??" RESPONSE. ! 791017 (GLM) -CHANGE TO CHECK FOR TYPE 6 FILES IF PURGE OPERATION. ! ! ! ! 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 WHEN LU2 IS FIRST ! INITIALIZED AND MUST MATCH THEREAFTER. ! LET DR.RD,D.RIO,MSS.,NAM..,READC,EXEC \ ,READF,WRITF,FM.ER\ ,J.PUT,IPUT,.PARS\ BE SUBROUTINE,EXTERNAL LET PK.DR,D.SDR,IFLG.,D.LT,D.LB,C.BUF, \ DS.DF, \ D.,DS.LU,.E.R.,ECH. BE INTEGER,EXTERNAL LET CAM.O,NO.RD,.E.R. BE INTEGER,EXTERNAL LET PDIRS,TRAK. BE SUBROUTINE LET PTST,GT BE SUBROUTINE LET BADTR BE SUBROUTINE LET LOCK. BE SUBROUTINE,EXTERNAL LET FID. BE FUNCTION,EXTERNAL LET MSC. BE FUNCTION,EXTERNAL ! ! ARRAY LET PNAM(3) BE INTEGER ! CONSTANTS LET N9 BE INTEGER INITIALIZE N9 TO -9 ! LET YE BE CONSTANT(54505K) LET KEYWD BE CONSTANT(1657K) 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 SECT2 BE CONSTANT(1757K ) LET SECT3 BE CONSTANT(1760K ) LET TAT BE CONSTANT(1656K ) LET TATLG BE CONSTANT(1755K ) LET TATSD BE CONSTANT(1756K ) 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#1 THEN GOTO IN2 IF IFLG. THEN GOTO NOPRM ! MSC CHANGE? ! IFNOT MSC.(PLIST) THEN GOTO SCER ! IF $(@PLIST+2)#DMSIN THEN GOTO NOPRM ! $(DDIR+126)_[IF([T_$(@PLIST+3)]AND 77400K)=20000K THEN 0,ELSE T] D.RIO(WRIT) !WRITE IT OUT RETURN !RETURN ! LABER:DO[MSNO_53;RETURN] ! NOPRM:DO[MSNO_50;RETURN] !NOT ENOUGH PRAMS - EXIT ! v IN2: IFNOT IFLG. THEN GOTO IN5!NOT INITIALIZING -JMP IF IFLG.=2 THEN[\ IF PLIST THEN[IF PLIST#3 THEN GOTO SCER] ;\ $(DDIR+126)_$[DS.DF_@PLIST+1]]!SET THE MASTER SECURITY CODE ! ! IF IFLG.# -$(LIST5 )THEN[MSNO_52;RETURN] IF IFLG.=3 THEN[IFNOT$LIST9 THEN RETURN] !NO LU 3 RETURN IN5: 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 NAM..($(LIS13 )) 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 IFNOT IFLG. THEN GOTO IN7 !IF NOT INIT SKIP IF IFLG.=2 THEN [FOR T_2 TO 124 DO $(DDIR+T)_0;\ $DDIR_2],ELSE $(DDIR+4)_3 !SET LU IN DISC DIRECTORY LTR_[IF IFLG.=2 THEN [$(DDIR+1)_$TATSD-1],\ ELSE[$(DDIR+5)_ -$TATSD -$TATLG-1]] ! IN7: DR.RD(READI,$LIST5 ,0)?[MSNO_54;RETURN] ! DO[EXEC(13,$$@DS.LU,T,T1);T1_T1 AND 77K\GET UNIT SELECT CODE ;EXEC(13,2,T,T2);T3_0;IF $TATLG+$TATSD THEN EXEC(13,3,T,T3)]! ! T_@PLIST+25 !SET NO OF SECTORS ADDRESS IF T1=(T2 AND 77K) THEN \ $T_$SECT2,ELSE[IF T1=(T3 AND 77K ) THEN \ $T_$SECT3] !IF WE DID NOT GET A SECT/TRACK BY NOW IFNOT $T THEN GOTO MSPRM ! THEN ERROR 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 IF $$@DS.LU=2 THEN[IF FTR<($1761K>-7)+8 THEN GO TO BADPM] ! MUST ! LEAVE SOME TRACKS FOR THE SYSTEM ! ! CHECK THE BAD TRACKS AND ARRANGE IN ASCENDING ORDER ! LIS49_[T1_LIS29]+20 FOR T_LIS29 TO LIS49 BY TY4 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 IFLG.=2 THEN GOTO IN20 ! IF $LIST9=$DLB THEN GO TO IN12!IS SAME LABEL SKIP DR.RD(READI,$LIST9,0)?[DR.RD(READI,$LIST5,0);GO TO IN12] MSNO_12 !DUPLICATE LABEL ERROR ! ! (GLM) -FIX FOR INITIALIZE LU3 PROBLEM ! ! IF INIT ON 3 WE MUST CLEAR THE LU3 FLAG (SET BY IN.IT) ! SO WE WILL MAINTAIN THE FMGR 003 ERROR UNTIL A GOOD IN CMND ! COMES IN. ! IF IFLG.=3 THEN[D.RIO(READI) ;TZ_@D.SDR+127;\ CLEAR THE LU3 $TZ_ ($TZ AND 77777K);D.RIO(WRIT)]! PROMPT FLAG ! RETURN IN12: IF IFLG.=3 THEN GOTO IN20 ! FILES NOT SAVED ON LU3 IF [TX,NEW_FID. ($(LIST5 ))] THEN[ \ IFNOT IFLG. THEN[ \IF NOT FIRST CALL IF $(DLB+1)# $XEQT THEN[ \IF NOT LOCKED AND NOT LOCK ABLE MSNO_61;RETURN \RETURN ERROR (DISMOUNTED WITH ] \OUT TELLING US) NO-NO ]; \ GO TO IN20 \ELSE WE ARE OK ] ! LOCK.($LIST5,3)?[RETURN] ! REQUEST LOCK/ RETURN IF ERROR ! A DIRECTORY EXISTS - IS THE NEW PRAM SET ! COMPATIBLE? ENDBL_ -$PDIR8*$PDIR6/2+[IF T3 =2 THEN -1 ,ELSE 0] ! 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. ! IN20: IF T3 =2 THEN GT($TAT) !IF LU TWO OR THREE IF T3=3 THEN GT($TAT+$TATSD)!GO SET THE TAT ! FULL SPEED AHEAD! $PDIR_$(LIS13 )+100000K $(PDIR1 )_$(@PLIST+14) $(PDIR2 )_$(@PLIST+15) $(PDIR3 )_$LIST9 $(PDIR4 )_FTR IF NEW THEN [$(PDIR5 )_0;$(PDIR9 )_FTR] $(PDIR6 )_$(@PLIST+25) $(PDIR7 )_LTR-ND+1 $(PDIR8 )_-ND FOR T_10 TO 15 DO $(PDIR+T)_$(@PLIST+T+19) IF NEW THEN[FOR T_16 TO 127 DO $(PDIR+T)_0] BL_0 ! ! NOW WRITE IT OUT IN22: DR.RD(WRIT,$LIST5 ,BL)?[GO TO IN25] ! 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 ! IN25: $DLB_$LIST9 !SET THE DIRECTORY LABEL WORD IN30: D.RIO(WRIT);IFNOT IFLG. THEN LOCK.($LIST5,5) !RELEASE LOCK*780413* EXEC(5,-1) !RETURN ANY LEFT OVER TRACKS RETURN !WE DID IT - EXIT ! IN15: IF T3 < 4 THEN \ IF LU IS 2 OR 3 (791017) [TRAK.(T3)?[GOTO IN30]] ! CHECK FOR TYPE 6 FILES MSS.(60);EXEC(2,CAM.O,35137K,1) ;\ SEND COLON PROMPT EXEC(1,CAM.O OR 400K,C.BUF,36);ECH._$1 !*781103* IF ECH.<1 THEN GOTO IN15 IF C.BUF=YE THEN[NEW_1; GO TO IN20], ELSE [ \ IF C.BUF=NO THEN [IF IFLG. THEN GOTO MSPRM,\ ELSE GOTO IN30],ELSE[IF C.BUF="??" THEN[\ NO.RD_-1;LOCK.($LIST5,5);\ *781103* RETURN],ELSE\ *781103* GO TO 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 ! TRAK.:SUBROUTINE(LOGUN) FEXIT ! 791017ީ (2001) ! TRAK. CHECKS FOR ID SEGMENTS THAT REFERENCE FMP TRACKS. ! IF ANY ARE FOUND, THE PROGRAM NAME IS PRINTED AND FEXIT IS TAKEN. ! LU3_LOGUN AND 1 !SET LU 3 FLAG NFLG_0 !FOUND FLAG NTR_($PDIR4 -< 7) !NEXT TRACK KPTR_$KEYWD !POINTER TO KEYWORD BLOCK NEXT: DMAN_[NAM3_[NAM2_[NAM1_$KPTR+12]+1]+1]+12 !PTRS TO ID SEGMENT IF $NAM3 AND 20K THEN DMAN_NAM3+5 !ADJUST FOR SHORT ID SEGS IF [K2_$NAM3 AND 7]=1 THEN GOTO OK !NO CHECK NEEDED FOR TYPE 1 ASSEMBLE["EXT $OPSY"; \ONLY CHECK TYPE 4 IN RTE 4 "LDA $OPSY"; \ "CPA N9" ; \ "JMP NEX2"] ! IF K2=4 THEN GOTO OK NEX2: IF (($DMAN -< 1) AND 1)#LU3 THEN GOTO OK ! COMPARE DISC LU IF ($DMAN AND 77600K) < NTR THEN GOTO OK ! IFNOT NFLG THEN MSS.(11) !SEND FMGR 011 IF FIRST TIME NFLG_1 $@PNAM_$NAM1 !1ST WORD OF NAME $([PN_@PNAM+1]+1)_($NAM3 AND 77400K)+40K !3RD WD OF NAME, PADDED $PN_$NAM2 !2ND WORD OF NAME FM.ER(2,PNAM,3) !WRITE PROG NAME OK: KPTR_KPTR+1 !BUMP KEYWD POINTER IF $KPTR THEN GOTO NEXT !CONTINUE IF NOT END IF NFLG THEN FRETURN !FEXIT IF ANY FOUND RETURN END ! ! GT: SUBROUTINE(TRLOC) ! SUBROUTINE TO CHECK ON TRACK ASSIGNMENTS FOR ! CHANGES TO THE SYSTEM OR AUX DISC FILE AREAS ! IF IFLG. THEN RETURN ! IF INIT THE LET MAIN DO IT IF TX THEN GO TO TRASN ! NEW SO GO GET ALL THE TRACKS IF FTR<[T_$(PDIR4 )] THEN GO TO TRASN ! IF LARGER AREA GET TR ! ! RETURN THE LEFT OVER TRACKS FOR ADD_T TO FTR-1 DO[T1_ADD+TRLOC;\ IF $T1=77776K THEN IPUT(T1,$XEQT)] EXEC(5,-1) !RETURN THE TRACKS : RETURN !AND RETURN ! TRASN:T1_FTR+TRLOC !SET UP FIRST AND LAST ADDRESSES T2_[IF TX THEN LTR,ELSE T-1]+TRLOC FOR ADD_T2 TO T1 BY -1 DO[J.PUT(ADD,$XEQT,JER);\ IF JER THEN BADTR] ! FOR ADD_T1 TO T2 DO[IF $ADD=$XEQT THEN IPUT(ADD,77776K)] RETURN END BADTR:SUBROUTINE T_ADD-TRLOC !CHECK IF UNAVAILABLE TRACK IS ALSO BAD FOR X_LIS29 TO LIS49 BY 4 DO[IF $X=T THEN RETURN] MSS.(1059,T) !NOT FOUND SO BAD TRACK ERROR OR TRACK NOT AVAILABLE GO TO IN30 !GO EXIT END END END$ SPL,L,O ! NAME: MC.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 MC.. (8) "92002-16008 REV.2001 791025" ! MOUNT CARTRIDGE DIRECTIVE ! ROUTINE FOR RTE FILE ! MANAGER (FMGR). ! ! MODIFIED 781103 TO CHECK FOR LAST TRACK > 1024 **GLM ! 790502 VERIFY THAT LU PASSED IS NUMERIC *GLM ! 790727 VERIFY THAT LU IS < 64 *GLM ! ! ! 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 SETAD BE SUBROUTINE ! LET D.SDR,DS.F1,PK.DR \ BE INTEGER,EXTERNAL ! LET FID. BE FUNCTION,EXTERNAL ! ! DECLARE CONSTANTS ! LET XEQT BE CONSTANT(1717K) LET TATSD BE CONSTANT(1756K) LET TATLG BE CONSTANT(1755K) LET B BE CONSTANT( 1) LET READI BE CONSTANT( 1) LET WRIT BE CONSTANT( 2) ! LU_$(@LIS+1) !BRING IN THE LTR_$(@LIS+5) !PRAMS DS.F1_0 !INSURE A CLEAN READ IF LU>0 THEN LU_-LU IF LU < -63 THEN [ER_56;RETURN] NLU_-LU DR.RD(READI,LU,0)?[GO TO OK] ! MC00: ER_12 !SEND DUPLICATE LU RETURN !ERROR ! OK: DSDR_@D.SDR FOR DLU_DSDR TO DSDR+120 BY 4 DO[\ IFNOT $DLU THEN GO TO MC01] ER_62 !MORE THAN 31 DISCS? RETURN !RETURN ! MC01: MXTR_0 IF NLU=2 THEN MXTR,LTR_$TATSD-1 IF NLU=3 THEN MXTR,LTR_-$TATSD-$TATLG-1 EXEC(100015K,NLU,EQT5) GO TO MC03 IF(EQT5 AND 36000K)#14000K THEN[\ MC03: ER_52; RETURN] !NO DISC-ERR. IF MXTR THEN GOTO MC02 IF (EQT5 AND 37400K)#\ 14000K THEN[EXEC(2,NLU+74000K,1,1,10000,0);\ MXTR_$B-1],ELSE GOTO MC02 IFNOT LTR THEN LTR_MXTR IF LTR>MXTR THEN[ER_56;RETURN] ! MC02: IFNOT LTR THEN[ER_55;RETURN] IF LTR > 1024 THEN [ER_56;RETURN] !*781103* ! $DLU_NLU DLU_[T_DLU+1]+1 $T_LTR IFNOT [NEW_FID.(LU)] THEN[\ LB_$(@PK.DR+3); \ DR.RD(READI,LB,0)?[GOTO MC05];\ GO TO MC00] ! MC05: $DLU_LB !SET LABEL MC04: IF NEW THEN [$(DLU+1)_$XEQT;\SET LOCK IF NEW MC06: D.RIO(WRIT);RETURN] !WRITE NEW DISC DIR. ! NEW,BUF_@PK.DR BLK_0 ! CHECK:DR.RD(READI,LU,BLK)?[GOTO MC06] !READ DIRECTORY UNTIL END BLK_BLK+1 OFF_0 ! NXT: SETAD ? [GOTO CHECK] IFNOT $FLE THEN GOTO MC06 !IF END OF DIRECTORY, EXIT IFNOT $TYPE THEN GOTO NXT !IF TYPE ZERO, TRY NEXT FILE IF $SIZE < 0 THEN [ \IF EXTENDED FILE, ER_-1 03;RETURN ] ! GIVE ERROR AND EXIT GO TO NXT !CHECK NEXT FILE ! END ! ! ! SETAD:SUBROUTINE FEXIT ! SIZE_[TYPE_[FLE_BUF+OFF]+3]+3 IF[OFF_OFF+16] > 144 THEN FRETURN RETURN END END END$ SPL,L,O ! NAME: RC.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 741118 ! ! *************************************************************** ! * (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 RC..(8) ! 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, FM.ER,\ LOCK., CONV. BE SUBROUTINE, EXTERNAL LET MC.. BE SUBROUTINE,EXTERNAL ! LET FID. BE FUNCTION, EXTERNAL ! LET D.LT, DS.LU, D.SDR,DS.DF 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 CONV. ($$@D.LT,MS,4) !SET LAST TRACK IN MESSAGE DS.DF,$DIS_ - $$@DS.LU !SET LU FOR MOUNT CALL FOR I_DS.LU TO @D.SDR+120 DO[\ $I_$[T_I+4]; $T_0] ! REMOVE FROM DIRECTORY IF $DIS = -2 THEN GO TO MOUNT IF $DIS = -3 THEN GO TO MOUNT !IF SYS OR AUX THEN GO REMOUNT D.RIO(WRIT) ! RE WRITE THE DIRECTORY OF DISCS. FM.ER (0, MSS,8) ! SEND LAST TRACK TO LOG RETURN MOUNT:MC..(N,LIS,ER) RETURN END END END$ SPL,L,O ! NAME: LI.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 LI..(8) "92002-16008 REV.2001 791022" ! ! 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 ! WPITH BLANKS ! ! D FORMAT IS THE HEAD ONLY ! ! ! ! DEFINE EXTERNALS ! LET .TTY BE FUNCTION,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! LET O.BUF,I.BUF,BUF.,.E.R.,\ TMP.,N.OPL BE INTEGER,EXTERNAL LET FSTAT,OPEN.,LOCF,WRITF,READF,EXEC,\ CONV.,JER. \ 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 LR_$([FR_[TYPF_[LIS1_@LIS +1]+4]+4]+4)!SET ADDRESSES TYPF_($TYPF AND 177400K)+40K !GET AND ISOLATE THE TYPE IF [FR_$FR] THEN[ \SET FIRST LAST RECORD IFNOT LR THEN LR_ FR] !DEFAULTS (1 IF ONLY FIRST) IF FR < 0 THEN [ER_56;RETURN]  !BAD PARAMETER ? 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.(O.BUF,TMP.,$OPLS, 0) !OPEN LIST FILE ! CALL OPEN.(I.BUF,$LIS1,N.OPL,OPFL) !OPEN FILE TO BE LISTED ! CALL LOCF(I.BUF,.E.R.,LP,LP,LP,NSEC,FLU,FTYP,RECS) ! ! IFNOT NUL THEN GO TO OK !IF NULL THEN CHOSE THE 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(O.BUF,.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); \IF DISC FILE FINE CR # SETA(R.BL);\ CALL FSTAT(LNNO); \MUST BE FOUND T_@LNNO; \SO NO STOP NEEDED UNTIL $T = FLU DO T_T+4; \FIND THE LU T_$( T+2);N_5], \SET IT UP ELSE[ \ SETA(BL.L); \SET UP A DIRECT LU 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 FTYP,$(@I.BUF+2)_1 !FOURCE TYPE 6 TO ONE RC_1 !DEFINE STARTING RECORD IF FR > 1 THEN [ \IF SKIP IS REQUESTED AND (791022) IF FTYP THEN [ \IF FILE IS TYPE IF FTYP < 3 THEN RC_FR]] !1 OR 2, SET FIRST RECORD 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 CALL READF(I.BUF,.E.R.,LBF,128,L,RC) ! READ RECORD IF .E.R.= -12 THEN [ \IF EOF AFTER IF RC > FR THEN GOTO EOF ] !FIRST RECORD - GO EXIT JER. !CHECK FOR ERRORS IF L <0 THEN [ \SOFT EOF? IF RC > FR THEN GO TO EOF, \YES ELSE [ER_-12;RETURN]] !NO, EOF BEFORE FIRST REQ. RECORD IF RC< FR THEN GOTO NEXTR !TYPE ZERO & > 2 POSITIONING 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 [ \IF NO DATA GET NEXT NEXTR: RC_RC+1; \STEP RECORD COUNT IF LR THEN[ \END OF REQUESTED DATA IF RC > LR THEN GO TO EOF]; \YES GO DO EOF GO TO NEXT] !ELSE DO NEXT RECORD 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(O.BUF,.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 O.BUF 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(O.BUF,.E.R.,$(TB-LP),N+LP) JER. RETURN END ! ! SPACE:SUBROUTINE DIRECT =ZXT !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$ ^bZSPL,L,O ! NAME: DL.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 DL..(8) "92002-16008 REV.2001 791018" ! ! 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 NUMBER ! ! ! DEFINE EXTERNALS ! LET PK.DR,D.SDR,TMP.,O.BUF,.E.R.,\ BUF.,N.OPL 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 F.TST,MSC.,.TTY BE FUNCTION,EXTERNAL ! LET F.SET,DR.RD,LOCF,WRITF,OPEN.,CONV.,D.RIO,CK.ID\ 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 TYPE,EXEND,FFLAG_0 DL_ @LIS+1 !SET DISC SPEC IF LIS=3 THEN[ \IF MASK OPTION FFLAG_1; \SET UP THE MASKS CALL F.SET($DL); \AND THE NEW DL_$(@N.OPL+1)], \CR REF. ELSE \OTHER WISE USE AS DL_$DL !A CR 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 !791018 (2001) IFNOT TYPE THEN \IF FIRST TIME OR IF s OPEN.(O.BUF,TMP.,$T,0) !TYPE ZERO, OPEN LIST FILE LOCF(O.BUF,.E.R.,T,T,T,T,T2,TYPE) !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 $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 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 IF FFLAG THEN[ \IF MASK OPTION IFNOT F.TST(PK) THEN GO TO NXFIL] !REJECT IF NOT IN SET. 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_MImN.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 [VALID_1; \ P_$PK8 AND 77777K; \ CK.ID(P)?[VALID_0];\ IF VALID THEN [P_P+12;FOR T_P TO P+2\ DO[ $T2_$T ;T2_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(O.BUF,.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 O.BUF !IF NOT A TTY TWO BLANKS ARE WRITF(O.BUF,.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$ ASMB,R,L,C * NAME: F.SET * SOURCE: 92002-18008 * RELOC: 92002-16008 * PGMR: G.A.A. * * *************************B************************************** * * (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 F.SET,8 92002-16006 760719 EXT .ENTR EXT N.OPL ENT F.SET FILTER SET UP ENTRY ENT F.TST FILTER TEST ENTRY * * FILTER FOR DL COMMAND * * THIS ROUTINE SET UP THE FILTER MASKS AND TESTS NAMES AGAINST THEM * NAME NOP F.SET NOP ONE PARAMETER THE FILE NAME JSB .ENTR GET PRAM DEF NAME JSB NAMF GET MASK AND TEST FOR FIRST WORD STA CPA1 SET THE VALUES STB MSK1 FOR LATER JSB NAMF GET SAME FOR WORD 2 STA CPA2 AND SAVE STB MSK2 JSB NAMF SAME FOR NAME 3 STA CPA3 STB MSK3 LDA DN.OP GET ADDRESS OF SUB PRAMS RAL,CLE,SLA,ERA CLEAR INDIRECT LDA A,I GET ADDRESS STA NAME SET ADDRESS JSB SUTY GET MASK FOR SC STA CPASC SAVE SC VALUE ONE CMA,SSA,INA SET MASK 2 CMA,INA USE SAME IF POSITIVE CODE PROVIDED STA CPASM STB MSKSC ISZ NAME STEP TO JSB SUTY GET MASK FOR TYPE STB MSKTY STA CPATY JSB SUTY STB MSKSZ ADA A DOUBLE SIZE TO GET SECTORS STA CPASZ JSB SUTY NOW GET RECORD LENGTH STB MSKRL STA CPARL SET VALUES JMP F.SET,I RETURN ALL MASKS SET UP * NAMF NOP NAME DON'T CARE SET UP LDA NAME,I GET VALUE AND C377 ISOLATE THE HIGH CHAR CPA "HM" IS "-"? CLB,RSS YES SET MASK LDB C377 NO, SET KEEP MASK XOR NAME,I GET OTHER CHAR. CPA "LM" IS "-"? RSS YES LEAVE ZERO MASK ADB B377 NO SET THE LOW BITS LDA NAME,I GET THE VALUE AND B MASK IT ISZ NAME STEP FOR NEXT TIME JMP NAMF,I RETURN A=VALUE, B= MASK * SUTY NOP TYPE MASK SET ROUTINE LDA NAME,I GET CURRENT PRAM SZA,RSS SET MASK BASED ON IF SUPPLIED CLB,RSS CCB B IS MASK ,A IS VALUE ISZ NAME STEP TO NEXT ENTRY JMP SUTY,I RETURN * B377 OCT 377 C377 OCT 177400 CPA1 NOP CPA2 NOP CPA3 NOP CPASC NOP CPASM NOP CPATY NOP CPASZ NOP CPARL NOP * MSK1 NOP MSK2 NOP MSK3 NOP MSKSC NOP MSKTY NOP MSKSZ NOP MSKRL NOP "HM" OCT 26400 "LM" OCT 55 DN.OP DEF N.OPL * * DADD NOP F.TST NOP MASK TEST ROUTINE PRAM IS ADDRESS OF DIRECTORY ENTRY JSB .ENTR DEF DADD LDB DADD,I GET THE ADDRESS LDA B,I GET NAME1 AND MSK1 KEEP UN MASKED CHAR CPA CPA1 IF OK CONTINUE INB,RSS ELSE JMP NO TAKE NO EXIT * LDA B,I NAME 2 AND MSK2 CPA CPA2 INB,RSS JMP NO * LDA B,I AND MSK3 CPA CPA3 INB,RSS JMP NO * LDA B,I AND MSKTY TYPE TEST CPA CPATY INB,RSS JMP NO * INB INB STEP OVER DISC ADDRESS LDA B,I GET SIZE AND MSKSZ CPA CPASZ INB,RSS JMP NO * LDA B,I AND MSKRL CPA CPARL INB,RSS RECORD LENGTH OK? JMP NO * LDA B,I SECURITY CODE AND MSKSC CPA CPASC TWO CHANCES HERE RSS CPA CPASM OK? CCA,RSS YES NO CLA NO MATCH EXIT JMP F.TST,I RETURN * A EQU 0 B EQU 1 END SPL,L,O ! NAME: PU.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 740801 0 ! ! *************************************************************** ! * (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 PU..(8) ! ! 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.,I.BUF,N.OPL,PK.DR BE INTEGER,EXTERNAL ! LET IER.,DR.RD,LOCK.,PURGE BE SUBROUTINE,EXTERNAL ! ! LET TATSD BE CONSTANT (1756K) LET SECT2 BE CONSTANT (1757K) 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] ! PURGE(I.BUF,.E.R.,$BLK,N.OPL,$T) ! IF .E.R.= -6 THEN .E.R._ -2006 !SET UNDEFINED MESSAGE ! IF .E.R. = -16 THEN GO TO ZPURG ! IER. RETURN ! ZPURG:X_$[T_@I.BUF+1] AND 377K !SET X TO THE SECTOR ADDRESS TI,BLK_0 !START WITH BLK ZERO TEST: IF TI=X THEN GO TO FOUND !IF MATCH THEN STOP SEARCH BLK_BLK+1 !STEP THE BLOCK ADDRESS TI_(TI+14)/$SECT2 !COMPUTE THE NEXT LOGICAL TI_$1 !BLOCK ADDRESS IN TI GO TO TEST !GO SEE IF THIS IS IT ! FOUND:BLK_BLK+(-(I.BUF/64)+$TATSD-1)*$SECT2-1 ! LOC_$T/400K+@PK.DR !COMPUTE ADDRESS IN BUFFER LOCK.(-2,3)?[RETURN] !LOCK DISC DR.RD(READI,-2,BLK) !READ THE BLOCK IF[T_$(LOC+8)]THEN[IF T-N.OPL THEN [ER_-7;GO TO EXIT]] !CHECK !SECURITY $LOC _ -1 !PURGE THE FILE DR.RD(WRIT,-2,BLK) !WRITE THE BLOCK EXIT: LOCK.(-2,5) !UNLOCK RETURN !RETURN END END END$ SPL,L,O ! NAME: DP.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 DP..(8) "92002-16008 760511" ! ! LET INPRS, \INVERSE PARSE ROUTINE EXEC, \SYSTEM OPEN, \FMGR OPEN READF \FMGR READ BE SUBROUTINE,EXTERNAL ! ! ! LET C.BUF, \INPUT BUFFER ECH., \ITS LENGTH CAM.O \LOG LU BE INTEGER,EXTERNAL ! ! ! DP..: SUBROUTINE GLOBAL B377_377K;UBLK_20000K !SET BLANK AND MASK ASSEMBLE["CCB"; \REPLACE THE FIRST DELIM "EXT C.DLM";\ "ADB C.DLM";\ "CLE,ERB";\ "LDA 1,I";\ "AND B377";\ "IOR UBLK";\ "STA 1,I";\ "SEZ";\ "INB"] ADD_.B. CALL EXEC(2,CAM.O,$ADD,@C.BUF-ADD+ECH.) RETURN END END END$ SPL,L,O ! NAME: RU.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 RU..(8) "92002-16008 781130 REV.1901" ! ! ! MODIFIED 781103 TO CLOSE TYPE 6 FILE AFTER IDRPL CALL **GLM ! LET BUMP., \UPDATES JOB TIME SET.T, \RESETS JOB TIMER MSS., \PRINTS ERROR MESSAGE EXEC, \SYSTEM CALLS RMPAR, \RETRIEVE PARAMETERS FM.ER, \SEND MESS. TO LOG IDRPL, \10-2:RP,XX PROCESSOR IDRPD, \10-2:RP,,XX PROCESSOR READF, \10-2FMGR READ RECORD IER., \CHECK FMGR ERROR OPEN.,CLOS., \INTERNAL OPEN\CLOSE ROUTINE .RENM, \10-2 RENAMING MOD. IN SES MODE SESSN, \10-2 TEST IF IN SESSION MODE .EXCP, \10-2 TEST IF PROG CAN BE RENAMED WRITF \FMGR WRITE RECORD BE SUBROUTINE,EXTERNAL ! LET .DFER \3-WORD TRANSFER BE SUBROUTINE,EXTERNAL,DIRECT ! !10-2 LET IFBRK BE FUNCTION,EXTERNAL !CHECK BREAK FLAG. LET TL. BE FUNCTION,EXTERNAL,DIRECT !CHECK RUN TIME LIMIT. ! LET .E.R., \FMGR ERROR LOC. O.BUF, \DOB BUFFER TL.P,  \RUN TIME LIMIT VALUES CAD., \COMMAND ADD. IN TABLE ACTV., \JOB ACTIVE FLAG NO.RD, \COMMAND READ FLAG G0.., \GLOBAL TABLE ADDRESS BUF., \BUFFER USED BY RP C.BUF, \TRANSLATED "RU" COMMAND ECH., \LENGTH OF COMMAND TMP., \ID SEG TEMP. STORAGE SCR., \SECOND 2 COMMAND CHARS. I.BUF, \10-2 DCB FOR :RP,XXXX N.OPL \10-2 SC & CRN FOR OPEN BE INTEGER,EXTERNAL ! LET SREQ BE CONSTANT (100027K) LET XTEMP BE CONSTANT(1721K) ! LET PTR,PTR1,PTR2,PTR3,PTR4,PTR5,PTR6 BE INTEGER !10-2 LET PAR(4),PAR5,PARM1,PARM(7) BE INTEGER LET SAVE BE INTEGER LET ABEND(4),ABX(7) BE INTEGER LET TIME(4) BE INTEGER LET JOB BE REAL LET LM(3) BE INTEGER LET NNAM(3) BE INTEGER !10-2-76 (DLB) LET RN,BAT BE REAL LET DUM,DUX BE INTEGER LET T1,T2 BE INTEGER ! !10-2 INITIALIZE PAR,PAR5,PARM1,PARM \ !10-2 TO 4(0),3,8(0) INITIALIZE ABEND,ABX TO " ABEND XXXXX ABORTED " INITIALIZE TIME,JOB,LM TO " ABEND JOB LIMIT " INITIALIZE RN TO "RUN " ! ! ! ! ! ! RU..: SUBROUTINE(NUM,PRAMS,ERR) GLOBAL LET NUM,PRAMS,ERR BE INTEGER CRCNT,PFL,RPSW _ 0; DM_@BAT !SET DUMMY TIME LOCATION IFNOT NUM THEN [ERR_50; RETURN] !ARE THERE ENOUGH PARAMS? IF PRAMS = 3 THEN GOTO GETN !CHECK NAME PARAMETER. ! ERR _ 56; RETURN !BAD PARAMETER. GETN: PTR6 _ [PTR5 _ [PTR4 _ [PTR3 _ \ [PTS2,PTR2 _ [PTR2F _ [PTR1 _ \  @PRAMS+1] + 3] + 1] + 4] + 4] \ + 4] + 4 ! ! IF FIRST PRAM NOT SUPPLIED AND 0G IS NUMERIC USE IT INSTEAD ! IFNOT $PTR2F THEN [ \ IF G0.. = 1 THEN PTS2 _ @G0..+1] !10-2 CALL .DFER(PARM1,$PTR1) !SET NAME IN RP.. CALL CALL .DFER(NNAM,$PTR1) !10-2 SET NAME FOR DUP CALL ! CRCNT_ECH. !SET COMMAND LENGTH ! 10-2 CALL SESSN($(@G0..+1))?[GOTO TSET] !10-2 TEST IF IN SESSION MODE CALL .EXCP(NNAM)?[GOTO TSET] !10-2 TEST IF CAN BE RENAMED? CALL .RENM(NNAM,.E.R.,RPSW) !10-2 RENAM MODULE IF POSSIBLE IF .E.R. THEN ERR _ .E.R. !10-2 IF ERROR BRING FORWARD IF ERR THEN RETURN !10-2 CHECK IF ANY ERRORS ! TSET: IF ACTV. THEN[IFNOT TL.() THEN [ \IF IN ACTIVE JOB, CALL SET.T(TL.P,BAT); \SET RUN TIME LIMIT, PFL _ 1; DM _ @DUM]] !IF NECESSARY. TRNON: CALL SET.T(T1,T1) IF SCR. = "IH" THEN CRCNT_0 !IF "IH" PASS ZERO LENGTH $1 _ -1 !MUST PASS THE CALL EXEC(SREQ,NNAM,$PTS2,$PTR3, \10-2 WHOLE COMMAND $PTR4,$PTR5,$PTR6, \BUFFER TO EXEC. C.BUF,CRCNT) ! GOTO REPLC !ERROR EXIT. ! CHKB: IF [SAVE _ $1] = -1 THEN \ GOTO ABCHK ! CALL RMPAR($(@G0..+41)) ABCHK: IF PFL THEN CALL BUMP.(BAT,TL.P) !UPDATE JOB TIME CALL SET.T(BAT,$DM) !RESET THE RUN TIME LIMIT .E.R._0 IF $$XTEMP # 100000K THEN GO TO EX !FIND OUT IF PROGRAM DIED ! CALL .DFER(ABX,NNAM) !10-2SET UP THE ABORT MESSAGE CALL FM.ER(2,ABEND,11) !SEND IT TO THE LOG. IFNOT ACTV. THEN GO TO EX !IF NOT IN JOB GO EXIT ! CALL OPEN.(O.BUF,TMP.,$(@TMP.+3),0) !OPEN THE LIST FILE IF j$(DM+1)> -1 THEN [ \IF TIME OUT ABORT IF T2 < 0 THEN [ \ IF PFL THEN JOB _ RN; \IF RN LIMIT USE RN WRITF(O.BUF,.E.R.,TIME,9); \SEND THE MESSAGE TO LP NO.RD,CAD._6; \TIME OUT ALWAYS ABORTS IER.]] !CHECK FOR ERRORS CALL WRITF(O.BUF,.E.R.,ABEND,11) !SEND THE ABEND MESSAGE IF .E.R.= -17 THEN .E.R._0 !SET OVERFLOW ERROR TO 0 !10-2EX: IF RPSW THEN CALL RP..(2,PAR,ERR) !PU THE ID IF RP'ED EX: IF RPSW THEN CALL IDRPD(NNAM,.E.R.); \10-2 CALL EXEC (5,-1) !10-2 RELEASE ANY TRACKS IF .E.R. THEN ERR _ .E.R. !10-2 IER. !REPORT ANY OTHER ERRORS IF ERR THEN RETURN !10-2 CHECK IF ANY ERRORS CALL EXEC(14,1,C.BUF,40);ECH._.B. !10-2 GET RETURNED STRNG FROM PROG IF ECH.>40 THEN RETURN !10-2 BUG IN OP-SYSTEM IFNOT ECH. THEN RETURN !10-2 CHECK IF STRING RETURNED IF (C.BUF AND 177400K)=35000K THEN[ \10-2 CHECK IF STARTING : NO.RD _ -1; C.BUF _ C.BUF-15000K] !10-2 SET RD BF FGG,CHANGE : > SPA RETURN ! REPLC: SAVE _ $1 CALL SET.T(BAT,$DM) !RESET THE JOB TIMER IF RPSW THEN GOTO PRMSG ! IF SAVE # "05" THEN GOTO PRMSG ! !10-2 CALL RP..(1,PAR5,ERR) !IF EXEC COULDN'T FIND CALL OPEN. (I.BUF,$PTR1,N.OPL,5) !10-2 CALL READF (I.BUF,.E.R.,BUF.,128) !10-2 FOR LATER TESTS IER. !10-2 CALL IDRPL(I.BUF,.E.R.,NNAM) !10-2 CALL CLOS.(I.BUF) !*781103* IF .E.R. THEN ERR _ .E.R. !10-2 IF ERR = 19 THEN GO TO ERTS !PROGRAM, LOOK FOR A FILE. IF ERR = 16 THEN[ \IF NON PROGRAM FILE FILE. ERTS: IF BUF.= -1 THEN RETURރN; \IF EOF AT START OR IFNOT ($(@BUF.+1) AND 377K) THEN RETURN; \ A BINARY FILE GO TO TRANS] !DON'T TR ELSE DO TR. ! IF ERR THEN RETURN RPSW _ 1; GOTO TSET !FILE AND TRY AGAIN. ! TRANS: CAD.,NO.RD _ 1 !CAN'T FIND PROGRAM. ERR _ 0; RETURN !TREAT AS A "TR" FILE. PRMSG: ERR _ 49 IF RPSW THEN CALL IDRPD(NNAM,T1); \10-2 IF CANNOT RUN :RP,X > :RP,,X CALL EXEC (5,-1) !10-2 RELEASE ANY TRACKS PICKED UP RETURN END END END$ SPL,L,O ! NAME: ST.DU ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! 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 ST.DU(8) "92002-16008 760622" ! 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 CH2ARACTERS: ! 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 I.BUF,O.BUF,BUF. BE INTEGER,EXTERNAL ! LET N.OPL,.E.R. BE INTEGER,EXTERNAL ! LET CREA.,OPEN.,LOCF,\ EXEC,READF,WRITF,\ MSS.,RWNDF,\ IER.,CK.SM,CLOSE BE SUBROUTINE,EXTERNAL ! LET IFBRK BE FUNCTION,EXTERNAL ! LET DU..,ST.. 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) ! 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_@O.BUF !SET DCB ADDRESS FOR SPACING IBUF_@I.BUF !SET INPUT DCB ADDRESS BUFF,BUFA,BF_@BUF. DO[F1,SIOI,EOFF,CK,SIO,FLG_0;LDR_100000K] DO[SUBF_400K;F2,TYP,DUMP_1] IFNOT ERS+1 THEN [IERS,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; \ 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_0;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_0;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.(I.BUF,$LIS1,N.OPL ,SUBF+1) LOCF(I.BUF,.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 110K)+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,\ >K ELSE $SECT2->2] IFNOT $SZ1 THEN[IF INTY THEN $SZ1_ISZ2] ! ! CREAT THE FILE ! CREA.(O.BUF,$LIS5,$OPLS)?[GO TO ST10] GO TO ST12 ST10: OPEN.(O.BUF,$LIS5,$OPLS,SUBF) ST12: LOCF(O.BUF,.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 ! 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(I.BUF,.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 IF LDR THEN GO TO ST22 ! 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(O.BUF,.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);\ EXEuPfd`C(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(O.BUF) !REWIND TO BE SURE OF PURGE CLOSE(O.BUF,.E.R.,$SZ-ID-1) !CLOSE AND IER. RETURN ! EXIT: LOCF(O.BUF,.E.R.,T,ID,IOF) IER. IF OUTY < 3 THEN[ \IF TYPE 2 OR 1 IFNOT IOF THEN ID_ID-1 ] !ADJUST RB FOR ZERO OFSET IFNOT FLG THEN ID_-1 GO TO ENDIT END ! ! END END$ |AfSPL,L,O ! NAME: CO.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 741118 ! ! *************************************************************** ! * (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 CO..(8) ! 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.,FM.ER,CREAT,CLOS.\ BE SUBROUTINE,EXTERNAL ! LET PK.DR,N.OPL, DS.LU BE INTEGER,EXTERNAL LET O.BUF 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 T=?O 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 FM.ER (1, FNAM,3) ! SEND CURRENT NAME TO LOG CREAT(O.BUF,.E.R.,$PKD,$OPS1,$PKD3,$PKD8,$LIS5)! CREAT THE FILE IF .E.R.<0 THEN [MSS.(.E.R.-2000);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 ! ER _ ERR- 2000 ! BAD: MSS. (ER) !PRINT MESSAGE ! IF ER < 2000 THEN [ER_0; GO TO XFER] ! 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$ SPL,L,O ! NAME: SP.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 780405 ! ! *************************************************************** ! * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * ! * RESERVED. NO PART OF THIS PROGRAfM MAY BE PHOTOCOPIED, * ! * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* ! * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ! *************************************************************** ! NAME SP..(8) "92002-16008 REV.1826 780405" ! ! MODIFIED: TO CLEAR WRITTEN-ON FLAG IN DCB SET-UP 780106 GLM ! MODIFIED: TO SET LAST PTN USED (ID22)=0 780221 GLM ! MODIFIED: TO BYPASS ID EXTENSION SAVE FOR TYPE 5 780405 BL ! ! THE SP ROUTINE SAVES A PROGRAM ! IN A FILE. THE FIRST TWO SECTORS ! ARE SET UP TO ALLOW THE PROGRAM ! TO BE RESTORED TO THE SYSTEM ! ! THIS PROGRAM IS INVOKED BY : ! SP, NAME ! WHERE: ! NAME IS THE NAME OF THE ! PROGRAM TO BE SAVED. ! ! DEFINE THE EXTERNALS ! LET CREA., EXEC,\ WRITF,READF,RWNDF,\ IER.,OPEN. BE SUBROUTINE,EXTERNAL ! LET ID.A BE FUNCTION,EXTERNAL ! LET BUF.,O.BUF,I.BUF,N.OPL BE INTEGER,EXTERNAL ! ASSEMBLE ["EXT $OPSY";"EXT $IDEX"] ! ! DEFINE INTERNAL ROUTINES ! LET ADS, SP.. BE SUBROUTINE ! LET MF BE FUNCTION ! ! DEFINE CONSTANTS ! LET XEQT BE CONSTANT (1717K) LET SECT2 BE CONSTANT (1757K) LET SECT3 BE CONSTANT (1760K) SP..: SUBROUTINE (N,LIS,ER) GLOBAL IFNOT N THEN [ER_50; RETURN] PAD_@ LIS +1 ID27_[ID_ ID.A($PAD)?[ER_14 ; RETURN]]+26 ! BF,T1_@I.BUF FOR T_BF TO BF +127 DO $T_0 FOR T_ID TO ID+25 DO [$T1_ $T;T1_T1+1] T1_T1+2 FOR T_ID+28 TO ID+29 DO [$T1_$T;T1_T1+1] ADS (BF+11) ASSEMBLE ["LDA $OPSY";"STA OPSY";"LDA $IDEX";"STA IDEX"] T_$ID15 AND 7 !GET TYPE OF PGM IF T>1 THEN [IF OPSY = -9 OR T#4 THEN GO TO SP2] !LEGAL CONTINUE ER_56 !ILLEGAL PROGRAM TYPE RETURN ! SP2: IF OPSY = -9 AND T#5 THEN [ \IF RTE-IV & NOT SEG. IF $ID22 >= 0 +THEN[$ID22_ ($ID22 AND 177700K)]; \IF PTN NOT ASSIGNED \SET LAST PTN USED=0 \ FOR DISP (780221 GLM) IF $ID29 THEN [ \AND IF EMA T_$(IDEX+(($ID29 AND 176000K)-<6));\THEN INDEX TO ID EXT T1_T1+5; \AND $T1_($T AND 37K) OR 100000K; \SAVE ID EXT WORD 0 T1_T1+1; \AND T_T+1; \SAVE ID EXT WORD 1 $T1_$T AND 176000K]] ! IF $ID15 AND 20K THEN[$(BF+7)_$ID12;\ T1_ID15 ;\ FOR T_ID23 TO ID26 DO[\ $T_$[T1_T1+1]];\ ID27_ID20] $ID16,$ID17,$(BF+8)_0 $ID18_($ID18 AND 167777K) SZR_[SZ_[TY_[CR_ @N.OPL+1]+1]+1]+1 $SZR_128 $TY_6 ! IFNOT $CR THEN $CR_-2 ! $SZ_[XF_MF( ID23)+ MF( ID25)]+1 ! CREA. (O.BUF,$PAD,N.OPL)?[ER_-15;RETURN] ! $(@O.BUF+2)_1 !FORCE TO TYPE 1 CALL EXEC(1,2,BUF.,128,$1756K-1,0) !READ THE SET UP WORD ! $ID35_$(125+@BUF.)!MOVE TO ID BLOCK I.BUF_ -1 !SET EOF FOR THOSE WHO DON'T KNOW BETTER ! FOR T_BF TO ID33 DO[$ID34_$ID34+$T] ! WRITF(O.BUF,.E.R.,I.BUF) ! WRITE ID IER. ! ADS ( [IBUF_@O.BUF+16]+2) ! $IBUF_[IF[T_$ID27]<0 THEN 3,ELSE 2] ! SET DISC LU ! $ID12_1 $ID13_(T AND 77600K)-<9 $ID14_( T AND 177K) $ID15_$SZ-<1 $ID16_128 $ID17_201K $ID18_ [IF T<0 THEN $ SECT3,ELSE $SECT2] $(ID18+1)_$XEQT $ID23_0 !780106 GLM RWNDF($IBUF,.E.R.) IER. ! RDP: READF ($IBUF,.E.R.,$ID26,256) ! IER. ! WRITF(O.BUF,.E.R.,$ID26,[IF[XF_XF-2]<0 \ THEN 128, ELSE 256]) ! IER. ! IF XF>0 THEN GO TO RDP ! RETURN ! END ! MF: FUNCTION(MAD) _ !COMPUTE # BLOCKS OF FILE SPACE MFV_($( MAD+1)-$MAD +177K) >-7 RETURN END ! ADS: SUBROUTINE (BASE) ID18_[ID17_[ID16_[ID15_[ID14_[ID13_[ID12\ _ BASE]+1]+1]+1]+1]+1]+1 ID35_[ID34_[ID33_[ID29_[ID26_[ID25_[ID24_[ID23_[ID22\ 780221 GLM _[ID20_ID18+2]+2]+1]+1]+1]+1]+3]+4]+1]+1 ! 780221 GLM RETURN END END END$ SPL,L,O ! NAME: MS.. ! SOURCE: 92002-18008 ! RELOC: 92002-16008 ! PGMR: G.A.A. ! DATE: 740801 ! ! *************************************************************** ! * (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 MS..(8) ! ! THIS ROUTINE IS PART OF THE RTE ! FILE MANAGEMENT PACKAGE ! FMGR PROGRAM. ! IT MOVES A FILE INTO THE SYSTEM ! AREA AND SETS UP THE TAT ! FOR THE TRACKS USED TO ! POINT TO THE INDICATED PROGRAM. ! ENTRY IS ON A : ! LS,NAMR,PROG,IH ! 1 5 9 ! WHERE: ! LS GETS TO THIS ROUTINE ! NAMR IS THE FILE NAME REFERENCE INCLUDING SECURITY AND ! CARTRIDGE INFORMATION ! PROG IS PRESENT THE FILE IS TO ! BE ASSIGNED TO THE NAMED ! PROGRAM (IF NOT GIVEN THE ! LS AREA IS ASSIGNED TO ! THE EDITR PROGRAM) ! IH (OPTIONAL) INDICATES THE FILE ! IS NOT TO BE SET UP AS THE CURRENT ! LS FILE. ! DEFINE EXTERNALS ! SUBS. LET OPEN.,IWRIS,WEOFS,\ READF,EXEC, MSS.,\ FM.ER,CONV.,PRTM,\ WRIS, IPUT BE SUBROUTINE,EXTERNAL LET JER. BE SUBROUTINE,EXTERNAL,DIRECT ! ! FUNCTIONS ! LEJT ID.A BE FUNCTION,EXTERNAL ! ! ARRAYS AND INTEGERS ! LET BUF.,I.BUF,N.OPL,CUSE.,.E.R. BE INTEGER,EXTERNAL ! ! DEFINE CONSTANTS. ! LET TAT BE CONSTANT (1656K) LET TATLG BE CONSTANT (1755K) LET XEQT BE CONSTANT (1717K) LET MS(3),MSI,MST(4),MS2 BE INTEGER INITIALIZE MS ,MSI,MST ,MS2 TO " LS LU X TRACK XXX" LET ED(3) BE INTEGER INITIALIZE ED TO "EDITR" LET A BE CONSTANT ( 0 ) ! ! MS..: SUBROUTINE(CO,LIS,ER) GLOBAL ! LIS9 _[LIS5 _[LIS1_@LIS+1]+4 ]+4 !SET PRAM ADDRESSES EXEC (5,-1) PRTM(0) ID_ ID.A ($[IF $LIS5 THEN LIS5 ,ELSE\\ @ ED ])?[ER_14;RETURN] OPEN. (I.BUF, $LIS1,N.OPL,400K) DO [IWRIS(T); TR_ $A; IF T THEN[\ ER_5; RETURN]] ! REPORT THE TRACK ! LU_(TR AND 77400K)-<8 ! SET LU ! CONV.(LU,MSI,1) ! PUT IN MESS ! CONV.(TR AND 377K,MS2,3) ! PUT TRACK ! MSS.(2015) ! TELL HIM ITS ! FM.ER(1,MS,9) ! COMMING. SEND IT ! LSRD: READF (I.BUF,.E.R., BUF.,70,L) JER. IF L<0 THEN GOTO LSEOF ! WRIS (BUF.,-(L-<1),T) ! IF T THEN [ER_5;RETURN] ! GO TO LSRD ! LSEOF:WEOFS(T) ! FOR T_ $TAT TO $TAT-$TATLG DO[\ IF $T = $XEQT THEN IPUT(T,ID)] ! TR_(TR-<7) AND 177600K IF $LIS9 # "IH" THEN IPUT (1767K, TR) ! PRTM(TR) ! RETURN THE LS WORD ! RETURN END END END$ ASMB,R,L,C HED "RP.." FMGR ROUTINE TO DO :RP,X,Y * SOURCE: 92002-18008 * RELOC: 92002-16008 * PGMR: D.L.B. * * *************************************************************** * * (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 RP..,8 92002-16008 761004 ENT RP.. EXT IDSGA,MSS.,EXEC,OPEN.,READF,IER.,.E.R. EXT IDRPL,IDRPD,.ENTR,I.BUF,N.OPL,BUF. SPC 1 A EQU 0 SPC 1 DUMMY NOP DUMMY PARAMETER PBUF NOP PARAMETER BUFFER IERR NOP RETURNED ERROR PARAMETER RP.. NOP ENTRY JSB .ENTR DEF DUMMY LDA PBUF CALCULATE THE ADDRESS OF THE ADA O4 TWO PARAMETERS LDB A,I GET PARAMETER TYPE INA BUMP TO THE NAME STA PRAM2 SZB,RSS CHECK IF SECOND PARAMETER JMP SKPCC SKIP THE :RP,,XXXXX SPC 1 JSB IDSGA FIND IF ID FOR 2ND PARAMETER DEF *+2 PRAM2 DEF * SEZ,RSS FOUND? JMP FOUN1 YES, :RP,, IT JSB MSS. NO, OUTPUT FMGR 009 DEF *+2 DEF D2009 JMP SKPCC NOW TRY :RP, SPC 1 FOUN1 JSB IDRPD DELETE THE ID DEF *+3 DEF PRAM2,I NAME OF ID DEF DUMMY DONOT CHANGE 6P IF GOOD RETURN SZA CHECK IF ANY ERRORS JMP EXIT YES, RETURN NOW SPC 1 JSB EXEC NO, RELEASE ANY TRACKS DEF *+3 DEF O5 DEF OM1 SPC 1 SKPCC LDA PBUF,I GET THE 1ST PARAMETER TYPE ISZ PBUF POINT TO PARAMETER NAME SZA,RSS CHECK IF 1ST PARAMETER JMP RP..,I NO, JUST RETURN DONE JSB IDSGA YES, FIND IF EXISTS? DEF *+2 DEF PBUF,I NAME OF 1ST PARAMETER SEZ CHECK IF FOUND? JMP FOUN2 NO, THEN PROCEED TO :RP, LDA D23 YES, DUPLICATE PROGRAM EXIT STA IERR,I RETURN FMGR 023 JMP RP..,I ERROR RETURN, WITH ERROR CHANGED!! SPC 1 FOUN2 JSB OPEN. NOW TRY TO OPEN UP THE FILE DEF *+5 DEF I.BUF DCB FOR FILE DEF PBUF,I FILE NAME DEF N.OPL SC,CRN DEF O5 NON EXC, FORCE TYPE 1 JSB READF NOW READ THE 1ST RECORD DEF *+5 DEF I.BUF DEF .E.R. DEF BUF. DEF D128 JSB IER. DEF *+1 JSB IDRPL NOW DO THE :RP, DEF *+4 DEF I.BUF DCB FOR FILE DEF DUMMY GET ERROR LOCALLY DEF PBUF,I SZA,RSS CHECK IF ANY ERROR? JMP RP..,I NO, RETURN DONE JMP EXIT YES, SET THE ERROR NUMBER SPC 1 O4 OCT 4 O5 OCT 5 D23 DEC 23 D128 DEC 128 D2009 DEC 2009 OM1 OCT -1 END ASMB,R,L HED "SESSN" ROUTINE TO FIND IF IN SESSION MODE * SOURCE: 92002-18008 * RELOC: 92002-16008 * PGMR: D.L.B. * * *************************************************************** * * (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 SESSN,7 92002-16008 REV.1826 780403 ENT SESSN EXT .ENTR,$OPSY SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 * CALLED: * JSB SESSN * DEF *+2 * DEF 0G LOGICAL UNIT OF SESSION TERMINAL * A = -1 IF NO SESSION * A = ASCII OF THE TERMINAL LOGICAL UNIT * E-REG = 1 IF NO SESSION * E-REG = 0 IF SESSION FOUND * ALGORITHM * WHEN LU IS CONVERTED TO ASCII, IT MUST MATCH THE LAST TWO * CHARACTERS OF THE CALLING PROGRAMS NAME AND THE SESSION BIT * IN THE IDSEGMENT (WORD 21, BIT 13) MUST BE SET. SPC 1 LU NOP GIVEN 0G SESSN NOP ENTRY JSB .ENTR DEF LU LDA LU,I GET POSSIBLE SESSION LU CLB CONVERT TO ASCII DIV D10 ALF,ALF IOR B IOR "00" STA LU SAVE FOR LATER LDA $OPSY OP SYSTEM IDENTIFIER ERA,ERA GET MAPPED BIT TO E LDB XEQT GET LAST TWO CHARS OF MY NAME ADB D13 INDEX INTO MY ID SEGMENT SEZ MAPPED SYSTEM? JMP XLOD1 YES DLD B,I NO, GET LAST 2 CHARS CONT1 RRR 8 GET LAST TWO IN B-REG LDA XEQT NOW CHECK IF SESSION BIT IS SET ADA D20 SEZ MAPPED SYSTEM? JMP XLOD2 YES LDA A,I GET WORD 20 FROM ID SEGMENT CONT2 AND SESBT MASK OFF ALL EXCEPT SESSION BIT CPB LU CHECK IF LAST TWO CHARS MATCH CLE,SZA,RSS AND SESSION BIT IS SET CCA,CCE NO, RETURN WITH NO SESSION LDA B YES, RETURN A & B = ASC 0G JMP SESSN,I DONE SPC 1 XLOD1 XLA B,I GET 2ND WORD OF NAME INB XLB B,I GET 3RD WORD OF NAME JMP CONT1 CONTINUE XLOD2 XLA A,I GET WORD 20 FROM ID SEGMENT JMP CONT2 CONTINUE SPC 1 "00" ASC 1,00 D10 DEC 10 D13 DEC 13 D20 DEC 20 SESBT OCT 20000 END ASMB,R,L,C HED ".RENM" ROUTINE TO RENAM MODULES WITH FMGR :RU,XXX * SOURCE: 92002-18008 * RELOC: 92002-16008 * PGMR: D.L.B. * * *************************************************************** * * (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 .RENM,8 92002-16008 761004 ENT .RENM EXT .ENTR,IDDUP,IDSGA,.DFER SPC 1 A EQU 0 B EQU 1 XEQT EQU 1717B SPC 1 * PURPOSE: RENAME A PROGRAM BEFORE RUNNING IT IF IN SESSION MODE * * < CALLED: CALL .RENM (NNAM,IERR,RPSW) * WHERE: * NNAM = 3 WORD BUFFER THAT CONTAINS THE GENERIC NAME * RETURNED WITH THE NEW NAME * IERR = NON ZERO IF LACK OF SUCCESS IN RENAMING * RPSW = RETURNED AS 1 IF AN IDSEGMENT IS PRODUCED * SPC 1 OLDNA NOP THREE WORD NAME BUFFER IERR NOP RETURNED ERROR CODE RPSW NOP CREATED NEW ID FLAG .RENM NOP ENTRY JSB .ENTR DEF OLDNA JSB .DFER GET NAME INTO INTERNAL BUFFER DEF NEWNA NEW NAME DEF OLDNA,I GENERIC NAME LDA XEQT GET LAST 2 CHARS OF MYNAME ADA D13 AND PROPAGATE TO NEW NAME DLD A,I RRR 8 GET IN B-REG STB TEMP1 SAVE LAST 2 CHARS OF FMGXX'S NAME DLD NEWNA NOW MODIFY OLD NAME TO NEW NAME AND O377 CHECK FOR IMBEDDED SPACES CPA SPACE ? LDA DOT YES, REPLACE SPACES WITH .'S IOR NEWNA MERGE IN 1ST CHARACTOR STA NEWNA LSR 8 NOW CHECK 2ND CHARACTOR CPB SPACE IS IT A SPACE? LDB DOT YES , CHANGE TO DOT LDA TEMP1 NOW GET LAST 2 CHARS OF NAME RRL 8 POSITION IOR SPACE MAKE 6TH CHAR A SPACE STB NEWNA+1 AND SAVE BACK STA NEWNA+2 IN THE NEW NAME BUFFER SPC 1 JSB IDSGA NOW FIND IF GENERIC NAME IS IN CORE ID? DEF *+2 DEF OLDNA,I SO THAT WE CAN RENAME IT? SZA,RSS YES, GO RENAME IT JMP MOVEB NO, CHANGE OLD NAME TO NEW NAME & RETURN ADA D26 BUMP TO WORD 27 OF IDSEG STA TEMP1 SAVE THE ID ADDRESS FOR LATER CHECK AGAIN JSB IDDUP NOW REPRODUCE THE ID DEF *+4 DEF OLDNA,I DEF NEWNA DEF IERR,I RETURN ERROR CODE SSA CHECK IF ILLEGAL NAME JMP EXIT YES, GET OUT CPA D14 CHECK IF NO ROOM FOR ID'S JMP EXIT YES, GET OUT CPA D16 CHECK IF UNDUPLICATABLE RSS YES CPA D17 CHECK IF UNDUPLICATABLE JMP GDEXT GOOD EXIT, NO RENAMING SPC 1 DUPCK CPA D23 CHECK IF ID ALLREADY EXISTS JMP CKIDT YES, CHECK IF SAME AS GENERIC NAME SZA CHECK IF OK DUPLICATION JMP EXIT IMPOSSIBLE ERROR FROM IDDUP ROUTINE INA SET SUCCESSFUL DUPLICATION FLAG STA RPSW,I AND RETURN IT MOVEB JSB .DFER MOVE NEW NAME BACK INTO OLDNAME BUFFER DEF OLDNA,I DEF NEWNA GDEXT CLA STA IERR,I RETURN GOOD ERROR CODE JMP EXIT DONE SPC 1 CKIDT JSB IDSGA FIND IDSEGMENT OF NEW NAME DEF *+2 DEF NEWNA SZA,RSS CHECK IF FOUND JMP AGAIN NO, WELL THIS IS A REAL TIME SYSTEM ADA D26 BUMP TO DISC ADDRESS WORD LDA A,I GET DISC TRACK/SECTOR/LU WORD CPA TEMP1,I CHECK IF SAME A GENERIC NAME? JMP MOVEB YES, EXIT OK EXIT JMP .RENM,I NO, DUPLICATE NAME ERROR SPC 1 D13 DEC 13 D14 DEC 14 D16 DEC 16 D17 DEC 17 D23 DEC 23 D26 DEC 26 O377 OCT 377 DOT OCT 56 SPACE OCT 40 TEMP1 NOP NEWNA REP 3 NOP END ASMB,R,L,C HED ".EXCP" ROUTINE TO DETERMINE EXCEPTION LIST OF RENAMING * SOURCE: 92002-18008 * RELOC: 92002-16008 * PGMR: D.L.B. * * *************************************************************** * * (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 .EXCP,8 92002-16008 761002 ENT .EXCP EXT .ENTR,IDSGA,N.OPL SPC 1 A EQU 0 * CALLED * JSB .EXCP * DEF *+2 * DEF PNAME PROGRAM NAME * %; A-REG & E-REG = 0 IF ALLOWED TO RENAME PROGRAM * A-REG = -1 & E-REG = 1 IF NOT ALLOWED TO RENAME SPC 1 NAME NOP PROGRAM NAME .EXCP NOP ENTRY JSB .ENTR DEF NAME JSB IDSGA FIND NAME IN SYSTEM DEF *+2 DEF NAME,I LDB N.OPL GET OPTION WORD :RU,PROG:= SOURCE BYTE ADDRESS. LDB NUMBA = MESSAGE BYTE ADDRESS. MBT OCCNT MOVE NODE NUMBER(ASCII) TO MESSAGE. LDA MINCT GET MINIMUM MESSAGE LENGTH (CHARS.) ADA OCCNT ADD THE NODE NUMBER CHAR. LENGTH, CMA,INA AND CONVERT TO NEG. CHAR. COUNT. STA TELCN SET THE MESSAGE LENGTH FOR 'PRINT'. JSB PRINT PRINT: "EDITING AT NODE XXXXX" DEF PSF TELCN NOP CONFIGURED NEG. MESSAGE LENGTH. TEMSG ASC 11,EDITING AT NODE 0 MINCT DEC 18 NUMBA DBL TEMSG+8 XIF PSF LDA DVTY CHECK FOR DRIVER 07B CPA DVR07 RSS JMP PSFC NO, SKIP NEXT CODE STA DVTYX SAVE CONS. DVR. TYPE. JSB PRINT SET TABS AT COLUMN'S 8 AND 23. DEF PSFC DEC -17 ASC 9,3&a8C1&a22C1 PSFC JSB PRINT PRINT "SOURCE FILE" DEF SRCIN DEC 6 ASC 6,SOURCE FILE? SRCIN JSB TTYIP INPUT RESPONSE CPB .1 ONE WORD RESPONSE? JMP FTST YES, CHECK FOR "0", OR ":". FPARS JSB SC.CR PARSE FILE NAME JMP LSFIL USE LS AREA DLD FSECR SAVE SC AND CR FOR A DST FSECW POSSIBLE ER. JSB INSRC FETCH FILE JMP PSF NOT FOUND TRY AGAIN * LDA FCARW GET USER'S CART. SPECIFICATION. SZA WAS IT SUPPLIED? JMP STEOF YES--NO NEED TO FAKE IT. LDA SBUF$,I NO. GET FIRST WORD OF DCB. AND B77 ISOLATE THE FILE'S LOCATION LU. CMA,INA NEGATE, AND SAVE FOR STA FCARW POSSIBLE USE IN FILE REPLACEMENT. * STEOF CCA SET EOF FLAG STA SLNG IN SOURCE LENGTH JSB ./B1 TRANSFER PARTIAL BUFFER JMP STBUF SET TBUFF. SPC 1 FTST LDA EBUFF,I GET SINGLE INPUT CHARACTER ALF,ALF ISOLATE THE AND LBYTE FIRST-AND 0NLY-INPUT CHARACTER. CPA ":" =":"? JMP ./A1 YES, QUIT NOW CPA B60 ="0"? CLA,RSS YES, SIMULATE NULL LS JMP FPARS GO PARSE FILE NAME JMP LSNUL SPC 1 LSFIL EQU * IFZ JSB REMCK TALKING REMOTE? CLA,RSS YES,TREAT LS AS UNDEFINED XIF LDA SFCUN SAVE SYSTEM LS POINTER, LSNUL CCB UNLESS LS UNDEFINED. SZA,RSS STB NOLSF STA LSLUT IN SOURCE FILE POINTER AND STA LSTRK SET UP RELEASE TRACK PNTR JSB ALCAT GET LS FILE AND DEST. TRACK CCA IF THE LOGICAL SOURCE AREA CPA NOLSF IS UNDEFINED, THEN JMP STEOF+1 BYPASS SOURCE INPUTS, AT PRESENT. JSB SQ FILL INPUT BUFFER STBUF LDA TBUFP POINT TBUFF TO TBUF0 STA TBUFF FOR ALL OTHER EDIT USES. JMP DISPL PRINT FIRST LINE SPC 1 .22 DEC 22 TBUFP DEF TBUF0 MBUF0 EQU EDITR OVERLAY ONE-TIME CODE. LERR EQU *-EDITR-75 CHECK ENOUGH ONE-TIME CODE FOR * 75 WORDS OF MBUF0. SPC 1 * MBUF0 OVERLAYS CODE AT THE START ('EDITR') WHICH IS * NOT NEEDED ONCE SOURCE FILE INFORMATION IS COMPLETE. * IT IS ONE OF THE DYNAMICALLY ASSIGNED BUFFERS. SEE * COMMENTS FOR EBUF0,ETC. NEAR END OF LISTING. SPC 1 NOLSF OCT 0 SET TO -1 IF LS UNDEFINED. N141 OCT -141 N32 OCT -32 * ********* * READ IN EDIT COMMAND AND ACT ON IT. ********* * NODE1 CLA RESET CHARACTER STA EXFLG EXCHANGE FLAG LDA LUCMD GET THE LAST LU-LOCK COMMAND. SLA IF THE LIST LU WAS LOCKED, JSB LULOK THEN GO TO UNLOCK IT. LDA TTYLU RESET THE STA LSTLU LIST LU IFZ CLB LDA INTFL GET THE INTERACTIVE FLAG. STB INTFL CLEAR THE INTERACTIVE FLAG. SZA,RSS IF FLAG WAS SET, SKIP--COMMAND WAS READ. XIF NODE2 JSB TTYIP INPUT COMMAND JSB ECH JMP ERR JSB LCASE CONVERT LOWER CASE CHAR.--IF REQUIRE0D. STA COMND SAVE TEMPORARILY * CPA "A" JMP ./A LDB ./EFL IF END ENTERED ANY OTHER COMMAND SZB,RSS IS DISALLOWED JMP NOTEN OK ALLOW ANY COMMAND CPA "E" END AGAIN? JMP ./E2 YES GO TRY THE NEW FILE NAME JMP ERR NO ERROR NOTEN LDB B40 RESET TAB FILL STB TBFIL TO SPACE CPA B40 COMMAND? JMP O/PEB NO, OUTPUT LINE CPA "=" JMP ./= CPA %G JMP ./CG MUTE BELL WITH PROMPT. CPA "P" JMP ./P DISPLAY CURRENT LINE CCB STB TRFLG STB LSTFG CPA "C" IF CHARACTER JMP ./C GO DO IT CPA "L" JMP NUMBR CLB STB LSTFG RESET LIST FLAG CPA "K" JMP ./K CPA "#" SEQUENCE NUMBER? JMP ./# CPA "O" JMP ./O CPA "M" MERGE NEW SOURCE? JMP ./M YES GO DO IT CPA SLASH SLASH AND "+" MEAN THE SAME RSS CPA PLUSS JMP NUMBR CPA "E" JMP ./E CPA "N" JMP ./N CPA "H" JMP ./H CPA "S" JMP ./S CPA "T" JMP ./T CPA "U" JMP ./U UNCOND. REPLACE W/O LIST. CPA "V" JMP ./V THIS WITH LIST. CPA "W" SPECIFY A NEW WINDOW? JMP ./W CPA "G" JMP ./Z CPA "X" JMP ./X CPA "Y" JMP ./X CPA "Z" DEFINE XCHANGE PATRN W/O LIST JMP ./Z CPA "^" JMP ./^ STB TRFLG RESET TRANSFER FLAG CPA MINUS JMP NUMBR JSB ASCII COMMAND CHARACTER RSS NUMERIC? JMP FNUM YES, GO TO FIND LINE NUMBER JSB TAB TAB THE COMMAND LINE LDA COMND RESTORE COMMAND CHARACTER CPA "Q" TERMINAL INTRINSIC EDIT? JMP ./Q YES, GO TO PROCESS. CPA "R" JMP ./R  CPA "I" JMP ./I JSB SWPET LDA COMND CPA "D" JMP COMPR CPA "J" JUMP TO NEW LINE W/O TRANSFER JMP ./J CCB STB TRFLG SET TRANSFER FLAG CPA "F" JMP COMPR CPA "B" COMPLETE TRANSFER AND START SEARCH JMP ./B FROM THE BEGINNING ERR JSB ERROR ERROR DEF NODE1 IN INPUT DEC 1 COMMAND ASC 1,?? PRINT "??" *** %G OCT 7 BELL (CONTROL G) "=" OCT 75 "G" OCT 107 "K" OCT 113 "Q" OCT 121 "U" OCT 125 "V" OCT 126 "X" OCT 000130 B37 OCT 37 B77 OCT 77 DVR12 OCT 5000 LINE PRINTER TYPE CODE. DVR23 OCT 11400 MAG. TAPE TYPE CODE. DVRTY OCT 37400 DRIVER TYPE MASK N.13I OCT 100015 STATUS REQUEST CODE LSTLU OCT 606 LIST LU * NUMBR JSB NUMIN CMA,INA COMPLEMENT NUMBER SZA,RSS AND STORE IN COUNT CCA IF NUMBER IS ZERO SET STA COUNT TO -1 JSB NLSLU SET UP NEW LU IF GIVEN ./CC JSB TR SSB EOF FOUND? JMP EOFPR YES, PRINT "EOF" FNUM2 ISZ COUNT FOUND LINE NUMBER? JMP ./CC NO, FETCH NEXT LINE JMP DISPL YES, DISPLAY IT SPC 1 NLSLU NOP JSB NUMIN GET OPTIONAL NEW LIST LU AND B77 SAVE JUST THE LU LDB 0 SZA,RSS IF NOT SUPPLIED LDA TTYLU USE TTY LU IOR B600 SET ECHO AND V-BITS STA LSTLU SAVE THE LU SZB,RSS SKIP UNLESS NOT SPECIFIED JMP NLSLU,I * JSB TYPEQ GET LIST DEVICE TYPE CODE. SZA,RSS IF IT'S INTERACTIVE, JMP NLSLU,I THEN SIMPLY RETURN; ELSE, CHECK: LDA LSTLU CPA TTYLU MUST NOT BE SAME AS COMMAND INPUT DEVICE JMP ERR JSB LULOK GO TO LOCK THE LIST DEVICE. JMP NLSLU,I RETURN. SPC 1 LULOK NOP LIST LU LOCKING/UNLOCKING ROUTINE. LDA LUCMD ` GET THE CURRENT COMMAND. XOR .1 CONVERT TO OPPOSITE ACTION. STA LUCMD SAVE FOR NEXT PASS. STA IOPT CONFIGURE THE CALL. IFZ JSB REMCK IF THE LIST DEVICE IS REMOTE, JMP LULOK,I THEN LOCKING IS NOT REQUIRED. XIF LOKIT JSB LURQ REQUEST DEF *+4 LOCK OR DEF IOPT UNLOCK DEF LSTLU FOR THE SPECIFIED DEF .1 LIST LOGICAL UNIT. JMP LUERR REPORT THE ERROR. * CPA M1 IF NO RN'S AVAILABLE, NOW, CLA,INA,RSS THEN GO BACK AND WAIT. CPA .1 IF LOCKED BY ANOTHER, THEN JMP WAITL GO BACK TO WAIT FOR IT. JMP LULOK,I LOCK/UNLOCK SUCCESSFUL--RETURN. * WAITL IOR BIT14 INCLUDE NO-ABORT BIT, STA IOPT AND SET COMMAND: WAIT FOR LU/RN. JSB PRINT INFORM DEF LOKIT THE USER DEC 15 THAT WE MUST WAIT. NAME1 ASC 15,EDITR WAITING FOR LIST DEVICE. * LUERR DST LUMSG+7 CONFIGURE ERROR MESSAGE. LDA TTYLU REPORT TO THE CONSOLE, INSTEAD, STA LSTLU DUE TO LIST-DEVICE PROBLEM. JSB ERROR PRINT THE ERROR MESSAGE, DEF LULOK,I AND DO THE REQUESTED LISTING. DEC 9 LUMSG ASC 9,LU LOCK ERROR XXXX LUCMD OCT 140001 NO WAIT/NO ABORT/LOCK IOPT OCT 140000 FIRST TIME: UNLOCKS ANY LU'S. BIT14 OCT 40000 DVTY NOP DVTYX NOP * TYPEQ NOP EQUIPMENT TYPE CODE DETERMINATION. STA LULOK SAVE LOGICAL UNIT, TEMPORARILY. JSB DEXEC GO TO GET I/O STATUS FOR THE DEVICE. DEF TYRTN IFZ DEF NODE XIF DEF N.13I NO-ABORT STATUS REQUEST DEF LULOK FOR THE SPECIFIED LOGICAL UNIT NO. DEF TAB EQT5 RETURNED TO 'TAB'. DEF SWPET EQT4 RETURNED, BUT NOT USED. DEF CHKN SUBCHANNEL RETURNED TO 'CHKN'. TYRTN JMP ERR ** ERROR: ISSUE "??" ** LDA TAB ISOLATE THE DEVICE TYPE CODE AND DVRTY FHROM EQUIPMENT-TABLE WORD #5. STA DVTY SAVE IT SZA,RSS IF IT'S TYPE <00> (INTERACTIVE), JMP TYPEQ,I THEN RETURN IMMEDIATELY: =0. * CPA DVR05 IF IT'S A 264X TERMINAL, THEN JMP TYPE5 GO TO EXAMINE THE LU SUBCHANNEL; CPA DVR07 2645 MP TERMINAL? DVR05 CLA YES, CLEAR "A" JMP TYPEQ,I ELSE RETURN: #0 (NON-INTERACTIVE). * TYPE5 LDA CHKN GET SUBCHANNEL FOR DEVICE. AND B37 ISOLATE SUBCHANNEL BITS(#4-0). STA B SAVE IT TEMPORARILY. SZA,RSS IF THE SUBCHANNEL IS ZERO, THEN RETURN JMP TYPEQ,I WITH SIMULATED TYPE <00> CODE IN . LDA DVR23 PREPARE TO SIMULATE MAG. TAPE TYPE<23>. CPB .4 IF THE SUBCHANNEL IS FOUR, THEN LDA DVR12 SIMULATE TYPE <12> LINEPRINTER. JMP TYPEQ,I RETURN--DEVICE TYPE: <12>,LP OR <23>,MT. SPC 1 COMPR JSB TR TRANSFER PENDING LINE COMP1 JSB ECH MATCH FIELD SUPPLIED? JMP EOFTS NO USE OLD ONE COMP2 LDA EBUFF YES SWAP EBUFF LDB MBUFF AND MBUFF STA MBUFF SET UP THE STB EBUFF NEW MATCH FIELD LDA ELNG SET THE NEW MATCH LENGTH STA MLNG FOR MBUFF EOFTS LDA SLNG IF AT SSA END OF FILE JMP EOFPR PRINT "EOF" JMP COMP4 START SEARCH COMP3 JSB TR SSB EOF FOUND? JMP EOFPR YES, PRINT "EOF" COMP4 CLA CLEAR STA WINDF WINDOW FLAG STA MCCNT STA JDEF$ ZERO THE INDEFINITE STA IDEF$ FLAGS. CMPR1 JSB MCH JMP DISPL CPA INDEF INDEFINITE CHARACTER? JMP CMPR2 YES - GO SET UP. CPA DLMTR WINDOW SPECIFIED JMP CMPR5 ON SEARCH CMPR7 STA NUM1 NO - SAVE THE CHARACTER CMPR6 LDA WIND2 PAST ADA SCCNT WINDOW AND LDB WINDF WINDOW SLB FLAG SSA SET? RSS  NO -- CONTINUE SCAN JMP COMP3 YES -- PATTERN NOT FOUND SPC 1 JSB SCH GET SOURCE CHARACTER. JMP EOL END OF INPUT CPA NUM1 COMPARE WITH PATTERN JMP CMPR3 COMPARES SO JUMP TO INDEF TEST LDB IDEF$ INB,SZB,RSS IF FIRST CHARACTER SEARCH JMP CMPR6 TRY THE NEXT CHARACTER. ISZ JDEF$ END OF INDEF MATCH? JMP COMP3 NO - SO NO MATCH. SPC 1 LDA SCCN$ RESET SOURCE POINTER STA SCCNT AND LDA MCCN$ PATTERN STA MCCNT LOCATION THEN LDB WINDF RESET THE WINDOW FLAG BRS IF TWO SET TO 1 ELSE 0. RSS SKIP THE CLEAR. SPC 1 CMPR2 CLB CLEAR CMPR8 STB WINDF WINDOW FLAG LDA MCCNT SET UP FOR INDEFINITE STA MCCN$ CHARACTER DVR07 CCA SAVE THE PATTERN LOCATION AND STA IDEF$ SET THE FIRST CHAR. FLAG STA JDEF$ AND THE INDEF FLAG JMP CMPR1 GO GET THE FIRST PATTERN CHARACTER. SPC 1 CMPR3 ISZ IDEF$ FIRST CHAR FOUND AFTER INDEF CHAR? JMP CMPR1 NO CONTINUE LDB WINDF GET WINDOW FLAG AND CPB .1 IF ONE SET TO ISZ WINDF SET TO TWO LDA SCCNT YES - SET STA SCCN$ CURRENT SOURCE POSITION. JMP CMPR1 CONTINUE MATCH SPC 1 CMPR5 CLB,INB IS WINDOW CHARACTER CPB MCCNT THE FIRST CHAR. OF COMMAND? RSS YES -- CONTINUE JMP CMPR7 NO, IGNORE LDA WIND1 START SEARCH AT STA SCCNT BEGINNING OF WINDOW CMA,INA IF WINDOW ADA SLNG STARTS BEYOND SSA END OF LINE JMP COMP3 DO NOT SEARCH JMP CMPR8 CONTINUE SEARCH WITH INDEF. 1ST SPC 1 * EOL CCA ADA MLNG IF THE ONLY CHARACTER IN THE MATCH FIELD IOR NUM1 IS ZERO (CNTR-@) IOR SLNG AND THE CURRENT LINE IS LENGTH ZKNLHERO, SZA,RSS JMP DISPL THEN DISPLAY IT. JMP COMP3 ELSE, NOT FOUND * * FNUM CLA RESET COMMAND STA ECCNT CHARACTER POINTER JSB NUMIN COMPUTE LINE NUMBER CMA,INA,SZA,RSS COMPLEMENT AND IF ZERO CCA SET TO -1 STA COUNT AND SAVE STA TRFLG SET TRANSFER FLAG JSB NLSLU SET UP NEW LU IF GIVEN LDA COUNT LOAD -(LINE NUMBER DESIRED) ADA LINES ADD CURRENT POSITION SSA,RSS IF POSITIVE JMP FNUM3 GO TO BEGINNING OF FILE STA COUNT ELSE USE DIFFERENCE AS LOOP CNTR JMP ./CC GO FIND LINE SPC 1 FNUM3 JSB ./B1 COMPLETE TRANSFER JMP FNUM2 SPACE FORWARD TO DESIRED LINE SPC 1 ./# LDA M3 SKIP OVER STA COUNT ALPHA COMMENT. ./#0 JSB ECH NOP ISZ COUNT JMP ./#0 JSB NUMIN FETCH START NUMBER swN STA BASE AND SAVE AS BASE JSB NUMIN FETCH 2ND NUMBER SZA,RSS IF ZERO SET LDA .10 TO 10 AND STA INCR SAVE AS INCREMENT JSB ./B1 GO TO BEGINNING OF FILE SPC 1 ./#1 CLA RESET CHARACTER OUTPUT STA OCCNT COUNTER LDA M72 MOVE STA COUNT FIRST 72 ./#2 JSB SCH CHARACTERS JMP SPC OF SOURCE JSB OUTCR TO OUTPUT ISZ COUNT BUFFER JMP ./#2 JMP ./#3 SPC 1 SPC LDA B40 BLANK JSB OUTCR FILL TO ISZ COUNT COLUMN 72 JMP SPC ./#3 CLA,INA SET UP COMMAND STA ECCNT BUFFER COUNTER LDA M3 SET UP LOOP STA COUNT COUNTER FOR 3 CHARACTERS ./#4 JSB ECH FETCH NEXT ALPHA COMMENT LDA B40 LOAD BLANKS IF NO COMMENT JSB OUTCR OUTPUT CHARACTER ISZ COUNT THIRD CHARACTER? JMP ./#4 NO, FETCH NEXT CHARACTER SPC 1 LDA BASE OUTPUT LINE NUMBER CLB JSB DEC IN ASCII LDA BASE UPDATE ADA INCR LINE STA BASE NUMBER LDA OCCNT OUTPUT CHARACTER LDB TBUFF TO DISC BUFFER JSB DOUTP JSB I/PSB INPUT NEXT RECORD SSB AT EOF? JMP EOFPR YES, PRINT "EOF" JMP ./#1 NO, CONTINUE SPC 1 ./= JSB NUMIN GET REQUESTED LENGTH SZA,RSS JMP ERR ADA MAXIN IF LONGER THAN ALLOWABLE SSA,RSS MAX, USE ALLOWABLE MAX CLA AND CONTINUE. ADA MAX STA MAXOP JMP NODE1 SPC 2 TBFIL OCT 40 WINDF NOP M72 DEC -72 MLNG NOP MCCNT NOP MBUFF DEF MBUF0 CHANGES POINTS TO CURRENT MATCH BUFFER JDEF$ NOP INDEFINITE PROCESSING FLAG * ALSO USED FOR IDEF$ NOP FIRST CHAR AFTER INDEF FLAG * ALSO USED FOR INDEF OCT 33 INDEFINITE CHAR. IS ESCAPE. INDE2 OCT 176 ALTERNATE ESCAPE CHAR. MCCN$ NOP INPUT PATTERN LOCATION FOR INDEF SEARCH * * TAB PERFORMS THE TAB OPERATION TAB NOP CLA RESET OUTPUT STA OCCNT CHARACTER COUNTER AND STA CNTRL 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 CNTRL NON-CONTROL CHARACTER COUNTER JSB OUTCR NO, OUTPUT CHARACTER JMP TAB1 TBFND CCB SET SPACE COUNTER STB CNT1 TO -1 LDB TBPNT,I TAB POINTER SZB,RSS ZERO? JMP SPACE YES, OUTPUT SPACE ISZ TBPNT BUMP TAB POINTER ADDRESS ADB CNTRL PAST SSB,RSS TAB? JMP TBFND+2 YES, GET NEXT TAB STB CNT1 STORE SPACE COUNTER SPACE LDA TBFIL LOAD SPACE JSB OUTCR OUTPUT SPACE ISZ CNTRL BUMP NON-CONTROL CHAR. CNTR. ISZ CNT1 LAST SPACE? JMP SPACE NO, CONTINUE SPACING JMP TAB1 GET NEXT CHARACTER * * SWPET SWAPS EBUFF AND TBUFF SWPET NOP USED AS TEMP 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 ./W JSB CHKN CHECK PARAMETERS JSB NUMIN FETCH SZA START OF ADA FM1 WINDOW STA WIND1 POINTER JSB NUMIN FETCH CMA,INA,SZA,RSS END OF LDA MAXIN WINDOW STA WIND2 POINTER JMP NODE1 GET NEXT COMMAND SPC 1 WIND1 NOP WIND2 DEC -150 SPC 1 CHKN NOP NPARA JSB NUMIN FETCH NEXT PARAM LDA ELNG IF END OF COMMAND CPA ECCNT THEN, ALL PARAMETERS CLA,INA,RSS WERE NUMERIC JMP NPARA ELSE, FETCH NEXT PARAM STA ECCNT RESET COUNT AND RETURN JMP CHKN,I * ./T JSB ECH STEP PAST TAB CHAR. JMP ./T1 NONE, SO DISABLE TAB JSB CHKN OTHERWISE CHECK PARAMETERS JSB ECH GET TAB CHARACTER ./T1 CCA SET TAB CHARATER TO -1 TO DISABLE STA TABCR STORE TAB CHARACTER LDA TABUF RESET TAB ADDRESS STA TBPNT POINTER LDA M10 SET COUNTER STA CNT1 TO -10 LDA ECCNT IF ONLY TAB CHARACTER CPA ELNG GIVEN, THEN RETURN JMP NODE1 WITH TABS UNCHANGED NXTNM JSB NUMIN GET NEXT NUMBER CMA,INA,SZA FIRST NUMBER ZERO? INA NO, INCREMENT IT STA TBPNT,I STORE TAB NUMBER ISZ TBPNT BUMP POINTER ISZ CNT1 LAST TAB? JMP NXTNM NO, CONTINUE JMP NODE1 YES, GET NEXT COMMAND TABUF DEF TAB0 TABCR OCT 73 DEFAULT TAB CHARACTER = ";" TBPNT NOP B54 OCT 54 "," * * TR TRANSFERS CURRENT SOURCE LINE TO DEST. AND GETS NEXT LINE TR NOP LDB SLNG IF AT SSB EOF, JMP TR,I RETURN LDB XIDT CHECK FOR A BREAK ADB .20 REQUEST BY EXAMINING BIT 12 LDA B,I OF ID SEGMENT WORD 21. AND BIT12 IF BREAK REQUEST IS PRESENT, SZA STOP WHAT IS GOING ON. JMP BREAK LDB TRFLG TRANSFER RECORD TO SZB DESTINATION FILE? JSB O/PSB YES, OUTPUT RECORD LDB LSTFlG LIST CURRENT SZB RECORD? JSB LSTSB YES, PERFORM LIST JSB I/PSB GET NEXT RECORD JMP TR,I SPC 1 .20 DEC 20 BIT12 OCT 10000 SPC 1 BREAK JSB $LIBR NOP LDA B,I GET ID SEGMENT WORD 21 AGAIN XOR BIT12 ZERO ONLY BIT 12 STA B,I JSB $LIBX RESTORE INTERRUPT NOW THAT ID DEF *+1 WORD IS SAFE. DEF DISPL DISPLAY PENDING LINE. SPC 1 ./^ JSB NUMIN GET LINES TO SUBTRACT. LDB T#REM CHECK # DEST REC >65K SZB AND IGNORE COMMAND JMP ERR IF SO. LDB T#REC CURRENT DESTINATION LINE CMB,SSB,RSS IF > 32K,IGNORE JMP ERR COMMAND. SZA,RSS NULL _ 1 INA ADA B SSA,RSS IF OFF THE TOP END, JMP ERR IGNORE COMMAND. STA COUNT JMP FNUM3 GO TO NEW LINE. SPC 1 NUMIN NOP ISZ ECCNT * JSB NAMR PARSE THE INPUT DEF *+5 DEF BUF10 PARSE BUFFER DEF EBUFF,I COMMAND STRING DEF ELNG COMMAND LENGTH DEF ECCNT CURRENT POSITION CCB ADB ECCNT STB ECCNT RESET CURRENT POSITION LDA BUF10 LDB BUF10+3 DATA TYPE SSA,RSS RBR,SLB JMP ERR NEGATIVE OR ASCII NOT ALLOWED JMP NUMIN,I * BUF10 BSS 10 * SKP SPC 1 ASCII NOP STA COMND SAVE CHARACTER ADA M58 GREATER THAN SSA,RSS "9" ? JMP ASCII,I YES, RETURN ADA .10 LESS THAN SSA,RSS "0" ? ISZ ASCII NO, BUMP RETURN ADDRESS JMP ASCII,I SPC 1 NXCHR NOP FCR1 JSB ECH FETCH NEXT COMMAND CHAR. JMP NXCHR,I NO MORE CHARS.? RETURN CPA B40 IGNORE ALL JMP FCR1 SPACES CPA B54 IF EITHER A JMP NXCHR,I COMMA OR CPA ":" A COLON IS JMP NXCHR,I v FOUND, RETURN ISZ NXCHR BUMP RETURN ADDRESS JMP NXCHR,I SPC 1 ":" OCT 72 COUNT NOP MATCH NOP ALSO NUM1 NOP ALSO NUM10 NOP ALSO UNCON NOP * * * CXT NOP THIS ROUTINE DOES ALL THE CLA MATCHING IN THE SOURCE BUFFER STA OCCNT AND REPLACEMENT IN THE STA XCCNT DESTINATION BUFFER FOR STA YCCNT EXCHANGE OPERATIONS. STA SCCNT LDB UNCON SZB JMP CXTUC STA BWIND RESET WINDOW BIAS STA MATCH AND MATCH FLAG. LDA WIND1 START SEARCH AT CXT1 STA SCCNT BEGINNING OF WINDOW CMA,INA IF BEYOND ADA SLNG END OF SSA RECORD JMP CXT,I RETURN CP1 JSB SCH FETCH NEXT SOURCE CHAR. JMP CXT,I END OF SOURCE, RETURN CPA FCHAR EQUAL TO 1ST CHAR. OF PATTERN? RSS JMP CP1 NO, GO LOOK AT NEXT CHAR. LDA SCCNT YES, SAVE PRESENT STA SCCN$ SOURCE POSITION ADA BWIND BEYOND ADA WIND2 UPPER BOUND CMA,SSA,INA,SZA OF WINDOW? JMP CXT,I YES, PATTERN NOT FOUND CLA,INA STA XCCNT START XCH WITH 2ND CHAR. SPC 1 CPNXT JSB XCH FETCH NEXT PATTERN CHAR. JMP XFND END OF PATTERN - MATCH!!! STA T1 SAVE PATTERN CHAR. JSB SCH FETCH NEXT SOURCE CHAR. JMP CXT,I END OF SOURCE, NO MATCH CPA T1 CHARACTER MATCH? JMP CPNXT YES, CONTINUE COMPARE LDA SCCN$ NO, BACK UP AND JMP CXT1 CONTINUE SEARCH SPC 1 XFND LDA XLIST SET LIST STA MATCH FLAG LDA SCCNT SAVE CURRENT STA T1 POSITION IN SOURCE CLA RESET STA SCCNT SOURCE CHARACTER COUNTER STA OCCNT OUTPUT CHARACTER COUNTER STA YCCNT REPLACE CHARACTER COUNTER k SPC 1 LDA SCCN$ MOVE CMA,INA CHARACTERS INA,SZA,RSS PRECEEDING JMP RPC2 STA T2 MATCH RPC1 JSB SCH CHARACTERS HLT 77B IN JSB OUTCR SOURCE ISZ T2 LINE JMP RPC1 TO OUTPUT SPC 1 RPC2 JSB YCH MOVE JMP RPC3 REPLACEMENT CHARACTERS JSB OUTCR TO OUTPUT JMP RPC2 SPC 1 RPC3 LDA OCCNT SAVE POSITION STA T2 FOR CONTINUATION OF SEARCH SPC 1 LDA T1 RESET SOURCE CHAR. POINTER STA SCCNT TO REMAINDER OF SOURCE RECORD CPA SLNG IF AT END OF JMP ENDCX RECORD, SEARCH FINISHED RPC4 JSB SCH MOVE REMAINDER JMP ENDRP OF SOURCE LINE JSB OUTCR TO OUTPUT JMP RPC4 SPC 1 ENDRP JSB ./R$ REPLACE OLD SOURCE LINE LDA YLNG COMPUTE CMA,INA BIAS FOR ADA XLNG UPPER BOUND ADA BWIND OF WINDOW STA BWIND LDA T2 RESTORE POSITION AND JMP CXT1 CONTINUE SEARCH SPC 1 ENDCX JSB ./R$ REPLACE LINE JMP CXT,I AND RETURN SPC 1 * CODE FOR UNCONDITIONAL REPLACE. SPC 1 CXTUC LDA XLIST TO LIST OR NOT STA MATCH TO LIST? LDA WIND1 CMA,INA,SZA,RSS JMP CXTU2 STA ASCII CXTU1 JSB SCH MOVE SOURCE CHARACTERS LDA B40 PRECEEDING WINDOW JSB OUTCR TO OUTPUT. ISZ ASCII JMP CXTU1 CXTU2 JSB XCH PASS OVER DUMMY SEARCH JMP CXTU3 PATTERN. JSB SCH NOP JMP CXTU2 SPC 1 CXTU3 JSB YCH MOVE REPLACEMENT CHARACTERS JMP CXTU4 TO OUTPUT. JSB OUTCR JMP CXTU3 SPC 1 CXTU4 JSB SCH MOVE REMAINDER OF RECORD JMP ENDCX TO OUTPUT JSB OUTCR JMP CXTU4 SPC 1 SCCN$ NOP BWIND NOP FCc(HAR NOP XCCNT NOP YCCNT NOP XLNG NOP YLNG NOP YOFFS NOP * * "XCH" FETCHES NEXT CHARACTER FROM SEARCH PATTERN XCH NOP LDA XCCNT CPA XLNG JMP XCH,I ISZ XCCNT ISZ XCH INA WATCH OUT FOR THIS ONE CLE,ERA ADA XYBUF LDA A,I SEZ,RSS ALF,ALF AND LBYTE JMP XCH,I * * "YCH" FETCHES NEXT CHARACTER FROM REPLACEMENT PATTERN YCH NOP LDA YCCNT CPA YLNG JMP YCH,I ISZ YCCNT ISZ YCH ADA YOFFS CLE,ERA ADA XYBUF LDA A,I SEZ,RSS ALF,ALF AND LBYTE JMP YCH,I * * "OUTCR" OUTPUTS ONE CHARACTER TO TBUFF OUTCR NOP LDB OCCNT CPB MAXOP JMP OUTCR,I CLE,ERB ADB TBUFF SEZ,RSS ALF,SLA,ALF XOR B,I XOR B40 STA B,I ISZ OCCNT JMP OUTCR,I * DLMTR OCT 57 DEFAULT DELIMITER IS "/" .6400 OCT 6400 * DLMST STA DLMTR IOR .6400 SET UP PROMPT STA / CHARACTER JMP NODE1 * * ./U CLA ./V CCB,RSS ./Z CLA IF "Z" RESET LIST FLAG ./X STA XLIST IF "X" OR "Y" SET FLAG STB UNCON JSB ECH FETCH 1ST PATTERN CHARACTER JMP XSET1 NO MORE CHARACTERS SO SET EXFLG LDB ECCNT LAST CHARACTER CPB ELNG IN COMMAND? JMP DLMST YES, GO CHANGE DELIMITER CLB STB XLNG INITIALIZE PATTERN LENGTH CNTR CPA DLMTR IF NULL PATTERN CHARACTER JMP ERX CHECK FOR ERROR STA FCHAR SAVE 1ST CHAR. IN PATTERN XSET2 JSB ECH FETCH NEXT CHARACTER JMP ERR NO DELIMITERS FOUND, SO ERROR ISZ XLNG INCREMENT PATTERN LENGTH CPA DLMTR DELIMITER? CLA,RSS JMP XSET2 NO, CONTINUE TO SEARCH XSET4 LDA XLNG STORE POSITION ADA .2 OF REPLACEMENT STA YOFFS PATTERN CMA,INA COMPUTE AND ADA ELNG STORE REPLACEMENT STA YLNG PATTERN LENGTH LDA EBUFF SWAP LDB XYBUF EBUFF STB EBUFF AND STA XYBUF XYBUF XSET1 CLA,INA SET EXCHANGE FLAG STA EXFLG LDB COMND LOAD COMMAND CHARACTER CPB "G" PENDING LINE EXCHANGE? JMP ./G YES - GO DO IT CPB "Y" IF "Y" COMMAND RSS PERFORM SEARCH JMP NODE2 ELSE, FETCH NEXT COMMAND JSB TR MOVE PENDING LINE SPC 1 * PRECEDE "X" PATTERN BY INDEFINITE CHARACTER AND USE AS "F" * PATTERN CLA RESET STA XCCNT XCH AND STA OCCNT OUTCR CHARACTER COUNTERS STA EXFLG AND EXCHANGE FLAG LDA DLMTR MAKE INDEFINITE CHAR. 1ST IN PATTERN XSET3 JSB OUTCR OUTPUT CHARACTER JSB XCH FETCH NEXT PATTERN CHARACTER RSS NO MORE CHARACTERS JMP XSET3 GO TO ADD CHAR. TO PATTERN JSB SWPET SWAP OUTPUT BUFF WITH COMND BUFF JMP COMP2 GO TO SEARCH ROUTINE SPC 1 ERX LDB UNCON NULL PATTERN IS OK FOR A U SZB,RSS OR V OPERATION. JMP ERR BUT AN INPUT ERROR FOR X,Y,Z. JMP XSET4 * ./G JSB CXT PERFORM EXCHANGE JMP DISPL THEN DISPLAY LINE XYBUF DEF XYBF0 CHANGES. POINTS TO CURRENT EXCHANGE * BUFFER. TBUFF DEF NBUF0 CHANGES POINTS TO CURRENT CONSOLE * OUTPUT BUFFER. XLIST NOP * SKP O/PSB NOP 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 SL NG IF RECORD HAS BEEN REDUCED SZA,RSS TO ZERO LENGTH, DON'T JMP O/PSB,I OUTPUT TO DEST. OPSB2 LDA SLNG GET CURRENT # OF CHARS. LDB SBUFP AND LOCATION OF SOURCE LINE JSB DOUTP CALL OUTPUT ROUTINE JMP O/PSB,I * * O/PEB LDA SLNG IF NOT AT SSA,RSS EOF THEN JSB O/PSB OUTPUT CURRENT LINE JSB TAB TAB COMMAND LINE ./R JSB ./R$ PERFORM REPLACEMENT ISZ COMND IF P COMMAND SKIP JMP NODE1 GET NEXT COMMAND ISZ CFLG IF C COMMAND SKIP JMP DISPL GO DISPLAY THE NEW LINE CCA SET LIST COUNT TO STA COUNT ONE LINE. JMP ./CC GO FINISH THE C COMMAND * * ./R$ REPLACES CURRENT LINE ON INPUT BUFFER WITH LINE IN COMMAND BUFFER ./R$ NOP LDA SLNG IF AT EOF SSA INSERT NEW LINE BEFORE LDA M2 EOF AND MAKE IT PENDING SLA,ARS COMPUTE ADDRESS INA OF NEXT ADA SBUFP SOURCE RECORD LDB OCCNT REPLACE CURRENT RECORD LENGTH STB SLNG WITH COMMAND RECORD LENGTH CMB,INB CONVERT # CHARS TO BRS MINUS # OF WORDS STB CNT1 STORE COMPLEMENT IN COUNTER ADA B ADD -(# OF WORDS) TO NEXT RECORD ADRS STA SBUFP TO GET NEW SOURCE FILE POINTER SZB,RSS ZERO LENGTH RECORD? JMP ./R$,I RETURN STA P1 LDB TBUFF STARTING ADDRESS OF COMMAND RECORD CTOS LDA B,I MOVE STA P1,I COMMAND INB RECORD ISZ P1 TO ISZ CNT1 SOURCE JMP CTOS FILE JMP ./R$,I SPC 1 ./I LDA OCCNT LOAD RECORD LENGTH LDB TBUFF LOAD RECORD LOCATION JSB DOUTP OUTPUT RECORD JMP NODE1 * * * ./Q ALLOWS USE OF 264X TERMINAL EDIT INTRINSICS TO REPLACE PENDING * LINE. * ./Q LDA DVTYX TEST FORg DRIVER TYPE 07B CPA DVR07 RSS YES, GO ON JMP ERR NO, ERROR JSB LSTSB LIST THE PENDING LINE LDA SLNG CHECK FOR LINE>77 CH. CMA,INA ADA .77 SSA JMP ./Q1 YES, MOVE CURSOR UP TWO LINES JSB PRINT POSITION CURSOR DEF ./Q2 AND SET LEFT DEC -9 DELIMITER FOR INTRINSIC EDITING. OCT 015520 < P > OCT 015501 < A > OCT 020033 < > OCT 057435 <137> OCT 057400 <137> * ./Q1 JSB PRINT SAME AS ABOVE BUT UP TWO DEF ./Q2 DEC -11 OCT 015520 < P > OCT 015501 < A > OCT 015501 < A > OCT 020033 < > OCT 057435 <137> OCT 057400 <137> * ./Q2 LDA NOPRN SAVE NON-PRINTING FLAG STA SCH TEMORARALY CCA SET CONDITIONS FOR INPUT ONLY, STA NOPRN OF THE MODIFIED LINE. STA COMND SET FOR DISPLAY OF THE MODIFIED LINE. JSB TTYIP REQUEST INPUT SZB,RSS JMP ZER ZERO LTH. READ JSB TAB LDA SCH RESTORE NON-PRINTING FLAG. STA NOPRN JSB PRINT MAKE SURE INSERT IS OFF. DEF ./Q3 DEC -3 ASC 2,R_ ./Q3 JMP ./R COMPLETE THE REPLACEMENT OPERATION. ZER CLA RESET COMMAND STA COMND LDA SCH RESTORE NON-PRINTING FLAG STA NOPRN JMP NODE1 * .77 DEC 77 * * * * SCH FETCHES NEXT SOURCE CHARACTER * SCH NOP ENTER WITH CHARACTER COUNT LDA SCCNT SCCNT AND SOURCE BUFFER START CPA SLNG ADDRESS IN SBUFP. JMP SCH,I ISZ SCCNT IF AT END OF SOURCE RECORD, ISZ SCH EXIT TO P+1. CLE,ERA ADA SBUFP IF NOT AT END OF SOURCE RECORD, LDA A,I EXIT TO P+2 WITH ASCII OF NEXT SEZ,RSS CHARACTER IN LOW BB@. STA MCH SAVE, TEMPORARILY. ADA N141 CHECK FOR LOWER-CASE ASCII. SSA JMP LCXIT NO. NOT LOWER-CASE. ADA N32 SSA,RSS JMP LCXIT NO. RETURN. LDA B40 YES. CONVERT TO XOR MCH UPPER-CASE ALPHA ASCII, JMP LCASE,I AND RETURN WITH =CHARACTER. LCXIT LDA MCH RETRIEVE THE ORIGINAL CHARACTER, JMP LCASE,I AND RETURN. * * / OCT 6457,3537 "CR / BELL _" SPC 1 ./CG EQU * IFZ JSB REMCK IF COMMUNICATING REMOTELY, THEN JMP NODE1 PROMPT CHANGE IS INAPPROPRIATE. XIF LDA /+1 ALF,ALF STA /+1 REVERSE ORDER OF _ AND BELL. CLA,INA XOR LN SHORTEN OR LENGTHEN STA LN MESSAGE LENGTH. JMP NODE1 TB SKP TTYIP NOP IFZ JSB REMCK TALKING REMOTELY? JMP DOCOM YES! XIF LDA NOPRN IF INPUT IS SZA NON-INTERACTIVE, THEN JMP TTYIN IGNORE THE PROMPT. JSB EXEC PRINT DEF *+5 PROMPT DEF .2.I CHARACTER DEF TTYLU DEF / DEF LN ALTERNATE -4 & -3. JMP EXIT SPC 1 TTYIN JSB REIO INPUT DEF *+5 COMMAND DEF .1.I FROM DEF TTYLU TELETYPE EBUFF DEF EBUF0 CHANGES, POINTS TO CURRENT COMMAND DEF MAXIN JMP EXIT ILLEGAL DEVICE, QUIT * EBRET STB ELNG CLA RESET STA ECCNT ALL STA SCCNT CHARACTER STA OCCNT COUNTERS JMP TTYIP,I IFZ DOCOM CLA PREPARE FOR NON-INTERACTIVE INPUT. CPA NOPRN IF DEVICE IS INTERACTIVE, THEN LDA LN GET THE PROMPT LENGTH. STA PRMTL INITIALIZE PROMPT LENGTH. SZA CHECK FOR A ZERO LTH. JMP INWR NO, GO ON LDA INLU YES, REMOVE INTERACTIVE BIT XOR BIT11 STA INLU INWR JSB DEXEC DO INTERACTIVE REMOTE READ DEF *+8 DEF NODE DEF RCODE DEF INLU DEF EBUFF,I DEF MAXIN DEF / OPT.PARAMS=PROMPT CHARS DEF PRMTL AND PROMPT LENGTH. JMP ./A0 ABORTIVE COMM. ERROR LDA INLU MAKE SURE INTERATIVE BIT IS SET IOR BIT11 STA INLU JMP EBRET * * RETURN+1 IF CRT IS REMOTE, RETURN+2 IF NOT REMCK NOP LDB NODE CPB M1 ISZ REMCK JMP REMCK,I XIF CFLG NOP ALSO SBUFP NOP POINT TO CURRENT LOC IN SORC BUFFER SLNG NOP LENGTH OF SOURCE RECORD (EVEN) ELNG NOP LBYTE OCT 377 LOWER BYTE MASK LN OCT -4 ALTERN. WITH -3 AFTER CONTROL G. NOPRN NOP SUPPRESS PRINTING IF #0. SCCNkT NOP .10K DEC 10000 .1000 DEC 1000 .100 DEC 100 IFZ PRMTL NOP INTERACTIVE PROMPT LENGTH. RPRMT OCT 6412,27537 REMOTE PROMPT: "CR LF / _" BIT11 OCT 4000 INLU NOP NODE NOP INTFL NOP INTERACTIVE WRITE-READ FLAG. WRLEN NOP WRITE LENGTH (-CHARS) FOR WRITE-READ. TEMPZ EQU REMCK TEMPORARY. SVTMP NOP TEMPORARY STORAGE FOR NOP OVERLAYED WORDS. * * INTERACTIVE REMOTE WRITE-READ ROUTINE: DISPLAY LINE & READ COMMAND. * INTER NOP STA BUFAD CONFIGURE WRITE-BUFFER ADDRESS IN CALL. STB WRLEN SAVE NEG. CHAR. COUNT, TEMPORARILY. BRS COMPUTE BUFFER LENGTH CMB,INB IN WORDS. ADA B FORM ADDRESS OF NEXT WORD, STA TEMPZ IMMEDIATELY FOLLOWING WRITE BUFFER. DLD TEMPZ,I GET NEXT TWO WORDS-AFTER BUFFER- DST SVTMP AND SAVE, TEMPORARILY. DLD RPRMT OVERLAY TWO WORDS FOLLOWING WRITE BUFFER DST TEMPZ,I WITH THE COMMAND-INPUT PROMPT CHARS. LDB WRLEN GET THE ORIGINAL NEG. CHARACTER COUNT. SLB IF THE COUNT WAS ODD, ADB M1 ADD ONE FOR THE WORD BOUNDRY. ADB LN ADD THE LENGTH OF PROMPT (-CHARS), STB WRLEN AND CONFIGURE CALL WITH TOTAL LENGTH. * JSB DEXEC CALL REMOTE 'EXEC' ROUTINE. DEF ERABT ERROR-RETURN ADDRESS. DEF NODE DESTINATION NODE. DEF RCODE READ REQUEST--NO ABORT. DEF INLU REMOTE TTY LU W/INTERACTIVE BIT(#11). DEF EBUFF,I INPUT BUFFER ADDRESS. DEF MAXIN MAXIMUM NO. OF INPUT CHARACTERS. BUFAD DEF * CONFIGURED WRITE BUFFER ADDRESS. DEF WRLEN CONFIGURED WRITE BUFFER LENGTH. ERABT JMP ./A0 ** COMMUNICATION ERROR: ABORT!! * STB ELNG SAVE READ LENGTH (+CHARS). DLD SVTMP RESTORE THE DST TEMPZ,I OVERLAYED BUFFER CHARACTERS. CLA RESET STA ECCNT ALL STA SCCNT  CHARACTER STA OCCNT COUNTERS. LDB ELNG RESTORE = TRANSMISSION LOG. JMP INTER,I RETURN. XIF SKP ./N JSB ECH ANY OTHER CHARACTER? JMP NP NO. PRINT SOURCE LINE. JSB LCASE CONVERT LOWER CASE CHAR.--IF NECESSARY. CPA "D" IF N IS FOLLOWED BY D, RSS PRINT DESTINATION LINE. JMP ERR ELSE ASK AGAIN. DLD T#REC JMP CVX NP DLD LINES FETCH CURRENT LINE NUMBER CVX JSB DEC CONVERT NUMBER TO ASCII IFZ JSB REMCK IF COMMUNICATING REMOTELY, ISZ INTFL SET THE INTERACTIVE FLAG. XIF LDB OCCNT CALL LDA TBUFF PRINT JSB LST ROUTINE JMP NODE1 PROCESS THE NEXT COMMAND SPC 1 ./H JSB ECH JMP HP JSB LCASE CPA "L" RSS JMP ERR JSB PRINT DEF NODE1 DEC 41 ASC 21, ''''/''''1''''/''''2''''/''''3''''/''''4 ASC 20,''''/''''5''''/''''6''''/''''7''''/''''8 HP LDA SLNG CLB JMP CVX SPC 1 ./S CLB LDA T#SEC COMPUTE NUMBER OF WORDS ASL 7 ALREADY STORED ON DISC, STA DEC SAVE, THEN COMPUTE LDA DBUF$ # OF WORDS IN DEST CMA,INA BUFFER. ADA DBUFP CLE ADA DEC ADD BACK LSB'S OF MPY SEZ AND BUMP B IF E SET. INB JMP CVX SPC 1 DEC NOP CLE,SZB,RSS >65K? JMP SNGLP DIV .10K WORK ON EXCESS FIRST STB I/PSB SAVE REMAINDER FOR NEXT PASS. CLB JSB DEC4 LDA I/PSB CCE SKIP DIV .10K THIS TIME SNGLP JSB DEC4 JMP DEC,I SPC 1 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 COiNVT 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 CONVT NOP STB NT SAVE REMAINDER SZA IF JMP CONV1 LEADING CPA OCCNT ZERO JMP CONV2 DO NOT OUTPUT IT CONV1 IOR B60 CONVERT NUMBER TO ASCII JSB OUTCR MOVE CHARACTER TO BUFFER CONV2 CLB SET REGISTERS UP LDA NT FOR NEXT DIVIDE JMP CONVT,I * * I/PSB FETCHES NEXT RECORD FROM SOURCE BUFFER * RETURNS WITH AN EOF FLAG, I.E. B=-1 EOF FOUND, B=0 NO EOF I/PSB NOP JSB DINP CLB STB NOLSF RESET LS FLAG. LDB SLNG LOAD RECORD LENGTH SSB IF LENGTH < 0, RETURN WITH JMP I/PSB,I EOF FLAG SET IN REGISTER CLB CLEAR EOF FLAG STB SCCNT RESET SOURCE CHARACTER CNTR JMP I/PSB,I * DISPL CLB RESET STB EXFLG EXCHANGE FLAG LDA TTYLU AND THE STA LSTLU LIST LU IFZ JSB REMCK IF COMMUNICATING REMOTELY, ISZ INTFL SET THE INTERACTIVE FLAG. XIF JSB LSTSB LIST CURRENT LINE JMP NODE1 PROCESS THE NEXT COMMAND. SPC 1 ./O LDA SLNG SSA JMP ERR END OF FILE JSB O/PSB OUTPUT PENDING LINE, THEN LDA DVTYX IF DRIVER TYPE IS 07B GO TO "Q". CPA DVR07 COMMAND. JMP ./Q RSS OTHERWISE USE THE P COMMAND. SPC 2 ./C STB CFLG SET THE "C"FLAG TO -1. * ./P LDA DLMTR USE DLMTR FOR TAB STA TBFIL JSB TAB TAB THE LINE LDA SLNG IF AT EOF SSA PRINT EOF AND GET JMP ERR NEXT COMMAND. JSB SWPET SET UP INPUT BUFFER CCA SET LIST FLAG STA COMND FOR ./R MODE STB PMODE INITIAL MODE IS REPL~ACE PNXT JSB ECH GET A CHARACTER JMP PFIN IF EOL THEN EXIT CLB SET B FOR MODE CHECK CPA %R CONTROL R? JMP MODE YES GO RESET MODE INB INSERT MODE? CPA %I JMP MODE YES GO RESET CPA %S ALTERNATE COMMAND JMP MODE INB SET FOR DELETE MODE CPA %C DELETE MODE? JMP MODE YES GO RESET CPA %T TRUNCATE LINE MODE? JMP ./R YES GO WRAP UP LDB PMODE GET THE CURRENT MODE CPB ZERO IF REPLACE JMP PRPL GO REPLACE CPB .1 IF INSERT JMP PINS GO INSERT CPB .2 IF DELETE JMP PDLS GO DELETE SPC 2 PRPL CPA DLMTR IS IT REALLY COPY JMP PCOPY YES GO COPY JSB OUTCR OUTPUT THE NEW CHARACTER SPC 1 PDLS JSB SCH GET THE OLD CHARACTER NOP IGNOR EOL JMP PNXT BURN THE OLD AND GO GET THE NEXT SPC 1 PCOPY JSB SCH GET THE CURRENT CHARACTER LDA B40 USE BLANK IF UNDEFINED JMP PINS2 SPC 1 PINS CPA DLMTR INSERT SPACES FOR LDA B40 DELIMITER PINS2 JSB OUTCR SEND IT OUT JMP PNXT GO PROCESS THE NEXT CHAR. SPC 1 PFIN JSB SCH MOVE THE REST JMP ./R OF THE LINE JSB OUTCR TO THE OUTPUT JMP PFIN BUFFER SPC 1 %R OCT 22 CONTROL R %I OCT 11 CONTROL I %C OCT 3 CONTROL C %S OCT 23 CONTROL S %T OCT 24 CONTROL T PMODE NOP * * SPSP ASC 1, MSPSP DEF SPSP * LST NOP STA CONVT SAVE TEMPORARILY. CLA PREPARE FOR NON-INTERACTIVE DEVICE. CPA NOPRN IF DEVICE IS INTERACTIVE, JMP LST0 THEN PROCEED TO LIST THE LINE. IFZ STA INTFL CLEAR COMMAND-READ INDICATOR. XIF JMP LST,I NON-INTERACTIVE: RETURN IMFMEDIATELY. * LST0 LDA CONVT RETRIEVE . CMB,INB,SZB COMPLEMENT CHARACTER COUNT JMP LST1 CONTINUE IF NOT ZERO LDA MSPSP OTHERWISE OUTPUT SPACES LDB M2 LST1 ADB M2 ADD TWO TO THE CHAR. COUNT STB LSTB2 AND SET IT CCB SUBTRACT ONE ADB A FROM THE BUFFER ADDRESS STB LSTB1 AND SET IT LDA B,I GET THE CURRENT CHAR. STA LSTB3 SAVE IT LDA SPSP NOW SET STA B,I THE FIRST CHARS. TO BLANKS IFZ LDA INTFL IF THE INTERACTIVE SZA FLAG IS SET, JMP LSINT GO SET UP FOR WRITE-READ. XIF SPC 1 JSB DEXEC ***************** DEF LSRTN IFZ DEF NODE XIF DEF .2.I LIST DEF LSTLU RECORD LSTB1 NOP DEF LSTB2 LSRTN JMP ERR LIST ABORT RETURN, GIVE "??" IFZ JMP LSTEX BYPASS WRITE-READ SET UP. SPC 1 LSINT LDA LSTB1 GET BUFFER ADDRESS. LDB LSTB2 GET BUFFER CHARACTER COUNT. JSB INTER WRITE BUFFER & READ COMMAND. XIF LSTEX LDA LSTB3 RESTORE THE STA LSTB1,I OLD WORD. JMP LST,I SPC 1 LSTB2 NOP LSTB3 NOP SPC 1 LSTSB NOP USED AS TEMP LDA SBUFP FETCH RECORD LENGTH LDB SLNG AND LOCATION SSB IF AT EOF JMP EOFPR GO PRINT "EOF" JSB LST PERFORM LIST JMP LSTSB,I * STRK# NOP SOURCE TRACK # SRCLU NOP SOURCE DISK LU NWTRK NOP RETURN OF TRACK FROM DISC ALLOC REQ. DTRK# NOP DESTINATION TRACK # NEWLU NOP RETURN OF LU FROM DISK ALLOC REQ. DSTLU NOP DESTINATION LU DSEC# NOP DESTINATION SECTOR # SSEC# NOP SOURCE SECTOR # .4 OCT 4 RCODE OCT 100001 * * RQST REQUESTS A TRACK FROM SYSTEM RQST NOP LDA RCODE ONE TRACK REQUEST STA RQST!C CODE WITH UNAVAIL. RETURN SPC 1 RQ.TR JSB EXEC ********************************* DEF *+6 DEF .4 REQUEST DEF RQSTC TRACK DEF NWTRK FROM DEF NEWLU SYSTEM DEF DSCTR ************************************ SPC 1 LDA DSCTR RAR CONVERT TO 128 WORD SECTORS STA DSCTR LDA NWTRK WAS THE REQUEST SSA,RSS HONORED? ISZ #TCNT YES, ADD 1 TO OUTSTANDING TRACK COUNT. SSA,RSS WAS A TRACK ALLOCATED? JMP RQST,I YES - RETURN CLA,INA NO - PRINT MESSAGE STA RQSTC AND REQUEST JSB PRINT TRACK WITH DEF RQ.TR SUSPENSION IF DEC 12 UNAVAILABLE. NAME2 ASC 12,EDITR WAITING FOR TRACKS * #TCNT NOP CURRENT # TRACKS OBTAINED FROM SYSTEM. * SETSO NOP SET UP THE SOURCE ROUTINE LDA LSLUT LOAD LS LU AND TRACK LDB .2 ASSUME LU 2 CLE,ELA SHIFT LU FLAG INTO E ALF,ALF MOVE TRACK TO LOWER BYTE STA STRK# STORE SOURCE TRACK # CLA,SEZ LU = 3 ? INB YES, INCREMENT LU STB SRCLU STORE SOURCE LU # STA #TRAK ZERO THE TRACK-RELEASE COUNT. STA SSEC# RESET SOURCE SECTOR NUMBER CCA INITIALIZE THE STA SNTRF NEW-TRACK FLAG =-1 JMP SETSO,I RETURN SPC 1 * ALCAT SETS SOURCE TRACK AND LU AND REQUESTS A DESTINATION * TRACK FROM SYSTEM. * ALCAT NOP JSB SETSO SET UP THE SOURCE JSB RQST REQUEST TRACK FROM SYSTEM LDA NWTRK STORE NEW STA DTRK# TRACK NUMBER LDB NEWLU STORE STB DSTLU NEW LU ALF,CLE,ALF MOVE TRACK # TO UPPER BYTE SLB LU = 3 ? CCE YES, SET E BIT ERA SHIFT E INTO DESTINATION FILE STA DSTRT LU AND TRACK WORD "t CLA RESET STA DSEC# DEST. SECTOR POINTER AND STA T#SEC TOTAL # OF DEST. SECTORS AND STA T#REC TOTAL # OF DEST. RECORDS JMP ALCAT,I * P1 NOP P2 NOP DSTRT NOP * EOFND STB SLNG JMP DINP,I * DINP NOP LDA SLNG FETCH RECORD LENGTH SSA,INA AT EOF? JMP DINP,I YES, RETURN ISZ LINES BUMP SOURCE LINE COUNTER JMP *+2 ALLOWING HUGE NUMBER ISZ LINEM (DOUBLE WORD). ARS COMPUTE ADDRESS ADA SBUFP OF NEXT RECORD CPA SBEND IF AT END OF BUFFER JMP DINP3 GO TO INPUT FROM DISC LDB A,I LOAD RECORD LENGTH OF NEXT RECORD INA STORE ADDRESS OF NEXT STA SBUFP RECORD IN INPUT BUFFER SSB IF RECORD LENGTH < 0, JMP EOFND THEN GO TO EOF FOUND BLF,BLF CONVERT BLR TO # OF STB SLNG CHARACTERS AND SAVE ADB MAXIN IF RECORD GREATER CMB,SSB,INB,SZB THAN MAX. LENGTH JMP $$$ER GIVE CORRUPT FILE ERROR LDB SLNG FETCH RECORD BRS LENGTH IN WORDS ADB A IF RECORD IS CMB,INB CONTAINED IN ADB SBEND INPUT BUFFER SSB,RSS THEN JMP DINP,I RETURN LDB SLNG FETCH RECORD LENGTH BRS IN WORDS CMB,INB COMPLEMENT FOR LOOP COUNTER STA P1 SET UP ADA MWDC1 POINTERS STA P2 FOR STA SBUFP RECORD MOVE LDA P1 GET SOURCE BEGIN ADDR CMA,INA NEGATE WITH REC SIZE ADA B TO COMPUTE NUMBER INA OF WORDS WHICH ARE ADA LWA PAST LWA SSA,RSS JMP DINP0 NONE, SO (B) IS SIZE CMA,INA ADB A NEG WDS PAST, SUBTR FROM (B) DINP0 SZB,RSS JMP DINP2 GO READ DISC IF 0 TO MOVE SPC 1 U DINP1 LDA P1,I MOVE STA P2,I RECORD ISZ P1 RESIDUE ISZ P2 IN FRONT OF INB,SZB INPUT BUFFER JMP DINP1 DINP2 JSB MIN READ BUFFER FROM DISC JMP DINP,I DINP3 JSB SQ JMP DINP,I * SQ NOP JSB MIN FILL INPUT BUFFER FROM DISC LDA SBUF$,I FETCH RECORD LENGTH LDB SBUF$ COMPUTE START OF INB RECORD ADDRESS STB SBUFP AND SAVE ALF,ALF CONVERT RECORD LENGTH SSA,RSS ALS WORD TO NUMBER STA SLNG OF CHARACTERS AND SAVE SSA,RSS IF EOF SKIP ADA MAXIN IF RECORD LENGTH GREATER CMA,SSA,INA,SZA THAN MAX ALLOWED JMP $$$ER GIVE CORRUPT FILE ERROR JMP SQ,I * DSCTR NOP DESTINATION SECTORS PER TRACK DNTRF NOP DEST. FILE NEW TRACK FLAG SNTRF NOP SOURCE FILE NEW TRACK FLAG .5 OCT 5 SEC# NOP WDCNT NOP * * * MIN MOVES SOURCE FILE INTO CORE MIN NOP LDA SNTRF READ FROM NEW SSA SOURCE TRACK? ISZ #TRAK YES, BUMP RELEASE TRACK COUNT CLA RESET STA SNTRF NEW TRACK FLAG LDA SSEC# GET NEXT SECTOR POINTER ADA SCT ADD BUFFER SECTOR SIZE RAL CONVERT TO 64 WORD SECTORS CMA LDB SRCLU GET READ LU STB SVSLU SAVE SOURCE LU FOR MERGES. SLB,RSS IF LU = 2 ADA SECT2 USE #SEC FOR LU2 SLB ELSE LU 3 ADA SECT3 WOULD READ CROSS SSA,RSS TRACK BOUNDARY? JMP RDISC NO, GO TO READ RAR CONVERT BACK TO 128 WORD SECTORS CCB SET STB SNTRF NEW TRACK FLAG ADA SCT READ TO END OF CURRENT INA,RSS TRACK, SKIP NEXT INSTRUCTION SPC 1 RDISC LDA SCT LOAD NUMBER OF SECTORS ASL 7 CONVERT SECTORS TO WORDS STA WDYCNT STA SVSWC SAVE THE WORD COUNT CMA,INA STORE STA MWDC1 -(WORD COUNT) LDA STRK# STA SVSTR SAVE SOURCE TRACK FOR MERGES. LDA SSEC# RAL CONVERT TO 64 WORD SECTORS STA SVSSC AND SAVE SPC 1 JSB EXEC ************************** DEF *+7 DEF .1 READ DEF SRCLU THE DEF SBUF$,I DISC DEF WDCNT DEF STRK# DEF SVSSC *************************** SPC 1 LDA WDCNT STORE END ADA SBUF$ OF DATA ADDRESS STA SBEND IN SBEND LDA SNTRF SSA NEW TRACK? JMP NTRAK YES, GO TO NEW TRACK PROCESSING LDA SSEC# MOVE ADA SCT SOURCE SECTOR STA SSEC# POINTER JMP MIN,I NTRAK CLA RESET SOURCE STA SSEC# SECTOR POINTER CPA RELS IF RELEASE FLAG IS ZERO JSB RELSR RELEASE SOURCE TRACK CCA MOVE BUFFER END POINTER ADA SBEND SO CODE WORD IS NOT STA SBEND INCLUDED IN SOURCE ISZ MWDC1 INCREMENT -(WORD COUNT) LDA SBEND,I GET CODE WORD AND LBYTE (LAST WORD ON TRACK) STA STRK# AND SET TRACK XOR SBEND,I AND LU POINTERS ALF,ALF TO NEXT TRACK STA SRCLU IN SOURCE JMP MIN,I * * RELSR RELEASES SOURCE TRACK RELSR NOP LDB SRCLU LDA TAT GET TRACK ASSIGNMENT TABLE ADRS CPB .3 LU = 3? ADA TATSD YES, ADD SYSTEM TRACKS TO ADRS ADA STRK# ADD TRACK TO BE RELEASED LDA A,I DOES THIS CPA XIDT "EDITR" RSS OWN TRACK JMP RELSR,I NO, RETURN JSB EXEC YES, RELEASE TRACK DEF *+5 DEF .5 DEF .1 DEF STRK# DEF SRCLU * LDA #TCNT GET OUTSTANDING TRACK COUNT. SZA IF NON-ZERO,  ADA M1 SUBTRACT THE ONE JUST RELEASED, STA #TCNT AND UPDATE THE COUNT. JMP RELSR,I RETURN. * .3 OCT 3 SVSSC NOP SVSLU NOP SVSWC NOP SVSTR NOP SKP DOUTP NOP CMA TRUNCATE STA ODDF (ALWAYS -VE) ADA MAXOP OUTPUT CMA,SSA,RSS LENGTH CLA TO MAXOP. ADA MAXOP CPA MAXOP IF RECORD LENGTH=MAXOP JMP ODD? TEST FOR ODD # CHARACTERS. DOUP1 STB P1 SAVE BUFFER ADDRESS SLA,ARS CONVERT # CHARS. TO # WORDS INA ADD ONE WHEN ODD ISZ T#REC BUMP NUMBER OF RECORDS CNTR. JMP *+2 ALLOWING HUGE NUMBER ISZ T#REM (DOUBLE INTEGER) ALF,ALF MOVE WORD COUNT TO STA DBUFP,I UPPER BYTE AND STORE ALF,ALF COMPUTE LOOP CMA,INA,SZA,RSS COUNTER FOR MOVE. IF = 0 JMP DOUP5 GO TO END BUFR. TEST STA CNT1 ELSE SAVE IT. DOUP2 ISZ DBUFP BUMP DEST. BUFFER POINTER LDB DBUFP CPB DBEND END OF BUFFER? JSB DOUT YES, OUTPUT IT LDA P1,I MOVE NEXT WORD STA DBUFP,I TO OUTPUT BUFFER ISZ P1 BUMP SOURCE ADDRESS ISZ CNT1 LAST WORD IN RECORD? JMP DOUP2 NO, CONTINUE MOVE LDA ODDF IF RECORD LENGTH NOT ODD, SZA JMP DOUP5 GO AWAY NORMALLY. LDA DBUFP,I BUT WITH RECORD LENGTH ODD, AND HBYTE REPLACE THE EVEN CHARACTER IOR TBFIL BEYOND DESIRED LENGTH WITH STA DBUFP,I A BLANK. DOUP5 ISZ DBUFP BUMP DEST. BUFR PNTR. LDB DBUFP CPB DBEND IF AT END OF DEST. BUFFER JSB DOUT OUTPUT BUFFER TO DISC, JMP DOUTP,I ELSE RETURN SPC 1 ODD? SLA,RSS JMP DOUP1 EVEN. NO FIXUP NEEDED. CLA STA ODDF SET TO SHOW ODD. LDA MAXOP RESTORE FOR MORE PROCESSING. JMP DOUP1 SPC 1 HBYTHFBE OCT 177400 MASK FOR HIGH BYTE. ODDF OCT -1 0 MEANS ODD, -VE MEANS EVEN. QH SKP * DOUT WRITES THE DESTINATION BUFFER ON A SYSTEM-ASSIGNED TRACK. * WHEN THE TRACK WILL BE FILLED BY A WRITE, DOUT REQUESTS A * NEW TRACK, MERGES THE RETURNED LU AND TRACK, AND STORES THE * RESULTING CODE WORD INTO THE LAST WORD OF THE CURRENT TRACK. * THE REST OF THE DESTINATION BUFFER (IF ANY) IS THEN WRITTEN * ON THE NEW DESTINATION TRACK. SPC 2 DOUT NOP CLA RESET NEW STA DNTRF DEST. TRACK FLAG LDA SCT LOAD OF SECTRS TO BE WRITTEN LDB PBFLG PARTIAL BUFFER TO SZB BE WRITTEN? LDA B YES, A_# OF SECTORS PBTRB STA SEC# STORE NUMBER OF SECTORS OF WRITE ADA DSEC# TRACK CMA BOUNDARY ADA DSCTR CROSSED? SSA,RSS JMP WDISK NO, PERFORM WRITE STA DNTRF SET NEW TRACK FLAG ADA SEC# INA,RSS WDISK LDA SEC# LDB T#SEC ADD NUMBER ADB A OF SECTORS TO STB T#SEC TOTAL NUMBER OF SECTORS ASL 7 CONVERT SECTORS TO WORDS STA WDCNT LDA DNTRF SSA,RSS NEW TRACK? JMP ECALL NO, GO TO EXEC CALL JSB RQST REQUEST NEW TRACK FROM SYSTEM CCB GET ADDRESS ADB DBUF$ OF LAST WORD ADB WDCNT ON TRACK LDA B,I SAVE DISPLACED WORD STA TEMP IN TEMP LDA NEWLU SET UP ALF,ALF AND IOR NWTRK STORE STA B,I CODE WORD INB STORE ADDRESS OF STB RESDU BUFFER RESIDUE SPC 1 ECALL LDA DSEC# RAL CONVERT TO 64 WORD SECTORS STA T3 JSB EXEC **************************** DEF *+7 DEF .2 WRITE DESTINATION DEF DSTLU FILE BUFFER DEF DBUF$,I ON DISC DEF WDCNT DEF DTRK# DEF T3 ************************ SPC 1 LDB DBUF$ RESET DESTINATION STB DBUFP BUFFER POINTER LDA DNTRF SSA NEW TRACK? JMP NTRK LDA DSEC# COMPUTE ADA SEC# NEXT SECTOR STA DSEC# POINTER JMP DOUT,I SPC 1 NTRK LDB NEWLU STORE STB DSTLU NEW LU LDB NWTRK STORE NEW STB DTRK# TRACK NUMBER CLA RESET NEXT STA DSEC# SECTOR POINTER LDB TEMP MOVE WORD DISPLACED BY CODE STB DBUFP,I WORD TO START OF BUFFER ISZ DBUFP LDA DNTRF CMA,SZA,RSS JMP PBCHK BUFR ENDED ON TRK BOUDARY, CHECK PBFLG ASL 7 CMA,INA MVR LDB RESDU,I MOVE RESIDUE TO START OF BUFFER STB DBUFP,I ISZ RESDU ISZ DBUFP INA,SZA JMP MVR PBCHK LDA PBFLG SZA,RSS PARTIAL BUFFER? JMP DOUT,I NO,RETURN LDA DNTRF YES, OUTPUT BUFFER RESIDUE CMA,SZA,RSS COMPL. TO GET SECTR RESID., IF 0 INA INCREMENT FOR WRITE OF CODE WORD CLB STB DNTRF RESET NEW TRACK FLAG JMP PBTRB * T3 NOP RESDU NOP MWDC1 NOP DBUFP NOP POINT TO CURRENT LOC IN DEST BUFFER CNT1 NOP ALSO , T#REC NOP CURRENT # OF REC IN DEST FILE T#REM NOP MOST SIG BITS FOR >65K T#SEC NOP CURRENT # OF SCTRS IN DEST FILE B60 OCT 60 TEMP NOP #TRAK NOP TRACK-RELEASE COUNT. RELS DEC -1 ./EFL NOP PASS1 DEC -1 FIRST PASS FLAG LSTRK NOP LS#TR NOP SKP ./K JSB ./B1 RESET TO START OF FILE. ./K0 LDA SLNG RECORD LENGTH, CHARS. LDB MAXOP REQUESTED FIELD WIDTH. CMB,INB ADB A IF > OR = SPECIFIED MAX., SSB,RSS LDA MAXOP SET TO REQUEST MAX. SSA IF EOF, PRINT EOF JMP EOFPR AND GET NEXT COMMAND. SLA DON'T THROW AWAY ODD CHARACTER, INA BUMP COUNT TO EVEN. ARS ./K1 ADA M1 SZA,RSS JMP ./K2 PROCESS THIS RECORD. LDB SBUFP ADB A POINT TO NEXT CHAR. PAIR LDB B,I CPB SPSP IF THEY ARE BOTH BLANKS, JMP ./K1 CONTINUE TO SHORTEN RECORD. ./K2 INA CORRECT TO NEW # OF WORDS. ALS CONVERT TO CHARACTER COUNT. LDB SBUFP JSB DOUTP SEND RECORD TO DEST. FILE JSB DINP GET NEXT RECORD. JMP ./K0 * ./M JSB SC.CR GET THE FILE NAME JMP ERR ERROR IF NO FILE NAME JSB TR SEND THE PENDING LINE JSB INSRC FETCH THE FILE NOP IGNOR NOT FOUND ERROR SPC 1 JSB EXEC NOW GET DEF *+7 THE OLD SOURCE DEF .1 BACK IN DEF SVSLU CORE DEF SBUF$,I DEF SVSWC DEF SVSTR DEF SVSSC SPC 1 JMP DISPL * SPC 1 ./J LDA SLNG IF NOT SSA,RSS AT EOF JSB O/PSB OUTPUT PENDING LINE CLA RESET THE EXCHANGE STA EXFLG FLAG AND CLA,INA THE CURRENT STA LINES LINE NUMBER JSB SETSO SET UP THE INPUT JSB SQ READ THE FIRST BLOCK JMP COMP1 START SEARCH SPC 1 * ./B RESETS SOURCE POINTER TO BEGINNING OF FILE BY * COMPLETION OF TRANSFER OF SOURCE FILE TO DESTINATION * FILE THEN DEFINING THE DEST. FILE AS THE SOURCE FILE * ./B JSB ./B1 PERFORM TRANSFER JMP COMP1 START SEARCH SPC 1 ./B1 NOP JSB ./B$ COMPLETE TRANSFER. CLA STA EXFLG RESET EXCHANGE FLAG STA PBFLG RESET PARTIAL BUFFER FLAG CLA,INA STA LINES RESET LINE COUNTER JSB ALCAT GET NEW SOUCE AND DEST. FILE JSB SQ READ IN FIRST BLOCK JMP ./B1,I FILL INPUT BUFFER * *./B$ COMPLETES TRANSFER OF SOURCE TO DESTINATION. ./B$ NOP JSB TR TRANSFER SOURCE SS3bB,RSS TO DESTINATION JMP *-2 FILE CCA PUT END OF STA DBUFP,I FILE RECORD IN ISZ DBUFP OUTPUT BUFFER LDA DBUF$ DETERMINE CMA,INA SIZE ADA DBUFP OF BUFFER CLB CONVERT SIZE ASR 7 TO SECTORS INA ROUNDING UP FOR ANY FRACTION STA PBFLG STORE IN PARTIAL BUFR FLAG JSB DOUT OUTPUT BUFFER TO DISC LDA #TRAK GET THE # OF TRACKS LDB LSLUT AND FIRST SOURCE TRACK ISZ PASS1 FIRST PASS AT SOURCE? JMP ./B2 NO - GO RELEASE TRACKS STA LS#TR YES - SAVE TRACK COUNT RSS BUT SKIP RELEASE ./B2 JSB RELTR RELEASE OLD SOURCE TRACKS LDA DSTRT SET SOURCE FILE POINTER TO STA LSLUT START OF DEST. FILE JMP ./B$,I SPC 1 RELTR NOP CMA,INA FORM A NEGATIVE TRACK COUNT STA TEMP AND SAVE STB LSLUT STORE START TRACK CLA RELEASE THE TRACKS CPB SFCUN CCA UNLESS 'LS' TRACKS STA RELS JSB SETSO SET UP TO READ THE SOURCE TRK2 LDA SRCLU GET THE LU LDB SECT2 GET SECTOR COUNT FOR LU 2 SLA IF LU 3 LDB SECT3 USE LU 3 COUNT RBR CONVERT TO 128 WORD SECTORS ADB M1 SUBTRACT ONE SECTOR STB SSEC# SET DISC ADDRESS FOR MIN READT JSB MIN GO READ TRACK AND RELEASE IT LDA SNTRF GET THE NEW TRACK FLAG. SSA,RSS WAS A TRACK RELEASED? JMP READT NO. CONTINUE READING. ISZ TEMP DONE? JMP TRK2 NO - DO NEXT ONE CCA YES - CLEAR THE FLAG STA RELS SO NO MORE ARE RELEASED. JMP RELTR,I *EOFPR PRINTS "EOF THEN RETURNS FOR NEXT COMMAND * EOFPR CLA PREPARE FOR NON-INTERACTIVE DEVICE. CPA NOPRN IF IT'S INTERACTIVE, JMP EOFPN PROCEED TO PRINT THE MESS 5AGE. IFZ STA INTFL CLEAR REMOTE COMMAND READ INDICATOR. XIF JMP NODE1 GO TO READ THE NEXT COMMAND. EOFPN EQU * IFZ JSB REMCK IF COMMUNICATING REMOTELY, JMP REMEO PERFORM WRITE-READ. XIF JSB PRINT DEF NODE1 EOFLN DEC -4 EOFMS ASC 4,EOF IFZ EOFAD DEF EOFMS * REMEO LDA EOFAD GET BUFFER ADDRESS. LDB EOFLN GET MESSAGE LENGTH. ISZ INTFL SET THE INTERACTIVE FLAG. JSB INTER WRITE EOF MESSAGE/READ NEXT COMMAND. JMP NODE1 GO TO PROCESS THE COMMAND. XIF SPC 1 * ./A TERMINATES EXECUTION LEAVING ORIGINAL LS AREA UNTOUCHED * ./A JSB ECH IF ANY CHARACTERS RSS FOLLOWING THE "A" JMP ERR GIVE AN ERROR INSTEAD OF ABORT ./A0 CLA STA LSTFG PREVENT LISTING. STA TRFLG 'DELETE' REMAINDER OF SOURCE LDA NOPRN GET INTERACTIVE FLAG. STA TYPEQ SAVE, TEMPORARILY. CCA STA NOPRN PREVENT REPETITIOUS ERROR MESSAGES. JSB ./B$ COMPLETE TRANSFER TO DESTINATION. LDA #TCNT GET NO. OF DEST. TRACKS, LDB LSLUT AND FIRST TRACK SPEC. SZA ANY DESTINATION TRACKS? JSB RELTR YES, GO TO RELEASE DEST. TRACKS. LDA TYPEQ RESET THE INTERACTIVE FLAG STA NOPRN FOR THE FINAL MESSAGE. ./A1 JSB PRINT DEF EXIT DEC 7 NAME ASC 7,EDITR ABORTED * * ./E COMPLETES TRANSFER OF SOURCE TO DESTINATION THEN * TERMINATES IF THERE IS NO INPUT ERROR. SPC 1 ./E STA ./EFL SHOW WE'VE BEEN HERE. JSB ./B$ COMPLETE XFER OF SOURCE TO DEST. ./E2 JSB ECH JMP ERR JSB LCASE CONVERT LOWER CASE CHAR.--IF NECESSARY. STA SAVL FOR RETURN TO SCHEDULER. CPA "L" SET SYSTEM LS POINTER? RSS JMP ./E3 IFZ JSB REMCK REMOTE CRT? JMP ERR YES, CAN'T ACCESS LS XIF }v SPC 1 JSB $LIBR ******************************* NOP TURN OFF MEMORY PROTECT AND LDA LSLUT SET SYSTEM LS AREA POINTER STA SFCUN TO FINAL FILE ADDRESS JSB $LIBX THEN TURN MEMORY PROTECT DEF *+1 BACK ON DEF LSTLS ****************************** SPC 1 DLU. DEF LU. DTRK. DEF TRK. DLSB DEF LSBUF DTBF0 DEF TBUF0 PERMANENT SAVE. LSLU NOP RETURN TO SCHEDULER LTRAK NOP RETURN TO SCHEDULER LSBUF ASC 4,LS FILE X, LU. ASC 1,2, TRK. ASC 2,XXX SPC 1 LSTLS LDA TBUFF STA DTBF0 LDA DLU. STA TBUFF LDB SFCUN LDA .2 SSB INA STA LSLU CLB JSB DEC CONVERT LU TO ASCII CLA STA OCCNT RESET CHAR COUNTER LDA DTRK. POINT TO TRACK ASCII STA TBUFF LDA SFCUN GET LS TRACK CLE,ELA SHUNT OUT LU ALF,ALF STA LTRAK B ALREADY CLEAR FROM ABOVE JSB DEC LDB OCCNT ACTUAL # OF DIGITS. ADB .10 INCREASE BY PREL CHARS LDA DLSB POINT TO MESSAGE, JSB LST AND SEND IT OUT. LDA DTBF0 RESTORE PRIMARY OUTPUT STA TBUFF POINTER AND RESET CLA CHARACTER COUNTER. STA OCCNT SPC 1 JSB ECH FETCH C OR R JMP ENDMS NONE, GO TO END MESSAGE JSB LCASE CONVERT LOWER CASE CHAR. IF NECESSARY. ./E3 STA ./EFL SAVE COMMAND MODE JSB SC.CR PARSE FILE NAME JMP CHEKR /R IS VALID TO REPLACE SOURCE. LDA ./EFL FETCH COMMAND MODE CPA "C" IF C JMP CRFIL GO TO CREATE FILE CPA "R" IF R JMP RPFIL GO TO REPLACE FILE JMP ERR OTHERWISE GO TO ERROR SPC 1 CHEKR LDA ./EFL GET COMND CPA "R" IF IT'S R, PICK UP TURN-ON RSS FILE NAME:SC:CR. JMP ERR NOT R - ERROR. LDA NBUFF LDB TBUFF JSB .MVW COPY THE ORIGINAL NAME DEF .3 NOP DLD FSECW PICK UP TURN-ON SC DST FSECR AND CR. JMP RPFIL TRY TO REPLACE. SPC 1 NBUFF DEF NBUF0 SPC 1 CRFIL DLD T#REC COMPUTE FILE SIZE NEEDED ASR 7 IN 128 WORD BLOCKS ADA T#SEC FSIZE = INA ( T#REC/128 + T#SEC ) + 1 STA FSIZE SPC 1 JSB CREAT CREATE OUTPUT FILE DEF *+9 DEF DBUF$,I DCB DEF RUBSH ERROR BUCKET DEF TBUFF,I FILE NAME DEF FSIZE # OF BLOCKS DEF .4 TYPE 4 DEF FSECR SECURITY CODE DEF FCART CARTRIDGE ID DEF DCBSZ DCB SIZE SPC 1 SSA ERROR FROM CREATE? JMP FMPC YES, PRINT MESSAGE JMP WRITR GO TO OUTPUT FILE SPC 1 RPFIL JSB OPEN OPEN OUTPUT FILE DEF *+8 DEF DBUF$,I DEF RUBSH DEF TBUFF,I DEF ZERO DEF FSECR DEF FCART DEF DCBSZ SPC 1 SSA ERROR FROM OPEN? JMP FMPC YES, PRINT ERROR MESSAGE SPC 1 WRITR JSB SETSO SET UP TO READ SOURCE. JSB SQ READ IN FIRST BLOCK NXREC LDB SLNG CONVERT # CHARS. TO BRS # OF WORDS STB RCLNG SPC 1 JSB WRITF WRITE DEF *+5 RECORD DEF DBUF$,I ON DEF RUBSH OUTPUT DEF SBUFP,I FILE DEF RCLNG SSA IF ERROR, PRINT MESSAGE AND JMP FMPC TRY TO RECOVER LDA RCLNG IF EOF WRITTEN SSA GO TO JMP CLSFL CLOSE FILE JSB I/PSB READ NEXT RECORD JMP NXREC CONTINUE SPC 1 CLSFL JSB CLOSE CLOSE DEF *+2 OUTPUT DEF DBUF$,I FILE SPC 1 SSA IF ERROR PRINT MESSAGE JSB FMPER AND END SPC 1 ENDMS LDA LS\K#TR FETCH OLD SOURCE TRACK LDB LSTRK COUNT AND POINTER SZB IF POINTER IS NON-ZERO JMP RELT RELEASE TRACKS. LDA #TRAK IF ZERO RELEASE ANY WORK TRACKS. LDB LSLUT SZB IF ZERO--DONE. RELT JSB RELTR RELEASE TRACKS SPC 1 JSB PRINT END OF EDIT MESSAGE DEF PRETN DEC 6 ASC 6,END OF EDIT * PRETN LDA SAVL IF E COMMAND INCLUDED L, CPA "L" REPORT THE LS LU AND RSS TRACK BACK TO THE JMP EXIT SCHEDULER. JSB PRTN DEF EXIT DEF LSLU SPC 1 ****** TERMINATION HERE ******** EXIT JSB EXEC DEF *+2 DEF .6 *** * SPC 1 SAVL OCT 0 SAVE PARAMETER FOLLOWING /E .6 DEC 6 B40 OCT 40 M58 DEC -58 M2 DEC -2 "C" OCT 103 M1 DEC -1 .1 OCT 1 .2 OCT 2 M3 DEC -3 DBEND NOP SBEND NOP SPC 1 $$$ER CCA STA SLNG SIMULATE END OF FILE JSB ERROR DEF ./A0 DEC 6 ASC 6,CORRUPT FILE SPC 1 PRINT NOP LDA NOPRN GET THE INTERACTIVE DEVICE FLAG. SZA IF IT'S NON-INTERACTIVE JMP PRNTX THEN, FORGET THE MESSAGE. LDA PRINT INA STA ERMEC INA STA ERMEP JSB DEXEC DEF PRNER IFZ DEF NODE XIF DEF .2.I DEF TTYLU ERMEP NOP ERMEC NOP PRNER CCB,RSS CLB PRNTX LDA PRINT,I JMP A,I * * * * ERROR NOP JSB LOGLU GET THE TERMINAL LU DEF *+2 DEF DUMMY LDB ERAB? SZB,RSS LDA TTYLU USE THE INTERACTIVE COMMAND DEVICE INSTEAD STA DUMMY * LDA ERROR INA STA ERREC INA STA ERREP JSB DEXEC PRINT THE ERROR MESSAGE DEF ERRER IFZ DEF NODE XIF DEF .2.I DEF DUMMY ERREP NOP ERREC NOP ERRER JMP EXIT #F ERROR MESSAGE FAILED, GIVE UP LDA ERAB? SZA JMP *+3 NON-INTERACTIVE, ABORT EDIT LDA ERROR,I JMP A,I * CCA STA SLNG JMP ./A0 * * * FSECR NOP FILE SECURITY CODE FCART NOP FILE CARTRIDGE REFERENCE NUMBER FSECW NOP SAVE SC DURING TURN-ON. FCARW NOP DITTO CR .75 DEC 75 ZERO NOP DBFP1 NOP DUMMY NOP * SC.CR NOP ISZ ECCNT * JSB NAMR PARSE INPUT DEF *+5 DEF TBUFF,I PARSE BUFFER DEF EBUFF,I COMMAND STRING DEF ELNG COMMAND LENGTH DEF ECCNT CURRENT POSITION * CCB ADB ECCNT STB ECCNT RESET CURRENT POSITION LDA TBUFF,I SZA,RSS JMP SC.CR,I NULL FILE NAME * LDB TBUFF ADB .4 DLD B,I DST FSECR SAVE SECURITY CODE & CART. REF. ISZ SC.CR JMP SC.CR,I * SPC 1 RLSAL JSB EXEC RELEASE ALL TRACKS DEF *+3 OWNED BY EDITR. DEF .5 DEF M1 JMP IN2 SKP * INSRC FINDS AND LOADS NEW SOURCE FILE. * * - CONDITIONALLY RELEASES ALL THIS EDITR'S TRACKS. * - READS SOURCE (FMGR) FILE INTO DESTINATION BUFFER, ONE RECORD * AT A TIME. * - WHEN DESTINATION BUFFER IS FULL, CALLS TO WRITE THE * BUFFER IN SYSTEM-ASSIGNED TRACK IN LS FORMAT. * INSRC NOP JSB OPEN OPEN INPUT FILE DEF *+8 DEF SBUF$,I DEF RUBSH DEF TBUFF,I DEF ZERO DEF FSECR DEF FCART DEF DCBSZ SSA,RSS ERROR ON OPEN? JMP IN1 NO, READ IN FILE JSB FMPER YES, PRINT ERROR JMP INSRC,I ERROR RETURN IN1 ISZ INSRC STEP TO OK RETURN LDA EXFLG ORIGINAL INPUT SSA,RSS FILE OR MERGE FILE? JMP NXTRC MERGE FILE! LDA SFCUN LDB TAT IF THIS EDITR DOES NOT SSA ADB TATSD  OWN THE TRACKS CLE,ELA ALF,ALF POINTED TO BY LS POINTER. ADB A LDA B,I THEN IT IS SAFE TO CPA XIDT RSS JMP RLSAL RELEASE ALL TRACKS. IN2 JSB ALCAT GET FIRST DEST. TRACK SPC 1 NXTRC LDA DBUFP SET DBFP1 INA TO STA DBFP1 DBUFP+1 SPC 1 JSB READF READ DEF *+6 SOURCE DEF SBUF$,I FILE DEF RUBSH DEF DBFP1,I DEF .75 DEF DBUFP,I SPC 1 SSA ERROR FROM READF? JMP FMPA YES, GO TO FILE MANAGER ABORT LDA DBUFP,I FETCH RECORD LENGTH SSA END OF FILE? JMP ENDFL YES, GO TO END PROCESS LDB EXFLG MERGE OR ORIGINAL? SSB JMP NOBMP ORIGINAL ISZ T#REC INCREMENT DEST RECORD COUNT JMP *+2 DURING READ FOR A MERGE, ISZ T#REM IN DOUBLE-WORD INTEGER. * NOBMP ALF,ALF MOVE RECORD LENGTH TO STA DBUFP,I UPPER BYTE ALF,ALF ADA DBFP1 ADD PREVIOUS POINTER STA DBUFP TO GET NEW POINTER CMA CHECK FOR AVAILABLE ROOM ADA DBEND TO END OF BUFFER. SSA,INA,RSS END OF OUTPUT BUFFER? JMP NXTRC NO, READ NEXT RECORD STA DBFP1 STORE NUMBER OF WORDS OF OVERFLOW JSB DOUT OUTPUT BUFFER LDA DBFP1 NO OVERFLOW SZA,RSS SO CONTINUE JMP NXTRC WITH READ LDB DBEND OTHERWISE FETCH OVERFLOW ADDRESS OVMVR LDA B,I MOVE STA DBUFP,I BUFFER INB OVERFLOW ISZ DBUFP INTO ISZ DBFP1 BEGINNING OF BUFFER JMP OVMVR JMP NXTRC READ NEXT RECORD ENDFL JSB CLOSE CLOSE DEF *+2 SOURCE DEF SBUF$,I FILE SSA ERROR FROM CLOSE? JSB FMPER YES, GO TO FILE MANAGER ERROR JMP INSRC,I RETURN * RUBSH NOP ANYTHING I DON'T WANT GOES HERE SPC 1 * FMPER PRINTS FILE MANAGER ERROR * FMPER NOP CMA,INA COMPLEMENT ERROR NUMBER CLB DIV .10 GENERATE ADA B60 ASCII FROM ADB B60 OCTAL ERROR NUMBER ALF,ALF IOR B STA MSGP+10 STORE IN MESSAGE JSB ERROR DEF FMPER,I DEC 11 MSGP ASC 11,FILE MANAGER ERROR -XX SPC 1 SPC 1 FMPA JSB FMPER PRINT FILE MANAGER ERROR JMP ENDFL THEN ABORT THE READ SPC 1 FMPC JSB FMPER PRINT FILE MANAGER ERROR JMP NODE1 THEN GET NEXT COMMAND SPC 1 NBUF0 ASC 10, FOR NAME:SC:CR SPC 1 * RECORD BUFFERS - THESE BUFFERS ARE DYNAMICALLY ASSIGNED * FOR INSTANCE, DURING EDITING BUFFERS ARE * SWITCHED BY CHANGING POINTERS SO THAT * THE COMMAND BUFFER (INPUT FROM CONSOLE) * IS USED AS AN EXCHANGE FIELD OR MATCH FIELD * BUFFER. * TBUF0 BSS 75 XYBF0 BSS 75 EBUF0 BSS 75 * MBUF0 IS A SIMILAR BUFFER WHICH OVERLAYS ONE-TIME CODE * STARTING AT 'EDITR'. SPC 2 * DEFAULT TABS ARE COLUMNS 7 AND 21 SPC 1 TAB0 DEC -6,-20,0,0,0,0,0,0,0,0,0 * * SKP A EQU 0 B EQU 1 AVMEM EQU 1751B END OF FOREGROUND+1 BKLWA EQU 1777B LAST WORD OF AVAILABLE MEMORY TAT EQU 1656B TRACK ASSGNMNT TABLE ADDRESS XIDT EQU 1717B EDITR ID TABLE ENTRY ADDRESS TATSD EQU 1756B # OF TRACKS ON SYSTEM DISC SFCUN EQU 1767B SYSTEM LS AREA (LU/TRACK) * BIT 15=LU SECT2 EQU 1757B # SECTORS PER TRACK LU 2 SECT3 EQU 1760B # SECTORS PER TRACK LU 3 MXSEC EQU ECCNT CNTRL EQU SWPET USE ENTRY POINT AS TEMP NEGFL EQU MATCH T1 EQU NUM1 T2 EQU NUM10 NT EQU CFLG RQSTC EQU LSTSB ENTRY POINT USED AS TEMP FSIZE EQU CNT1 RCLNG EQU CNT1 BASE EQU JDEF$ INCR EQU IDEF$ END EDITR * SKP IFHFBN REIO EQU EXEC .2.I EQU .2 XIF A EQU 0 B EQU 1 AVMEM EQU 1751B END OF FOREGROUND+1 BKLWA EQU 1777B LAST WORD OF AVAILABLE MEMORY TAT EQU 1656B TRACK ASSGNMNT TABLE ADDRESS DRT EQU 1652B DEVICE REF. TABLE ADDRESS LUMAX EQU 1653B MAX LU ON SYSTEM XIDT EQU 1717B EDITR ID TABLE ENTRY ADDRESS TATSD EQU 1756B # OF TRACKS ON SYSTEM DISC SFCUN EQU 1767B SYSTEM LS AREA (LU/TRACK) * BIT 15=LU BITS 14-7=TRACK SECT2 EQU 1757B # SECTORS PER TRACK LU 2 SECT3 EQU 1760B # SECTORS PER TRACK LU 3 MXSEC EQU ECCNT CNTRL EQU SWPET USE ENTRY POINT AS TEMP NEGFL EQU MATCH T1 EQU NUM1 T2 EQU NUM10 NT EQU CFLG RQSTC EQU LSTSB ENTRY POINT USED AS TEMP FSIZE EQU CNT1 RCLNG EQU CNT1 BASE EQU JDEF$ INCR EQU IDEF$ END EDITR H D7| 92060-18001 1926 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.1926 790506 XIF IFZ NAM DVP43,0 92060-16001 REV.1926 790506 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 InS 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 STC 0 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 a 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 E S 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 FZ 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 G T 92060-18012 1926 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.1926 790506 END S HN 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 K,x 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 L_ 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 \ MS 92060-18016 1926 S 0722 RTE-III INPUT OUTPUT CONTROL             H0107 `*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.1926 790506 * ***** 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,$DATC * 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 * * * * 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. IN/TERRUPT 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 I:N 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 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 - 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 * i6 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 <9$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 LDA CICM2 "SC03 INT XXXXX" CIC.7 JSB $SYMG `i * * 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. $DATC DEC 1926 DATE CODE OF OPERATING SYSTEM MODULE. * $BLLO DEC -100 LOW BUFFER LIMITS *1926DLS* $BLUP DEC -300 UPPER BUFFER LIMITS *1926DLS* 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 #* * 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 * Pf:: =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#: 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 TELETYPEW`RITER * 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 2NLHBUFFER 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-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) JN* 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 SUSP~ENDED 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 CALXL 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 COdDE * 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. * OPT1 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 RETU'RNED 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 m* ------------------------------------------------------ * ! 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0! * ------------------------------------------------------ * 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 REQUESTSg: * 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 LIST (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`7 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 IMMEADIATE 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. LDA RQP1 GET THE RQ CODE. *1926DLS* * * 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. CPA B21 IF CLASS READ, THEN *1926DLS* JMP L.01 SKIP BUFFER CHECK. *1926DLS* 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,ALF 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) TeO (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 STB 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 * LDhNLHB 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 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 HN* 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 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 BUFFERcG 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. JMP $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 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. 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 YEMPTY 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: * ************************************H******************** * 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. |z 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 7* EQT1 ADDRESS IS IN B ON EXIT * QCHK NOP RSA RAL,RAL SJP *+2 STA QCKST STB TEMP1 SET LIMIT LDA EQT1,I START AT 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 LO~>CATIONS 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 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 PR3NLHOVIDED 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 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 (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. !N* 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 *******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 ADB $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) - * * j(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 DE0VICE 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 * 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* RBL,CLE,ERB *1926DLS* 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+R2). 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 > * 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 * a` 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 WO%RD 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 EXIT. * 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 L]INK 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 > * 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 WVNLHORD 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 N 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 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) 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 ADDRES )S. 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 CONDITIOEN - * 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 * 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 > * * 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 * n 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. 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 GETR 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 * **********************************R************************************ * * 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 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 STB 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 * NLH 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 * ************************************************************************ 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. N 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 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 TEMPƻ2 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 TIhjME-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 TKHE 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 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. * **************************************9************************** * $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. * 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 $I&NER 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). * LDA EQT5,I IF EQT IS BUSY OR WAITING FOR *1926DLS* SSA,RSS DMA, THEN SKIP DMA RELEASE. *1926DLS* JSB CLDMA OTHERWIZE,IF AV OR DOWN,RELEASE DMA. * JSB XUPIO SET ANY ASSOCIATED 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 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 * RELQUESTS 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. 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. * XXUP2 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> 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 THOME 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 * 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 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 NNLHOT 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 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. 1N 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 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 IOCL-5 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 CONFͺIGURE 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 TMP1 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 .+57Y7 -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 o  T] 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 X& 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  Ya 92060-18020 1926 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.1926 790506 * 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 STVART 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 * IOR WSTAT,I IF I-O SUSP.,MERGE CURRENT STATUS AND SET AND CL.NP (CLEAR NO PARMS BIT) *1926DLS* 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 CL.NP OCT 157777 *1926DLS* 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 * H 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 L0oNLH230 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: 4N* 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 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 IOR WSTAT,I *1926DLS* JMP L0375 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 * 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 * y 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 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,Rr{,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,RTONOFSSGOSTPR6IT $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 x= LAST INPUT CHAR.+1 ADD. * TEMP4 = PARAMETER VALUE ADDRESS. * TBUF = DEF TEMP5 (6 LOCATIONS) * 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, 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--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 ABOVEQ, 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 COMMAN_D * * 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 * * CLEAR NO-PRAMS BIT IN CASE PROG IS IN THE TIME LIST * ADB D15 ADVANCE TO ID16 LDA B,I FETCH IT AND CL.NP REMOVE THE NO-PRAMS BIT STA B,I RESTOR7E THE WORD LDB WORK FETCH ID ADDR AGAIN * 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 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 B177NLH 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 d7N 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 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,aRAL 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 * ***************************************************************** * * 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 = MULTI6PLE 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 TEMP3 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 EXIT 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 TO 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 STARCT 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 * 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 eDEC -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 JSc)B $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 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 * u NLHLDA 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 ԔN* 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 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 BuY * 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 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 uLDA 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 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 GE2T 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? JMP 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,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 $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,CLcE,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 ******************************************************************* * 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  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 T0RACKS 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 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 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 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 J 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 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 AL9L 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. * 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 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 $IDN NLHO,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 ESC03 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 HN* * 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 * * 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 SURE 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 H 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 REQUoEST 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 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 SET 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 CHAR 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 Vx 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. 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 TOTAL 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 NEGAT_3IVE 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-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 PRNLHOGS 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 $LIST oN ^I 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 b= 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  c m 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< e~ 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 g 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< hw 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  j 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 STR:kIPED) AND 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!!! * ************************************************************************* SPC 4 ******* WARNING ******************************************************** * THIS DRIVER CONTAINS A SECTION OF CODE THAT TEMPORARILY MODIFIES * THE ALTERNATE MAP FOR THE ECC SCHEME (ERR CORRECTION) * OF THE 13037 CONTROLLER. * THE SECTION OF CODE AT LIMST SHOULD BE REVIEWED * WHEN THIS DRIVER IS PUT IN A NEW OP SYSTEM, TO VERIFY THAT * THE ASSUMPTIONS MADE IN THE CODE ARE STILL VALID. 800129 ************************************************************************** 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 RETURN * 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 CONT4INUE 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 READC 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 * YJMP 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 COMMAND 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 EQT13,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 COMMANDa 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 FORMAT 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 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 T HE 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 LOWER LIMIT ADA UBUF ADD IN THE BUFFER ADDRESS ADB UBUF AND STA S1 SET THE LOW STB SU AND HIGH LIMITS XECC1 JMP CRECT /NOP (CNFG'D TO NOP FOR SYS W/ DMS) * CLB GET LOW PAGE# OF CORRECTION LSR 10 ADDRESS. STA INWD SAVE LOW PAGE IN TEMP(SUBR ENT PT) RSB WHICH MAP ARE WE EXECUTING IN?? BLF (MEM ST REG(BIT12)=0/1=SYS/USR) SLB,RSS CURR MAP=SYS?? IOR B40 YES-SET POINTER TO USR MAP STA OUTCC SAVE MAP REG# OF ALT MAP IN TEMP(SUBR) SPC 1 * SAVE 2 REGS OF ALTERNATE MAP CUZ WE'RE GONNA OVERLAY 'EM SPC 1 LDB BM2 GET 2 REGS: MAPS>TO>MEM CBX SIGN OF X SAYS DIRECTION LDB ABSS1 SAVE AREA FOR 2 ALT MAP REGS.  XMM MOVE 2 FROM ALT MAP TO ABSS1 SPC 1 * SAVE 2 REGS OF CURRENT PORTMAP TO ABSS2 SAVE AREA SPC 1 LDA INWD GET PAGE# OF CORRECTION ADDR IOR B100 ADD OFFSET TO PORT A MAPS LDB OTAD3 GET CNFG'D I/O INSTRUCTION SLB USING PORT B CURRENTLY?? IOR B40 YES-ADJUST OFFSET TO PORT B LDB BM2 MOVE 2 REGS: PORTMAP>TO>MEM CBX INTO SAVE AREA AT ABSS2 LDB ABSS2 XMM MOVE 'EM SPC 1 * STUFF 2 REGS. OF CURRENT PORT MAP INTO ALTERNATE MAP FOR XOR SPC 1 LDA OUTCC GET MAP REG# OF ALT MAP LDB B2 LOAD 2 MAP REGS: MEM>TO>MAPS CBX FROM PORT MAP SAVE AREA LDB ABSS2 AT ABSS2 XMM MOVE 'EM * CRECT LDB S1 ADD LOW LIMIT+DISPLACEMENT & GET ADB STATW THE CORRECTION ADDR IN B REG. JSB XOR CORRECT PAT1 NOP THE JSB XOR DATA PAT2 NOP IN THE JSB XOR BUFFER PAT3 NOP * XECC2 JMP DONE? /NOP (CNFG'D TO NOP IF DMS SYSTEM) SPC 1 * RESTORE ALTERNATE MAP FROM ABSS1 SAVE AREA SPC 1 LDA OUTCC GET POINTER TO ALT MAP REGS. LDB B2 SET TO MOVE 2 REGS: MEM>TO>MAPS CBX FROM THE 2 WORD SAVE LDB ABSS1 AREA AT ABSS1. XMM RESTORE MAPS AS BEFORE * 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 BM2 OCT -2 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. * THE FIXUP IS ALWAYS DONE THRU THE ALTERNATE MAP IN * SYSTEMS WITH DMS (RTE-III/IV). (RTE-II CORRECTS IN CUR MAP.) * TWO REGISTERS OF THE ALTERNATE MAP ARE TEMPORARILY SET UP * FROM THE PORT MAP WHICH WAS USED FOR THE DMA XFER. TWO REGS * MUST BE SET UP INCASE THE 3 WORD XOR PATTERN CROSSES A PG BOUNDARY. * THE CURRENT MAP IS NOT USED FOR XOR BECAUSE WE MAY MAP OURSELF * OUT OF EXISTENCE WHEN THE PORT MAP IS COPIED IN. * XOR NOP LDA S1 GET LOWER LIMIT CMA,CLE,INA WATC;H '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 * XECC3 JMP XORD /NOP (CNFG'D TO NOP IF DMS SYSTEM) * XLA B,I GET THE DATA XOR XOR,I FIX IT AND XSA B,I RESTORE IT TO DATA BUFFER. JMP EXXOR EXIT * XORD LDA B,I GET THE DATA(IT'S IN CUR MAP) XOR XOR,I FIX IT AND STA B,I RESTORE IT TO DATA BUFFER. * 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 NLH 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 WNEQT# 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 ABSS1 DEF COUNT NOP * JMP MOVE,I NO; RETURN. SPC 2 ABSS2 DEF TMP2 * TEMP MAP SAVE AREA COUNT NOP * SAVE AREA FOR ALT MAPS (ECC) NOP * FOR REQUEST SYNDROME CODE. TMP2 NOP * SAVE AREA FOR 2 REGS. OF CURRENT NOP * PORT MAP (ECC ROUTINE). * LBUFP NOP B2 OCT 2 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 S""TATUS 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 IF 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,2INA 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 NoFOR 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 ST A 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 IT 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 STA 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 * LDA $OPSY GET OP SYS TYPE RAR ROTATE TO DMS BIT SLA,RSS DO WE HAVE DMS?? JMP CLC4 NO-LEAVE IN JMP'S AROUND MAP CODE * CLB YES-ENABLE MAPPING CODE FOR ECC STB XECC1 SET THE 640INSTRUCTIONS TO "NOP" STB XECC2 FOR ALL SYSTEMS STB XECC3 EXCEPT RTE-II. 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 * IS 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 HOLD 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 m6 { 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  92060-18037 1926 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.1926 790430 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3GN,3,90 92060-16037 REV.1926 790430 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 I"NTERACTIVE 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 REV.1926 790430 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G3,5,90 92060-16037 REV.1926 790430 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,TIME_1,MULR EXT 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 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 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 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 wLSTAA 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 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 IS 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 * ****************************A********************** * 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 * ****************BH************** 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 e 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 * 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 9SET MAIN RESIDENT 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. * CLA,INA SET MEM PROTECT FLAG OFF STA MPTFL *** PCO 1926 * 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 AKDDRESS <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 LΐNLHABDO MAP. LDA M2002 SET BASE CORE ADDR STA DBASE IN MAP. 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 N 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 B 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 1901 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.1901 781108 * 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) GO TO 22 1000 IF (IA.EQ.0) GO TO 160 C MT LU LOCK WAS NOT SUCCESSFUL, TELL USER 22 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 DO 400 ITR=0,ILT DO 390 ISEC=0,95,INCR CALL SUB (GIDLU,ISUB) 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 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$ 5u   92060-18040 2001 S C0222 &RESTR RSTOR UTILITY             H0102 ͒ASMB,R,L,C * NAME: RSTOR * SOURCE: 92060-18040 * RELOC: 92060-16040 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.2001 791031 * 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) GO TO 22 1000 IF (IA.EQ.0) GO TO 2 C LU LOCK WAS NOT SUCCESSFUL- TELL USER 22 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 jX 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 ILUTR(ILU+1) = IHDR(IWORD) 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) a IF ((IDLU.EQ.2).OR.(IDLU.EQ.3)) GO TO 730 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,14Il) 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$    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$ -   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   92060-18043 1901 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.1901 781108 ENT DBKLB DBKLB EQU * END DBKLB O]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.7906).OR.(IDTYP.EQ.7920)) CGO 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$ FTN4,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 4 92060-18045 1926 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.1926 790506" ! ! 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) 0   !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   92060-18047 1631 S 0122 &PKDIS PKDISC TRANSFER FILE             H0101 :***** :*****NAME: &PKDIS :*****SOURCE: 92060-18047 :***** REV.1631,760624 :***** :PK,32767,RT :: 3  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 1940 S 0122 &AN3F0 RTE-III 7900 DISC ANSWERS             H0101 &LISTF,,32767, * LIST FILE ** ANSWER FILE &AN3F0 92060-18050 1940 RTE3/7900 790918 YES * ECHO ON 35 * EST # TRACKS !SYSTM,,32767, 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,%CLIB,,32767 REL,%RLIB1,,32767 REL,%RLIB2,,32767 REL,%RLIB3,,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 Z$DBL,RP,3 * 3(4) = 3-WORD(4-WORD) FLOATING POINT /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,XE  =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 Q   92060-18051 1940 S 0122 &AN3F5 RTE-III 7905 DISC ANSWERS             H0101 &LISTF,,32767, * LIST FILE ** ANSWER FILE &AN3F5 92060-18051 1940 RTE3/7905 790918 YES * ECHO ON 35 * EST # TRACKS !SYSTM,,32767, 7905 * TARGET DISC (7905/06/20) 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,%CLIB,,32767 REL,%RLIB1,,32767 REL,%RLIB2,,32767 REL,%RLIB3,,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 Z$DBL,RP,3 * 3(4)=3-WORD(4-WORD) FLOATING PT /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 f  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 1926 S C0122 &OPN.C OPN.C OPEN /COMPILER LIB             H0101 .ASMB,R,L,C HED COMPILER LIBRARY OPEN ROUTINE NAM OPN.C,7 92060-16102 790420 REV. 1926 $CLIB *REVISED USE OF D.RPx TO .Rx AS IN RTE-LC FOR REV 1901 *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 PROBT DISC PROTECT BITS 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 CURRAENT EXTENT SECTOR NUMBER WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.RSC 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.TTY FCB USER TERMINAL * 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 .R1 RETURN PARAMETERS EXT .R2 OF OPEN CREATE ROUTINE 'GEX.C' EXT .R3 EXT .R4 EXT .R5 EXT .R6 EXT .R7 EXT C.INP EXT C.LEN EXT NAMR EXT FCB1. EXT FCB2. EXT RW#EC EXT C.SON EXT C.CRD DEFAULT CARTRIDGE 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 CLB STB C.EXT,I STB C.BFF,I STB C.WRD,I ISZ C.WRD,I STB C.RSC,I INITIALIZE FCB FOR STB C.RC#,I RESTART STB READF LDA C.FID,I SEE IF FILE IS ALREADY OPEN AND B10 CPA B10 JMP RET2 YES, EXIT STB C.LNK,I STB C.??,I 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 LDA C.CR,I IS CRN SUPPLIED FOR THIS FILE? SZA,RSS LDA C.CRD 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 .R1 THRU .R7 * * .R1 = ERROR CODE, IF >= 0 THEN THE # OF SECTORS IN THE FILE * .R2 = TRACK AND LOGICAL UNIT * .R3 = OFFSET AND SECTOR NUMBER * .R4 = TRACK NUMBER (LU IF TYPE = 0) * .R5 = NUMBER OF SECTORS IN TRACK AND SECTOR NUMBER * .R6 = SECURITY CODE OF THE FILE * .R7 = 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 .R7 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 .R6 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 .R1 TYPE 0 FILE? LDA .R4 A=LU#,B=#SECTRS SZB,RSS JMP OPNL1 YES JSB SETUP SET UP THE FCB LDA C.CR,I LDB C.CRD SZB,RSS STA C.CRD SET UP DEFAULT CARTRIDGE * * LINK THE FCB INTO THE LIST - HEAD IS GLOBAL CAL%LED 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? 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 STA C.FCB,I 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 E1dj5 LDA M15 BAD NAMR JMP OPN.C,I * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-ADDED FOR CHECKING FOR LU>63! * E12 LDA M12 JMP OPN.C,I BAD LU (LU>63)! * *THAT'S IT! * 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 FORMAT 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 DEFAULT 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 ERROR, 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 .1 INITIATE THE NAMR CHAR PNTR STA TEMP LDA M3 STA END MINUN JSB NAMR DEF *+5 DEF C.NAM,I DEF C.TRN DEF C.LEN DEF TEMP ISZ END JMP MINUN LDA C.NAM,I AND UCMSK CPA AMPSD IS SOURCE 1ST CHAR AN & ? JMP *+2 YES-OK JMP E15 NO GO TELL THEM LDA C.NAM,I AND B377 IOR TMP PUT PROPER 1ST CHAR IN NAMR STA C.NAM,I LDA C.CRD LDB C.NAM ADB .5 STA B,I GETS PROPER CR IN CASE NOT SPECIFIED 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 JMB P RETRN SET UP FCB * * * * OPEN LOGICAL UNIT DEVICE * LU6 LDA C.TTY+2 DEFAULT TO MTM TERMINAL 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 * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-ADDED TO CHECK FOR LU>63! * AND B377 MASK TO LU NUMBER. ADA M64 SSA,RSS JMP E12 BAD LU #. LDA LU * *THAT'S IT! * 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 * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-FOLLOWING 2 STATEMENTS REMOVED SO * LU DE-LOCKING FOLLOWS ORDERLY PROGRESSION. * * CPA .1 LU ALREADY LOCKED? * JMP OPN1 YES! * *THAT'S IT! * SZA,RSS REQUEST MAKE IT? JMP OPN1 nYES! 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 .R1 MAKE SECTORS/FILE INTO BLOCKS/FILE RAR STA C.#SC,I AND STORE INTO FCB LDA .R2 AND B77 ISOLATE FILE LU AND STA TMP SAVE IT CMA,INA SET MINUS LU STA C.CR,I LDA .R4 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 .R5 EXTRACT AND B377 START SECTOR STA C.SSC,I SET START BLOCK XOR .R5 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 SWEE \<:6TY 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 TEMP 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 M3 DEC -3 M7 DEC -7 * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-ERROR CODE AND CHECK PARAM. * FOR LU>63 PROBLEM. * M12 DEC -12 M64 DEC -64 * *THAT'S IT! * 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 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 CHARACTER SPC 2 END 2<  92060-18055 1913 S C0122 &CLO.C CLOSE /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY CLOSE ROUTINE NAM CLO.C,7 92060-16102 790207 REV. 1913 $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 GEX.C D.RTR REPLACEMENT ROUTINE EXT ADS.C FCB ADDRESS PASSER ROUTINE EXT GE#SC WRITE OUT BUFFER ROUTINE EXT C.HLK HEAD OF FCB LINKED LIST EXT C.FCB ADDRESS OF FCB EXT C.FID FCB ID WORD EXT C.FLU FCB LOGICAL UNIT WORD EXT C.EXT FCB EXTENT NUMBER WORD EXT C.#SC FCB NUMBER OF BLOCKS/EXTENT WORD EXT C.RSC CURRENT OFFSET SECTOR NUMBER EXT C.BFF FCB BUFFER ADDRESS WORD EXT C.FAD FCB DIRECTORY ADDRESS FROM D.RTR WORDS EXT C.?? FCB PROMPT CHARACTERS 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 AND CLRFG CLEAR OPEN FLAG STA C.FID,I AND =B7 DETERMINE FCB TYPE CPA .2 SCRATCH? JMP CLSSC CLOSE SCRATCH FILE SZA READ FCB CPA =D4 SOURCE REWIND FILE? JMP CLSRD CLOSE SOURCE TYPE FILES * 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 LDA C.RSC,I RESET C.#SC IN CASE WE CALL A SON. INA STA C.#SC,I 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 .40K OCT 40000 UNLOCK - NO ABORT .1 DEC 1 .2 DEC 2 .5 DEC 5 CLRFG OCT 177767 END e  92060-18056 1926 S C0122 &RED.C RED.C READ /COMPILER LIB             H0101 ASMB,L,C NAM RED.C,7 92060-16102 790403 REV. 1926 $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 * AL 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 * *FOLLOWING CODE CHANGED ON 790403 *REV 1926-REMOVES FMP '005' TYPE ERROR. *NOTE, HOWEVER, THAT THE SPECIAL CASE WHEN *RECORD POINTER > 128 IS IGNORED. * LDB BP,I POINTER > 128? ADB =D-129 SSB,RSS JMP OVER. IF SO, IGNOR CHECK. LDB C.BFF GET BASE ADDRESS. ADB BP,I ADD OFFSET WORD POINTER. LDB B,I SHOULD YIELD WORD CNT FOR RECORD. CPB SAVC MUST COMPARE WITH 1ST WORD OF RECORD. JMP OVER. LDA =D-5 SIMULATE -005 ERROR & RETURN. JMP REDC.,I OVER. ISZ BP,I 'OVER.' LABEL ADDED! * *THAT'S IT! * *EXIT: B := SAVECOUNT; EXIT EQU * LDB SAVC *EXIT2: EXIT2 EQU * L5 ISZ REDC. JMP REDC.,I END _b  92060-18057 1901 S C0122 &WRT.C WRITE /COMPILER LIB             H0101 ASMB,L,C NAM WRT.C,7 92060-16102 770523 REV. 1901 $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 1901 S C0122 &SPC.C SPACE /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY SPACE ROUTINE NAM SPC.C,7 92060-16102 781101 REV. 1901 $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.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 * * * * SPC.C NOP JSB ADS.C SET UP FILE CONTROL BLOCK ADDRESSES 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 z  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 A1 ASC 1,1 B77 OCT 77 B1100 OCT 1100 CTR NOP LINE COUNTER LU NOP LOGICAL UNIT LBUF DEF *+1 ASC 1, BLANKS PBUF DEF A1 END   92060-18059 1901 S C0122 &RWN.C REWIND /COMPILER LIB             H0101 ASMB,L,C NAM RWN.C,7 92060-16102 780921 REV. 1901 $CLIB * * REVISED USE OF D.RPx TO .Rx FOR RTE-LC * * 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.SLU FCB SECONDARY FILE LU 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 .R4 D.RTR RETURN PARAMETER 4 EXT .R5 D.RTR RETURN PARAMETER 5 EXT .TTY THE INTERACTIVE TTY TEST ROUTINE EXT LURQ THE LU LOCK ROUTINE 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); 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 .R4 STA C.STR,I * FCB.STARTSECTOR := RETURNP5 AND @377; ] LDA .R5 AND =B377 STA C.SSC,I * FCB.OFFSETBLOCK := 0; 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 ENzf D Q6  92060-18060 1901 S C0122 &EOF.C EOF /COMPILER LIB             H0101 ASMB,L,C NAM EOF.C,7 92060-16102 770523 REV. 1901 $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 S   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 1901 S C0122 &GMM.C GET MEMRY /COMPILER LIB             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. * *************************************************************** * * SOURCE: 92060-18061 * * * NAM GMM.C,7 92060-16103 780921 REV. 1901 $CLIB EXT COR.A,ID.AD 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) * * DEF not required if #SEGS is zero * GMM.C NOP ENTRY 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 INITIALIZE CALL NUMBER STA SEG# NEXT JSB ENTRY,I GET NA1  ME 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 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 SEG# NOP END zQ   92060-18062 1901 S C0122 &OLY.C LOAD OVRLY /COMPILER LIB             H0101 ^ASMB,L,C 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. * *************************************************************** * * SOURCE: 19060-18062 * * * NAM OLY.C,7 92060-16103 780815 REV. 1901 $CLIB EXT EXEC,$OPSY 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 TRY JSB EXEC CALL THE SUPERVISOR DEF *+3 DEF SEGL C.OLY NOP LDA C.OLY SEGMENT NOT FOUND TRY TO RP IT INA STA N34 SET UP ADDRESSES FOR T5IDM INA STA N5 JSB EXEC CALL T5IDM TO LOAD THE SEGMENT DEF RTN DEF N23I DEF T5IDM DEF C.OLY,I N34 NOP N5 NOP DEF K1 RTN JMP EXIT ERROR RETURN JUST EXIT * LDA $OPSY FIGURE OUT HOW TO GET THE RETURN VALUE ERA,SLA TEST THE DMS BIT JMP DMS IF DMS INSTALLED JMP * LDA B,I ELSE JUST LOAD THE DATA JMP TS GO TEST THE RESULT * DMS XLA B,I DMS DO THE DMS CROSS LOAD TS SZA,RSS IF ZERO THEN THE SEGMENT WAS SET UP JMP TRY SO GO TRY AGAIN EXIT ISZ OLY.C SHOULD NOT RETURN JMP OLY.C,I IF IT RETURNS, EXIT * SEGL OCT 100010 T5IDM ASC 3,T5IDM N23I DEF 23,I K1 DEC 1 A EQU 0 B EQU 1 END     92060-18063 1913 S C0122 &RUN.C RUN PROG /COMPILER LIB             H0101 ASMB,L,C NAM RUN.C,7 92060-16104 790207 REV. 1913 $CLIB * * SOURCE: 92060-18063 * * 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; * GET-ID-FOUND * 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.TTY THE TERMINAL EXT C.RP ID FINDER 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 FCB2P BSS 1 LOCAL POINTER SET UP TO POINT TO FCB2 .CHLK DEF C.HLK .PRAM BSS 1 .CPAS DEF C.PAS D5 DEC 5 D14  DEC 14 D25 DEC 25 D112 DEC 112 .SKED DEC 23 SCRFG BSS 1 THE SCRATCH FILE FLAG DUPFG BSS 1 THE DUPPED ID FLAG RUN.C BSS 1 * MOVE FCB1 TO FCB1. FOR 25 WORDS; LDB RUN.C 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. STB FCB2P (WILL FIX C.#SC LATER) 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 *+2 JMP CLOSE ISZ RUN.C JMP EXIT * COPY C.#SC FROM FROM OLD FCB2 TO NEW ONE. SKED LDA FCB2P GET IT. ADA =D6 LDA A,I STA FCB2.+4 PUT IN NEW. * MOVE_THE_USERS_PARAMETERS_DOWN; 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 * GET-ID-FOUND LDA C.TTY+2 LDB ID JSB C.RP JMP EXIT NO ERROR RETURN STA DUPFG STB ID * SCHEDULE(ID,PRAMLISTP ); 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 D112 * 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 DUP * LINK_IT_BACK_IN; LDA FCB1P STA C.HLK CLA STA FCB1P,I DUP LDA DUPFG SZA JMP EXIT LDB ID CLA JSB C.RP DELETE ID RSS ERROR RETURN EXIT ISZ RUN.C JMP RUN.C,I END   92060-18064 1901 S C0122 &END.C END /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY END ROUTINE NAM END.C,7 92060-16103 780726 REV. 1901 $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-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: * 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 CLOSE 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 JMP END.C,I ERROR RETURN * EXIT LDA END.C,I GET THE DEF TO THE PRAMS STA PADD AND PUT IN THE PRAM CA;C  LL JSB PRTN RETURN DEF *+2 PARAMETER STRING PADD DEF END.C,I JSB EXEC TERMINATE DEF *+2 DEF .6 * .6 DEC 6 END N   92060-18065 1901 S C0122 &PRM.C GET PRAM /COMPILER LIB             H0101 ASMB,L,C NAM PRM.C,7 92060-16102 780921 REV. 1901 $CLIB * * SOURCE: 92060-18065 * * 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 DE0-  F 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 1901 S C0122 &GMS.C GET MEM SG /COMPILER LIB             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. * *************************************************************** * * SOURCE: 92060-18066 * * * NAM GMS.C,7 92060-16103 781006 REV. 1901 $CLIB EXT COR.A,ID.AD EXT C.OLY ADDRESS OF LAST SEGMENT LOADED * 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 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 A EQU 0 B EQU 1 END \2  92060-18067 1901 S C0122 &WARC. WRT AFT RD /COMPILER LIB             H0101 ?ASMB,L,C NAM WARC.,7 92060-16102 770523 REV. 1901 $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 SAVLh  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 1901 S C0122 &GES.C GET SECTR /COMPILER LIB             H0101 6ASMB,L,C NAM GES.C,7 92060-16102 780728 REV. 1901 $CLIB * * REVISED USE OF D.RPx TO .Rx FOR RTE-LC * * 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 + OFFSETBLOCK1) / BLOCKSPERTRACK; LDB C.SSC,I 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 .R4 D.RTR RETURNP4 EXT .R5 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 PAR ~ AMETERS *IF FCB.OFFSETBLOCK = FCB.NUMBEROFBLOCKS 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 .R4 STA C.STR,I EXT C.SSC THE EXTENT START SECTOR * FCB.STARTSECTOR ;= RETURNP5 AND @377;]; LDA .R5 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 H  92060-18069 1901 S C0122 &GEX.C D.RTR INTF /COMPILER LIB             H0101 =ASMB,L,C NAM GEX.C,7 92060-16105 781127 REV. 1901 $CLIB SPC 3 * NAME: GEX.C * SOURCE: 92060-18069 * PGMR: EARL STUTES * * CALLING SEQUENCE: LDA function * LDB cr * JSB GEX.C * DEF parameter *iff function<=3 * 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 3 * THIS PROCEDURE HANDLES SEVERAL OF THE DIFFERENCES BETWEEN RTE-IV 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 .R1 D.RTR RETURN PARAMETER #1 ENT .R2 D.RTR RETURN PARAMETER #2 ENT .R3 D.RTR RETURN PARAMETER #3 ENT .R4 D.RTR RETURN PARAMETER #4  ENT .R5 D.RTR RETURN PARAMETER #5 ENT .R6 D.RTR RETURN PARAMETER #6 SECURITY CODE ENT .R7 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 ENT PROBT 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 A EQU 0 B EQU 1 PROBT OCT 74000 DISC PROTECT BITS MYID EQU 1717B FUNCT BSS 1 THE PASSED IN FUNCTION PARAMETER CR BSS 1 THE PASSED IN CR PARAMETER .R6 BSS 1 FSCTR EQU .R6 SCTRS BSS 1 EITHER CURRENT SECTOR OR #OF SECTORS TRACK BSS 1 THE TRACK BEING WRITEN ON OR READ FROM .R7 BSS 1 DLU EQU .R7 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 NEWOP EQU .2 NEW OPEN FUNCTION CODE D.RTR ASC 3,D.RTR LIMEM EQU 0 A FAKE FOR RTE II-III SPC 2 GEX.C DEF LIMEM 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 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 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 .R2 INB STB .R3 JSB EXEC CALL D.RTR DEF *+7+1 DEF QSKED DEF D.RTR DEF IMYID DEF .PRAM,I DEF .R2,I DEF .R3,I DEF CR JMP FETCH EXIT CASE * 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;]B 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 FROM EXEC READ SSA,RSS 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 FROM EXEC WRITE ABOVE LA EQU * * SETUPD.RTRETURN ] STB C.FLU,I JSB SD.RN ISZ GEX.C JMP EXIT * ELSE L2 EQU * LDA .PRAM,I MAKEOPENEXTCALL LDB =D6 SZA,RSS ADB =D2 STB FUNCT LDA C.EXT STA .PRAM JMP CEXEC SPC 2 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 SOPEN JSB INNEW INITIALIZEANEWTRACK; * SET UP PRAMS FOR D.RTR LIKE RETURN LDA TRACK JSB SD.RN LDA DLU STA .R2 CLA STA C.FAD,I STA C.FAD+1,I STA .R6 LDA =D3 STA .R7 JMP EXIT 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 * ESAC; SPC 3 FETCH LDA B e PRAM ADDRESS TO A CLB,CCE ERB JSB P.PAS FETCH THE RETURN PARAMETERS DEC -5 .R1 BSS 1 .R2 BSS 1 .R3 BSS 1 .R4 BSS 1 .R5 BSS 1 ISZ GEX.C LDA .R1 CHECK FOR ERRORS SSA JMP GEX.C,I * IF FUNCTION = NEWOPEN THEN LDA FUNCT CPA NEWOP JMP *+2 JMP NOTOP EN * GETP6&P7; LDA .R2 AND =B77 STA DLU LDA .R2 ALF,ALF RAL,RAL AND =B1777 STA TRACK LDA .R3 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 .R3 FETCH THE TYPE CODE ALF,ALF AND =B377 ADA =B3 ADA C.BFF LDB A,I STB .R7 ADA =B5 FETCH THE SECURITY CODE LDB A,I STB .R6 JMP FILID NOTOP CPA .1 JMP *+2 JMP EXIT FILID DLD .R2 DST C.FAD,I EXIT ISZ GEX.C JMP GEX.C,I SPC 3 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 DEF DLU DEF TRLU DEF .2 DEF TRACK DEF SCTRS *^$" JMP REDPD,I SPC 3 SD.RN BSS 1 SETUPD.RTRETURN STA .R4 THE TRACK WORD LDA SCTRS STA .R1 NUMBER OF SECTORS IN THE FILE ADA =D2 ALF,ALF STA .R5 JMP SD.RN,I SPC 3 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 .PRAM EQU .R1 NAME EQU .R2 TRLU EQU .R4 IDPTR BSS 1 IMYID EQU .R5 NLU EQU .R5 END $   92060-18070 1901 S C0122 &CRE.C CREATE /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY CREATE ROUTINE NAM CRE.C,7 92060-16102 780921 REV. 1901 $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-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 NAMrf  E 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 CLA SSB CMA STA BUF+5 SESSION USES DBL WRD 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 w   92060-18071 1901 S C0122 &ADS.C FCB PTRS /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY UTILITY ROUTINE ADS.C NAM ADS.C,7 92060-16102 770809 REV. 1901 $CLIB * * 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.FSEZ 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 ADDRET SS 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 v  92060-18072 1901 S C0122 &C.BS2 SCR BUF 2 /COMPILER LIB             H0101 ASMB,R,L,C NAM C.BS2,7 92060-16102 771214 REV. 1901 $CLIB * * SOURCE: 92060-18072 * HED SOURCE INPUT/OUTPUT BUFFER * * SOURCE I/O BUFFER * ENT C.BS2 BUFFER ENTRY POINT * * * C.BS2 BSS 129 * * END l  92060-18073 1901 S C0122 &ID.AD SEG NM ADR /COMPILER LIB             H0101 !ASMB,L,C 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. * *************************************************************** * * SOURCE: 19060-18073 * * * NAM ID.AD,7 92060-16103 780811 REV. 1901 $CLIB ENT ID.AD * EXT EXEC,IDSGA,$OPSY * 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 NAME INB STB NAM34 INB STB NAM5 TRY JSB IDSGA TRANSLATE THE NAME TO AN ADDRESS DEF *+2 NAME NOP STA B PUT THE ADDRESS IN THE RIGHT REG SZB IF WE GOT ONE JMP ID.AD,I RETURN WITH IT * JSB EXEC WE FAILED SO TRY T5IDM TO RP IT DEF RTN DEF D23I DEF T5IDM DEF NAME,I NAM34 NOP NAM5 NOP RTN CLB FAILED SET UP ERROR RETURN (LOADS RESULT FROM A) LDA $OPSY FIGURE HOW TO GET THE RETURN ERA,SLA TEST THE DMS BIT JMP DMS IF DMS GO DO XLOAD * LDA B,I GET THE RETURN WORD JMP TS GO TEST IT * DMS XLA B,I DMS INSTALLED DO A XLOAD TS CLB SET UP B FOR REJECT SZA DID WE GET ANY WHERE? JMP ID.AD,I NO RETURN WITH B=0 * JMP TRY YES TRY AGAIN * A EQU 0 B EQU 1 D23I DEF 23,I T5IDM ASC 3,T5IDM END     92060-18074 1901 S C0122 &C.TRN TRN ON STR /COMPILER LIB             H0101 >!ASMB,L,C NAM C.TRN,7 92060-16102 781016 REV. 1901 $CLIB * * SOURCE: 92060-18074 * * 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 C.CRD THE FATHER'S SOURCE CARTRIDGE 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 - (C.TTY+2) 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.CRD 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 l1  92060-18075 1901 S C0122 &C.SAU SRC FCB /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SAU,7 92060-16102 770721 REV. 1901 $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. * *************************************************************** 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 * +-------D----------------------------------------+ * 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 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 1901 S C0122 &C.SOR SRC FCB /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SOR,7 92060-16102 770815 REV. 1901 $CLIB * * SOURCE: 92060-18076 * * 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 * +---------8--------------------------------------+ * 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 BUFFER ADDRESS DEF WARC. REWIND GUARANTEE ROUTINE DEF INSC. $INCLUDE ROUTINE ADDRESS END   92060-18077 1901 S C0122 &C.BIN BIN-R FCB /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.BIN,7 92060-16102 770721 REV. 1901 $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. * *************************************************************** 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 * +-------P----------------------------------------+ * 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 !F  92060-18078 1901 S C0122 &C.LST LST FCB /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.LST,7 92060-16102 770721 REV. 1901 $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. * *************************************************************** 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 * +---------------Z--------------------------------+ * 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 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.BLI BUFFER ADDRESS DEF C.DUM REWIND GUARANTEE ROUTINE DEF C.DUM $INCLUDE ROUTINE ADDRESS END ik  92060-18079 1901 S C0122 &C.SC0 SRC FCB 0 /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SC0,7 92060-16102 770802 REV. 1901 $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. * *************************************************************** 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 * +-----9------------------------------------------+ * 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 hWORD 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   92060-18080 1901 S C0122 &C.SC1 SRC FCB 1 /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SC1,7 92060-16102 770802 REV. 1901 $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. * *************************************************************** 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 * +-----1------------------------------------------+ * 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 fWORD 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   92060-18081 1901 S C0122 &C.SC2 SRC FCB 2 /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.SC2,7 92060-16102 770802 REV. 1901 $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. * *************************************************************** 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 * +-----3------------------------------------------+ * 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 WOYRD 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 g  92060-18082 1901 S C0122 &C.BNS BIN FCB /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY BINARY FILE CONTROL BLOCK NAM C.BNS,7 92060-16102 770515 REV. 1901 $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 1901 S C0122 &C.BSA SRC BFR /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY SOURCE BUFFER NAM C.BSA,7 92060-16102 770515 REV. 1901 $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 1901 S C0122 &C.BS0 SRC BFR /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY SOURCE BUFFER NAM C.BSO,7 92060-16102 770515 REV. 1901 $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 1901 S C0122 &C.BBI BIN BFR /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY BINARY BUFFER NAM C.BBI,7 92060-16102 770515 REV. 1901 $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 1901 S C0122 &C.BLI LST BRF /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY LIST BUFFER NAM C.BLI,7 92060-16102 770515 REV. 1901 $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 1901 S C0122 &C.BS0 SCR BFR 0 /COMPILER LIB             H0101 ASMB,R,L,C NAM C.BS0,7 92060-16102 771214 REV. 1901 $CLIB * * SOURCE: 92060-18089 * HED SOURCE INPUT/OUTPUT BUFFER * * SOURCE I/O BUFFER * ENT C.BS0 BUFFER ENTRY POINT * * * C.BS0 BSS 129 * * END g   92060-18090 1901 S C0122 &C.BS1 SCR BFR 1 /COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY SCRATCH BUFFER #1 NAM C.BS1,7 92060-16102 770515 REV. 1901 $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 1901 S C0122 &SUP.C INITIALIZE/COMPILER LIB             H0101 Z0ASMB,L,C HED COMPILER LIBRARY INITIALIZE SUBROUTINE -- SUP.C NAM SUP.C,7 92060-16104 781106 REV. 1901 $CLIB * * SOURCE: 92060-18091 * * * * 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."; * C.TTY(3) := LOGLU OR 400B * FETCH_TURN_ON_STRING; * IF LENGTH(TURN_ON_STRING) = 114 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 EXT C.CRD THE DEFAULT CATRIDGE NUMBER EXT C.HLK THE HEAD LINK POINTER * GLOBAL INTEGER ARRAY EXT C.TTY THE FCB FOR THE LOGLU EXT LOGLU THE ROUTINE TO RETURN USERS LU# * 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 SPC 5 A EQU 0 B EQU 1 D1 DEC 1 O13 OCT 13 D224 DEC -224 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 * C.TTY(3) := LOGLU OR 400B JSB LOGLU DEF *+2 DEF * IOR =B400 STA C.TTY+2 CLB STB C.HLK STB C.SON * FETCH_TURN_ON_STRING; JSB EXEC DEF *+4+1 DEF D14 DEF D1 DEF C.TRN DEF D224 * IF LENGTH(TURN_ON_STRING) = 224 THEN LDA B ADA D224 SZA JMP L1 * SONFLAG := TRUE; CCA STA C.SON JMP L2 * ELSE * BEGIN * TURN_ON_STRING_LENGTH := B; L1 EQU * STB C.LEN CLB STB C.CRD * 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.Nu 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 C  92060-18092 2026 S C1222 &FTN4 MAIN             H0112 ASMB,Q,C HED ** 16K FTN4 COMPILER (FTN4:PASS1) ** NAM FTN4,3 92060-16092 REV.2026 800423 * *************************************************************** * (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. * *************************************************************** * NAME: FTN4, PART OF FTN4, PART OF FTN4 COMPILER. * * SOURCE: PART OF 92060-18092 * * RELOC: PART OF 92060-16092 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.ABT ABORT COMPILE EXTRY ENT F.ACC TEMP ACCUMULATOR FLAG 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.CAL CALL STATEMEXT PROCESSORd EXT F.CC CHARACTER COUNT ENT F.CCW FTN OPTION WORD 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.DCF DIM, COM FLAG ENT F.DEF DATA EXISTS FLAG ENT F.DNB DEF OF NBUF (NAM RECORD) ENT F.DO LWAM - END OF DO TABLE EXT F.DOP DO STATEMEXT PROCESSOR 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 ENT F.EQF EQUIVALENCE FLAG ENT F.ER0 'RX' OF ERRX LIB ERROR ROUTINE 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 ENT F.INT TEMP VARIABLE ARRAY ENT F.IOF INDICATOR FOR I/O INDEX EVALUATOR EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) ENT F.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG ENT F.LO END OF ASSIGNMEXT TABLE+1 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.NCR NO CROSS REF FLAG ENT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NXN NO INPUT FLAG ENT F.OPF OUTPUT PACK FLAG EXT F.PAK PACK BUFFER WORD EXT F.PAP PAUSE STMT. PROCESSOR EXT F.RDP READ STATEMEXT PROCESSOR ENT F.RPL PROGRAM LOCATION COUNTER 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.S#1B BOTTOM OF STACK 1 ENT F.S1T TOP OF STACK 1 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 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 ENT F.SXF COMPLEX CONSTANT FLAG ENT F.T # WORDS ON STACK 1 ENT F.TAC ? EXT F.TC NEXT CHARACTER EXT F.TRM TERMINATE COMPILE ENT F.TYP TYPE STMT FLAG EXT F.WRP WRITE STATEMEXT PROCESSOR * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * ENT AA.F ASSIGN ADDRESS SUB. ENT CRT.F TEST FOR CARRAGE RETURN EXT CSN.F CHECK STATEMENT # TYPE. EXT DL.F DEFINE LOCATION SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER ENT FNS.F FIRST NOT SPEC. STMEXT CHECK EXT IA.F INPUT (A) CHARACTERS SUBROUTINE EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT IFT.F IF GOTO COMPLETION EXT ISN.F INPUT STATEMEXT NUMBER EXT ISY.F INPUT SYMBOL EXT MCC.F RESET TO FIRST COLUMN OF STATEMEXT ENT NEW.F SUB TO CLEAR TEMPS FOR A NEW MODULE ENT SCC.F SAVE F.CC SUBROUTINE EXT SNC.F START NEXT CARD SUBROUTINE EXT TDO.F DO TERMINATION CODE GENERATOR EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT UC.F UNINPUT COLUMN  EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) SPC 1 * THIS FORTRAN IV COMPILER RUNS 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.EMP EMA 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 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 G4 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. * CLA INPUT ANY KIND OF STATEMENT #. JSB ISN.F 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 JSB 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 YSTATEMENT. * ISY.F INPUTS A SYMBOL AND SETS ARRAY IDENTIFIER. * * * SHORT HAND FOR TEMPS * T1 = T1STS * 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='(' OR '='? *IT IS A DO * * 0! 1! STID9 *STATEMENT * * ! ! ************* * ! O_______________________ X * ! TC=? ^ * ! ________O------------------- ^ * ! ! ! ! ! ! ^ * ! ! 'C/R', ')' '(' E '=' ^ * ! ! '"', ! ! L ! ^ * ! ! "'" T4_T4-1 ! S ! ^ ^------! * O<<0? JMP IDN30 [+!-]ND (N>0) * LDA T3IDN PRECEDED BY + OR - ? [+!-] SZA JMP IDN12 YES +!- * LDA F.DLF 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 BUU~FFER 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? [+!-]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 V 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 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 EXPONENT 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 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 ,640* * 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. /6 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.ID+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 wCHAR. 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 K65 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 IDN05 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.3%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 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 JMP 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 2T8 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 SSA,RSS (IF ZERO, DON'T DECREMENT IT) STA F.OPF OUTPUT F.PAK? SZA JMP PACK2 NO, NOT YET * LDB K2 STB F.OPF CL{1A,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 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 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 TYn640PE * 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 26ASMB,Q,C HED ASSIGNMEXT TABLE ROUTINES NAM FA.F,8 92060-16092 REV.2001 791101 * * THIS MODULE OF THE HP FTN4 COMPILER CONTAINS THE ASSIGNMEXT TABLE * 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. * *************************************************************** * NAME: FA.F, PART OF FTN4, PART OF FTN4 COMPILER. * * SOURCE: PART OF 92060-18092 * * RELOC: PART OF 92060-16092 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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 ENT F..E DIMENSIONS CONSTANT BIT FROM ASSIGNS TABLE ENT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ABT ABORT COMPILE EXTRY ENT F.AF ADDRESS FIELD CURREXT F.A ENT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.AT. SUBSCRIPT INFO FLAG EXT F.CCW FTN OPTION WORD ENT F.D0 ARRAY ELEMEXT SIZE ENT F.D1 DIMENSION 1 ENT F.D2 DIMENSION 2 ENTM F.D3 DIMENSION 3 ENT F.DCF DIM, COM FLAG EXT F.DID ADDRESS OF F.IDI ENT F.DNI ADDRESS OF NID ENT F.DP BASE OF USER SYMBOL TABLE EXT F.E EQUIVALENCE TABLE POINTER ENT F.EFG E - FLAG - SET IF SUBSCRIPT IS DUMMY EXT F.EQF EQUIVALENCE FLAG ENT F.EXF EXTERNAL STATEMEXT FLAG EXT F.IDI INPUT ARRAY NON-NUMERIC ENT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) ENT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.L # WORDS ON STACK 2 EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.MFL TYPE STMT. MODE FLAG ENT F.NC NAME CHANGE FLAG. ENT F.ND NUMBER OF DIMENSIONS ENT F.NT NAME TAG 0= VAR, 1=CONSTANT. ENT F.NTF NAME TAG FLAG ENT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. ENT F.R JSB ERR0 FLAG EXT F.RPL PROGRAM LOCATION COUNTER EXT F.S1T TOP OF STACK 1 ENT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.TC NEXT CHARACTER EXT F.TYP TYPE STATEMEXT FLAG ENT F.X1 F.A OF F.D1 ENT F.X2 F.A OF F.D2 ENT F.X3 F.A OF F.D3 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * ENT AI.F ASSIGN ITEM ENT BNI.F CLEAR NID TO BLANKS EXT CDI.F CLEAR IDI ROUTINE ENT CSN.F CHECK STATEMENT NUMBER TYPE ENT DAF.F DEFINE (F.AF) ENT DAT.F DEFINE (AT) ENT DIM.F DEFIND (F.IM) ENT DIU.F DEFINE (F.IU) ENT DL.F DEFINE LOCATION SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE ENT ESC.F ESTABLISH CONSTANT SUBROUTINE ENT ESD.F ESTABLISH DEF SUBROUTINE ENT FA.F FETCH ASSIGNS ENT FID.F FETCH (ID) TO NID (UNPACK)r4 ENT GNA.F GET NEXT SYMBOL TABLE EXTRY ENT IN4.F INIT FOR FA.F MODULE ENT ITS.F INTEGER TEST ENT NCT.F TEST FOR NOT A CONSTANT ENT NST.F TEST FOR NOT A SUBROUTINE NAME ENT NTI.F MOVE NID TO F.IDI (PACKS) ENT NWI.F SET F.D0 TO # WORDS IN ARRAY ENT TCT.F TEST (A) = F.TC ELSE ER 28 ENT TS.F TAG SUBPROGRAM SUB. ENT TV.F TAG VARIABLE EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * GENERAL LIB EXT * EXT .MVW MOVE WORDS * A EQU 0 B EQU 1 SUP * * IN4.F NOP INITILIZE CODE LDA AIK1 MAKE SURE WE HAVE DIRECT ADDRESSES RAL,CLE,SLA,ERA LDA A,I STA AIK1 INA STA AIK2 LDA F.CCW SEPERATE ALF,ALF THE Y BIT RAR AND AND K1 MAKE ADA K2 A 2 OR A 3 BASED ON IT STA NWET1 SAVE FOR THE NWE ROUTINE JMP IN4.F,I RETURN * K1 OCT 1 SKP * THE ASSIGNMENT TABLE * * THE ASSIGNMENT TABLE OR SYMBOL TABLE CONTAINS ENTRIES OF * LENGTHS 2 THRU 7 WORDS (LENGTH FIELD MAX). * THESE ENTRIES ARE AT TIMES LINKED TO OTHERS IN ORDER * TO DESCRIBE MORE COMPLEX STRUCTURES. * * WORD ONE IDENTIFIES THE ENTRY AND IS SPLIT UP INTO FIELDS: * * !---!---------!---------!------!------!---!---!---------! * !NT ! IM ! AT ! IU ! NC ! R ! E ! NW ! * !---!---------!---------!------!------!---!---!---------! * !15 !14 13 12!11 10 9! 8 7 6 ! 5 4 3 ! 2 1 0! * !---!---------!---------!---------!-----------!---------! * * WHERE: NT =NAME TAG = 0 IF ITEM IS NAMED * IM =ITEM MODE = 0 IF STATEMENT NUMBER * 1 IF INTEGER (INT) * 2 IF REAL (REA) * 3 IF LOGICAL (LOG) *  4 IF OBJECT CODE (TWPE) * 5 IF COMPLEX (CPX) * 6 IF DOUBLE PREC.(DBL) * 7 IF TEMP. ADD. (ADDR) * * AT =ADDRESS TYPE TELL STATUS OF THE ADDRESS FIELD (AF) * =0 IF ABSOLUTE LOCATION (NOT USED) * =1 IF RELATIVE LOCATION WITHIN THE PROGRAM (REL) * AF= RELATIVE ADDRESS * =2 IF UNDEFINED OR UNREFERENCED YET (STR-ABS) * AF= POINTER TO THIS ENTRY (USUALLY) * IF AF<0 THEN (-AF)= # WORDS IN STRING TO * BE ALLOCATED AT BEGINNING OF PASS TWO * =3 IF VARABLE IS IN LABELED COMMON (BCOM) * AF= COMMON OFFSET OR LOCATION IN COMMON * =4 IF VARABLE IS IN BLANK COMMON (COM) * AF= POINTER TO COMMON INFO. ENTRY * =5 IF VARABLE IS A DUMMY PARAMETER (DUM) * AF= RELATIVE ADDRESS OF DEF TO THE VAR. * =6 IF THIS IS A DIMENSION ENTRY (DIM) * AF= RELATIVE ADDRESS OF THE ARRAY OR * IF BCOM THEN POINTER TO INFO. ENTRY * =7 IF THIS IS A LABELED COMMON INFO. ENTRY (BCOMI) * AF= IF IU=SUB THEN EXT ID NO. OR 0 * ELSE OFFSET FROM BEGINING OF COMMON * IN THAT BLOCK * ID = POINTER TO SUB ENTRY FOR * EXT NUMBER. * * IU =ITEM USAGE TELLS HOW IT IS BEING USED * = 0 NOT YET USED * = 1 SUBROUTINE (SUB) * = 2 VARABLE OR CONSTANT (VAR/CON) * = 3 ARRAY (ARR) * * NC =NAME CHANGE USED ONLY IN FIX-EXT PART ON THE TABLE * =0 NO NAME CHA}8NGE REQUIRED (IF USED IN EXT ) * =1 FIRST CHAR. MAY BE CHANGED TO '$' * =2 FIRST CHAR. MAY BE CHANGED TO '#' * =3 FIRST CHAR. MAY BE CHANGED TO '%' * * R =IF IN FIX-EXT THEN ERR0 CALL FLAG * =0 IF ERR0 NOT TO BE CALLED * =1 IF ERR0 TO BE CALLED * =IF DIMENSION ENTRY THEN DIMS. CONSTANT FLAG * =0 IF CONSTANT DIMIMENSIONS * =1 IF NON-CONSTANT DIMIMENSIONS * * E =EXPLICIT TYPE FLAG USED TO FLAG ERROR IF TYPE CONFLICT * =0 IF TYPE IS IMPLICIT * =1 IF MENTIONED IN A TYPE STATEMENT * * NW = NUMBER OF WORDS IN THIS ENTRY * * VARABLE NAMES: * * !---!---------!---------!---------!-----------!---------! * CHARACTER 5 ,6 (IF NEEDED) * !---!---------!---------!---------!-----------!---------! * CHARACTER 3 ,4 (IF NEEDED) * !---!---------!---------!---------!-----------!---------! * CHARACTER 1,2 (ALWAYS) * !---!---------!---------!---------!-----------!---------! * AF= ADDRESS (AT=REL OR DUM),COMMON OFFSET (AT=COM) * POINTER TO DIM ENTRY (IU=ARR) (THIS BEFORE BCOM) * POINTER TO BCOMI ENTRY (AT=BCOM,IU#ARR) * !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=INT,REA,LOG,CPX,DBL AT=ABS,REL,STR-ABS,COM,BCOM,DUM * IU= VAR/CON,ARR OR 0 IF NAME OF CURRENT PROGRAM * * THE NAME WILL BE FILLED WITH BLANKS TO MAKE AND EVEN NO. OF CHAR. * * DIMENSION ENTRY * * !---!---------!---------!----------!----------!---------! * X3 POINTER TO SIZE OF THIRD DIMENSION (IF NEEDED) * !---!---------!---------!----4-------!----------!---------! * X2 POINTER TO SIZE OF SECOND DIMENSION (IF NEEDED) * !---!---------!---------!----------!----------!---------! * X1 POINTER TO SIZE OF FIRST DIMENSION (ALWAYS) * !---!---------!---------!----------!----------!---------! * NUMBER OF WORDS ELEMENT (SET ONLY IF EMA) * !---!---------!---------!----------!----------!---------! * AF= ARRAYS ADDRESS (AT=REL,DUM) OR COMMON OFFSET (AT=COM) * OR POINTER TO BCOMI ENTRY (AT=BCOM) * (NOTE THESE AT'S ARE OF THE VARABLE ENTRY, THIS AT IS DIM) * !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=NUMBER OF DIMENSIONS (1,2,3) AT=6 IU=0 * R=1 IF ONE OR MORE DIMENSIONS ARE VARIABLE * * BLOCK COMMON INFO. ENTRY * * !---!---------!---------!----------!----------!---------! * ! SECOND WORD OF OFFSET IF EMA VARIABLE ! * !---!---------!---------!----------!----------!---------! * ! POINTER TO LABEL ENTRY FOR THIS BLOCK ! * !---!---------!---------!----------!----------!---------! * ! OFFSET OF THIS VARIABLES ENTRY IN THE ABOVE BLOCK ! * !---!---------!---------!----------!----------!---------! * !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=0,1 AT=BCOMI IU=0 NW=3,4 * IM=1 => 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 ! 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 ! NC ! ! 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 NC=TYPE: 0=UNKNOWN * 2=NON-FORMAT * 3=FORMAT * * 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) * * !---!---------!---------!----------!----------!---------! * 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 icBASE 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 POINTER 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 T3FA 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 ONLYNLH 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! N* 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 F.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 LDA F.LO ADA F.NW STA F.LO STA F.S2B BEGIN ADDR OF OPERATOR STACK LDA F.S2T STA J ADA F.NW STA F.S2T LAST WORD LOC OF OPERATOR STACK LDA F.L SET B = MAX ( F.L, F.NW ) CMA,INA ADA F.NW LDB F.NW 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 * 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 K32 EQU B40 K64 DEC 64 T1AI 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 T4AI,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 ADIpA 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 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 TSUBF NOP TAG 'SUB' FLAG K33 DEC 33 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 * A?* **************** 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 K28 DEC 28 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 * ************************** * * CHECK STATEMENT NUMBER * * ************************** SPC 1 CSN.F NOP AND B40 BIT 5 = TYPE BIT. XOR B,I SET TYPE BIT OR CHECK IT. ALF,ALF CHECK DEFINED FLAG. CCE (SET DEFINE BIT) RAL,ELA E = DEFINE BIT. ALF,RAL RESTORE POSITION. RAL SEZ,RSS WAS IT DEFINED ? STA B,I NO. SET TYPE & DEFINE BIT. AND B40 GET TYPE DIFFERENCE (IF WAS DEF) SEZ IF NEW DEFINITION SZA,RSS OR OLD BUT SAME TYPE JMP CSN.F,I THEN O.K., SO EXIT. LDA K32 ELSE ERROR 32. JSB ER.F 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 BUAFFER 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 SZB OVERFLOW ? JMP RPLOV YES. STA MPYT1 SAVE LOW PART OF PRODUCT (HIGH BETTER BE ZERO) 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 SEZ,SSB,RSS OVERFLOW ? JMP MPY.F,I NO, RETURN. JMP RPLOV YES, ERROR. * MPYT0 NOP MPYT1 NOP END qNLHHNASMB,Q,C HED INPUT GROUP FOR FTN4 COMPILER NAM IC.F,8 92060-16092 REV.2026 800423 * * 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. * *************************************************************** * NAME: IC.F, PART OF FTN4, PART OF FTN4 COMPILER. * * SOURCE: PART OF 92060-18092 * * RELOC: PART OF 92060-16092 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) ENT F.ABT ABORT COMPILE EXTRY EXT F.ACC TEMP ACCUMULATOR FLAG 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.D DO TABLE POINTER 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.E EQUIVALENCE TABLE POINTER EXT F.END END FLAG ENT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG ENT F.ERF ERROR FLAG (# OF ER.F CALLS) ENT F.ERN ERROR ARRAY EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) 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 ENT F.LOP NO. LINES LEFT ON THIS PAGE. ENT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSP LAST OPERATION FLAG ENT F.NCR NO CROSS REF FLAG EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NTF NAME TAG FLAG ENT F.NXN NO INPUT FLAG ENT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.RPL PROGRAM LOCATION COUNTER ENT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.SEG LOAD A NEW SEGMENT EXT F.SID STATEMEXT ID PHASE FLAG EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ ENT F.SVL SAVE # WORDS ON OPER STACK (F.L) EXT F.T # WORDS ON STACK 1 ENT F.TC NEXT CHARACTER ENT F.TIM TIME ARRAY ADDRESS IN HEAD ENT F.TRM TERMINATE COMPILE * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * 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) ENT CRP.F CROSS REF PAIR SUB. EXT CRT.F TEST FOR CARRAGE RETURN EXT CSN.F CHECK STATEMENT NUMBER TYPE. ENT EJP.F PAGE EJECT SUBROUTINE ENT ER.F ERROR PRINT SUBROUTINE ENT EXN.F EXAMINE NEXT CHARACTER 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) ENT II.F INPUT ITEM ENT IIV.F INPUT INTEGER VARABLE ENT IN6.F INIT FOR IC.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 NCT.F TEST FOR NOT A CONSTANT EXT OW.F OUTPUT WORD EXT PAK.F PACK SUBROUTINE ENT PSL.F PRINT LINE ON PRINTER ENT SCP.F SAVE CURREXT STATPMEXT POSITION. ENT SKL.F SKIP LINES ON LIST ENT SNC.F START NEXT CARD SUBROUTINE EXT TV.F TAG VARIABLE ENT UC.F UNINPUT COLUMN ENT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * COMPILER LIBRARY ROUTINES USED * 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 K49 DEC 49 * * INITIALIZE THIS MODULE * IN6.F NOP STB CRD#1 SET CARD BUFFER POINTER ADB K49 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 CLmEAR THE LOCAL CARD BUFFERS STA CD#2 ALSO SET STA PGNUM THE PAGE NUMBER BACK TO ZERO STA LDADR AND THE PRINTED LOAD ADDRESS 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 CARD 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,I SO WE CAN GET IT BACK DEF K43 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 STB DCD# SET LOCAL POINTER TO CARD #. ISZ DCD# LDB B,I GET POINTED TO ADDRESS. STB LINOL SAVE THE LINE NUMBER LOCATION IN BUFF. ADB K3 SKIP OVER LINE NUMBER. LDA F.CCW 'Q' OPTION ? AND B4000 SZA ADB K3 YES. SKIP OVER LOAD ADDRESS. STB CBA SET CURREN.T BUFFER ADDRESS. ADB K41 INDEX TO CARD LENGTH AREA. STB CICNT SET POINT TO IT. INB AND TO THE LINE COUNT. STB MLIN LDB LDADR (OLD LOAD ADDRESS) SZA 'Q' ? JSB CLA.F YES. CONVERT LOAD ADDRESS. 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 COUNT FROM READ LDA LINOL COMPUTE EXTRA LENGTH AT START. CMA,INA DUE TO LINE # & LOAD ADDR. ADA CBA ADA B INCLUDE THIS IN WORD COUNT. STA 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 LDA MLIN,I GET THE COUNT PASSED IN SSA IF NEGATIVE JMP RD06 TREAT CARD6 AS A COMMENT * LDA CD# STUFF THE CURRENT CARD NUMBER STA DCD#,I IN THE BUFFER FLAG 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 KK06 '*' ALSO COMMENT. JMP RD06 * 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 SZA CONTINUATION ? JMP RD.F,I NO. DON'T PRINT IT. JSB PSI.F YES. PRINT. CLB,INB IF FIRST CARD CPB FIRST THEN CLA,RSS ERROR. 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 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 JSB PSI.F PRINT IT JMP RD00 AND READ ANOTHER CARD * "D" OCT 42000 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 K43 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 K7 OCT 7 KM7 DEC -7 K2 DEC 2 K40 DEC 40 K41 DEC 41 K67 DEC 67 K90 DEC 90 KK06 BYT 52,0 '*' IN HIGH BYTE. KK07. OCT 177400 KK08 BYT 103,0 'C' IN HIGH BYTE. KK09 BYT 44,0 '$' IN HIGH BYTE. 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 ISZ 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 * 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 * 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. DST ERBFY ALSO IN ERROR BUFFER JSB SOU.F PASS IT THRU IF 'M' OPTION. LDA F.CCW CHECK IF WE ARE TO LIST IT SLA,RSS WELL? JMP PSI01 NO, GO FIX "D". * LDA CICNT,I # OF WORDS+2 IN IMAGE LDB LINOL LOC OF LINE # JSB PSL.F LIST THE CARD * PSI01 LDA CBA,I IF "D" IN COL 1, CHANGE TO BLANK. LDB A AND KK07. UPPER BYTE. ADB KK01 + " " - "D" IN UPPER. CPA "D" WAS IT "D" ? STB CBA,I YES, CHANGE TO BLANK. JMP PSI.F,I RETURN SPC 2 KK01 BYT 334,0 " " - "D" IN UPPER BYTE. K43 DEC 43 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.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 JSB IC.F SET UP THE LINE. JSB UC.F LDB F.RPL LOAD ADDRESS. LDA F.CCW 'Q' OPTION ? AND B4000 yHFBSZA H JSB CLA.F YES, CONVERT LOAD ADDRESS. JSB PSI.F PRINT IT NOW. JMP SNC.F,I RETURN * B4000 OCT 4000 SPC 2 CLA.F NOP CONVERT LOAD ADDRESS INTO CARD BUFFER. STB LDADR SAVE VALUE. LDA LINOL SET UP ADDRESS. ADA K3 STA T1CLA CLA CONVERT. AFTER EACH LINE, (B,A) = RRR 12 00000000 00000111 22233344 45550000 BLF,RBL 00000000 11100000 22233344 45550000 RRL 6 00111000 00222333 44455500 00000000 ALF,ALF 00111000 00222333 00000000 44455500 ALF,RAR 00111000 00222333 00000444 55500000 RRR 3 00000111 00000222 33300000 44455500 BLF,RBL 11100000 22200000 33300000 44455500 LSR 5 00000111 00000222 00000333 00000444 ADB "00" DIGITS 1 & 2. ADA "00" DIGITS 3 & 4. STB T1CLA,I ISZ T1CLA STA T1CLA,I ISZ T1CLA LDA LDADR NOW DO LAST DIGIT & BLANK. AND K7 IOR "0" BLANK,DIGIT ALF,ALF DIGIT,BLANK. STA T1CLA,I JMP CLA.F,I EXIT * T1CLA BSS 1 POINTER TO ASCII LOADR ADDR. LDADR BSS 1 CURRENT PRINTED LOADR ADDR. "0" ASC 1, 0 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 REWI ND 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 STA ICK1 JSB WRT.C WRITE THE RECORD DEF C.SC1 ON THE SCRATCH FILE DEF LINOL,I DEF ICK1 JMP PASER IF ERROR GO REhPORT 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 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 SAVE 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,RSS ALPHANUM ? SZB,RSS YES. DIGIT OR LETTER ? JMP IA.F,I NOT LETTER. EXIT. * ISZ T0IA LETTER. 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 * **************** * T * 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 * * ************************** * * ENTER WITH A = TYPE: -1 = FORMAT. * 0 = DON'T CARE. * +1 = NON-FORMAT. SPC 1 ISN.F NOP STA T3ISN SAVE TYPE. 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 ZESRO AND NOT PART OF THE JMP ISN07 STATEMENT NUMBER. (IC.F BUMMPED THE 6 TO 7) * SZB,RSS DIGIT? JMP ISN04 YES * 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 T3ISN TYPE. LDB F.A SZA DO WE CARE ? JSB CSN.F YES. CHECK IT OUT. 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 T3ISN BSS 1 TYPE. 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 DERBV 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 DERBV DEF ERBFV ADDRESS LOCATION IN ERROR BUFFER. HDLP7 DEF HEADN SKP * ********************** * * CATASTROPHIC ERROR * * ********************** SPC 1 * TO PRINT ERROR MESSAGE & SCAN NEXT STATEMENT * INPUT: (A)=ERROR TYPE SPC 1 ER.F NOP d CPA K84. DATA / CODE OVERFLOW ? JMP F.ABT YES, PUNT. 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 JSB CCR.F (CHANGE C/R TO BLANK) STA B,I END LDA T0WAR FOR PRINTING JSB CCR.F (CHANGE C/R TO BLANK) 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 * LDA B,I YES. CHANGE (POSSIBLE) MIDDLE WORD. JSB CCR.F STA B,I 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 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 N@OTHING 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 ERROR TYPE SPC 2 CCR.F NOP CHANGE C/R IN EITHER CHAR TO BLANK. STA T1CCR SAVE DATA. AND B377 2ND CHAR. CPA B15 IF C/R, LDA B40 CHANGE TO BLANK. STA T2CCR SAVE 2ND CHAR. LDA T1CCR GET 1ST CHAR. AND BM400 CPA B6400 IF C/R, LDA B20K CHANGE TO BLANK. IOR T2CCR MERGE 2ND CHAR. JMP CCR.F,I EXIT. * T1CCR NOP T2CCR NOP BM400 OCT 177400 MASK OVER UPPER CHAR. B6400 BYT 15,0 C/R IN UPPER BYTE. B20K BYT 40,0 BLANK IN UPPER BYTE. SPC 2 BOM.F NOP DISASTER DETECTED SET UP THE MESSAGE ISZ F.ERN STEP THE DISASTER COUNT JSB WAR.F BY CALLING WAR.F JMP BOM.F,I EXIT SPC 1 F.LPR NOP '(' ADDRESS IN EQUIV STMT. F.RPR NOP ')' ADDRESS IN EQUIV. STMT. F.SVL NOP NO WORDS IN STACK 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 JS'B PD.F MAKE TWO ASCII DIGITS STA ERBFX ERROR TYPE STA F.LSP SET LAST OPERATION FLAG CLA SKIP A LINE. JSB SKL.F LDA F.CC SEE IF COLUMN IS NEGATIVE, ZERO OR ONE. ADA KM2 F.CC - 2 SSA,INA WELL ? (F.CC - 1) JMP WARN3 YUP. JUST MESSAGE. * LDB CBA GET CURRENT CARD LENGTH ADB K41 (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 ERBFZ ERROR COLUMN * 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 DWARN ASSUME "WARNING" LDB ER.F CALL FROM ER.F?? SZB LDA DERR0 YES. "ERROR" LDB BOM.F CALL FROM BOM.F?? SZB LDA DDISA YES. "DISASTR" CLB RESET ER.F FLAG. STB ER.F LDB DERBW JSB .MVW DEF K4 NOP LDA K27 (LENGTH IF COL COUNTER) LDB F.CC IF F.CC < 01 ADB KM2 SSB THEN LDA K22 m 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 JMP WAR.F,I * DERBW DEF ERBFW ADDRESS OF ERROR/WARNING/DISASTR DERR0 DEF *+1 ASC 4, ERROR DWARN DEF *+1 ASC 4,WARNING DDISA DEF *+1 ASC 4,DISASTR SPC 1 WAR02 LDA B,I GET THE WORD XOR "?" CNANGE LOWER CHAR TO "?" AND B377 ISOLATE THE UPPER CHARACTER XOR B,I JMP WAR03 * T1WAR NOP "?" OCT 77 "?B" ASC 1,? SPC 2 ERCK1 DEF *+1 ADDRESS OF ERROR MESSAGE. ASC 02, ** ERBFV ASC 04,FTN. ** ERBFW ASC 04,WWWWWWW ERBFX ASC 10,XX DETECTED AT LINE ERBFY ASC 06,0000 COLUMN ERBFZ ASC 01,ZZ K22 DEC 22 LENGTH INCLUDING "COLUMN ZZ" K27 DEC 27 LENGTH WITHOUT IT. 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 lHFBBHASMB,Q,C HED STATEMENT PROCESSORS FOR FTN4 NAM EX.F,8 92060-16092 REV.2026 800423 * * 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. * *************************************************************** * NAME: EX.F, PART OF FTN4, PART OF FTN4 COMPILER. * * SOURCE: PART OF 92060-18092 * * RELOC: PART OF 92060-16092 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) ENT F.ASS ASSIGNMEXT STATEMEXT PROCESSOR EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.AT ADDRESS TYPE OF CURRENT F.A ENT F.CAL CALL STATEMEXT PROCESSOR EXT F.CC CHARACTER COUNT EXT F.D DO TABLE POINTER EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D2 DIMENSION 2 EXT F.D3 DIMENSION 3 EVXT F.DEF DATA EXISTS FLAG EXT F.DLF DELIMETER FLAG EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DO LWAM - END OF DO TABLE ENT F.DOP DO STATEMEXT PROCESSOR EXT F.DP BASE OF USER SYMBOL TABLE ENT F.GOP GO TO STATEMENT 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.L # WORDS ON STACK 2 EXT F.LFF LOCICAL IF FLAG EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSP LAST OPERATION FLAG EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.R JSB ERR0 FLAG ENT F.RDP READ STATEMEXT PROCESSOR EXT F.RPL PROGRAM LOCATION COUNTER EXT F.S2B BOTTOM OF STACK 2 EXT F.S2T TOP OF STACK 2 EXT F.SBF 0= MAIN, ELSE SUBROUTINE ENT F.SFP STATEMEXT FUNCTION PROCESSOR EXT F.SRL SAVE RPL AT BEGINNING OF RECORD EXT F.STB STRING BACK JUMP FLAG EXT F.STS TO STATEMEXT SCAN EXT F.SXF COMPLEX CONSTANT FLAG EXT F.TC NEXT CHARACTER 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 AI.F ASSIGN ITEM EXT CRT.F TEST FOR CARRAGE RETURN EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION 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 ENT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GPE.F GENERATE SUB. PROG. EXTRANCE EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT ENT IFT.F IF GOTO COMPLETION EXT II.F INPUT ITEM EXT IIV.F INPUT INTEGER VARABLE ENT IN5.F INIT FOR EX.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 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 ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PDF.F PRODUCE DEF SUBROUTINE EXT RP.F INPUT ')' EXT SCP.F SAVE CURREXT STATPMEXT POSITION. 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 SEGMENT * EXT EE.F EXPRESSION EVALUATOR EXT GIM.F GET ITEM MODE 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 * ********d*********** * * IF ( PROCESSOR * * ******************* SPC 1 F.IFP JSB EE.F EXPRESSION EVALUATOR 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 CLA,INA INPUT FIRST STMT # (NOT FORMAT) JSB ISN.F LDA JMP. JSB OA.F OUTPUT JMP TO IT LDA B54 , JSB TCT.F CLA,INA INPUT SECOND STMT # (NOT FORMAT) JSB ISN.F 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 # CLA,INA INPUT THIRD STMT # (NOT FORMAT) JSB ISN.F 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 CLA,INA INPUT STMT # (NON-FORMAT) JSB ISN.F 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 NOuT 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 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 JSB 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 * * ********************* 6 SPC 1 IBL.F NOP CLA STA T1IBL T1=0 JSB ICH.F INPUT CHAR. LDA B50 '(' JSB TCT.F F.TC-TEST IBL02 CLA,INA INPUT STMT # (NON-FORMAT) JSB ISN.F 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 CLA,INA INPUT STMT # (NON-FORMAT) JSB ISN.F 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 B15 OCT 15 K50 DEC 50 K51 DEC 51 B75 OCT 75 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 F.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 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 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 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 B51 ')' RSS JMP IOL53 ILLEGAL DELIMITER * JSB ICH.F SKIP THE ')', GET NEXT. 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. CCA INPUT STMT # (FORMAT) JSB ISN.F ISZ F.CC 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 JM~P 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 * * ******************************** SPC 1 IOL.F NOP READ() OR WRITE() 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) NLH 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 }NCPX 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 K48 DEC 48 K63 DEC 63 SKP * * * * I/O STATEMENT LIST PROCESSOR, CONTINUED * * VARIABLE ARRAY SIZE; GENERATE SIZE CALC. CODE. * IOL03 LDA T0IOL EMA VAR DIM ? STA F.A JSB EA?.F JMP IOL3A NO. LDA K48 YES. ERROR. JSB ER.F * IOL3A 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 OUTPaUT 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 OR -F.A OF DEF. ADB K2 INDEX TO THE HIGH ORDER WORD LDB B,I GET IT (OR -F.A OF 2ND TEMP) SSB,RSS CONSTANT OR TEMP ? JMP IOL18 CONSTANT. * CMB TEMP. (B)=F.A CLA GENERATE DEF TO IT. JSB SOA.F JMP IOL19 GO HANDLE LENGTH. * IOL18 CLE,ERB CONVERT TO A RAL,ERA STD. DOUBLE INTEGER JSB DTR.F SEND DEF TO ESTABLISHED REAL CONSTANT * IOL19 DLD T3IOL GET THE NUMBER OF ELEMENTS TO DO RAL RE-FORMAT TO STD REVERSED DBL INT. LSR 1 CMB NEGATE. CMA,INA,SZA,RSS INB 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 = SARRAY, 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 IMPLIED 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 SPC 1 **************************** INDEXS INTO FIX-ENT TABLE ***??? .MPY DEF .TBL+5 FIX-POINT MPY .XIO. DEF .TBL+30 DOUB}LE 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 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 AG.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 LDB F.M3 'ADA F.M3' LDA ADAI JSB SOA.F LDA STAI 'STA' LDB CONTR STA I JSB SOA.F LDA NEGI CMA,INA JSB OAI.F LDB F.M2 'ADA F.M2' LDA ADAI JSB SOA.F LDB F.M3 (B)=F.M3 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 JMP 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 * e 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 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! N* 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 NEXT 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 LDA DUM JSB DAT.F DEFINE AT(F.A)=DUM ISZ F.ARF F.ARF=F.ARF+1 LDA F.RPL JSB DAF.F DEFINE AF(F.A)=RPL 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 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 aNLHFUNC 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 K76 DEC 76 K74 DEC 74 DUM OCT 5000 AT=5 ORG * END NASMB,Q,C HED FTN STATEMENT PROCESSORS STMTS WITHOUT EXPRESSIONS NAM NEX.F,8 92060-16092 REV.2001 791101 * *************************************************************** * (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. * *************************************************************** * NAME: NEX.F, PART OF FTN4, PART OF FTN4 COMPILER. * * SOURCE: PART OF 92060-18092 * * RELOC: PART OF 92060-16092 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) ENT F.ASP ASSIGN STMT. PROCESSOR EXT F.AT ADDRESS TYPE OF CURREXT F.A ENT F.BSP BACKSPACE STMT. PROCESSOR EXT F.CC CHARACTER COUNT ENT F.CON CONTINUE STMT. PROCESSOR ENT F.EFP ENDFILE STMT. PROCESSOR ENT F.FMT FORMAT STMT. PROCESSOR EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.LFF LOCICAL IF FLAG EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSN9 F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.OPF OUTPUT PACK FLAG ENT F.PAP PAUSE STMT. PROCESSOR ENT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER ENT F.RTN RETURN STMT. PROCESSOR ENT F.RWP REWIND STMT. PROCESSOR EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 ENT F.STP STOP STMT. PROCESSOR EXT F.TC NEXT CHARACTER * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AI.F ASSIGN ITEM EXT CID.F CLEAR F.ID ARRAY EXT CDI.F CLEAR IDI ROUTINE EXT CRT.F TEST FOR CARRAGE RETURN EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT ESD.F ESTABLISH DEF SUBROUTINE EXT IC.F GET NEXT CHARACTER EXT ICH.F GET NEXT NON BLANK CHAR. AND TYPE IT EXT IDS.F INPUT DIGIT STRING EXT IIV.F INPUT INTEGER VARABLE ENT IN3.F INIT FOR ENX.F MODULE EXT IOP.F INPUT OPERATOR EXT ISN.F INPUT STATEMEXT NUMBER EXT ITS.F INTEGER TEST EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PAK.F PACK SUBROUTINE ENT PTM.F PROGRAM TERMINATION CODE GEN. ENT RTN.F SUBROUTINE RETURN HANDLER EXT SOA.F STORE AND OUTPUT (OA.F) EXT TCT.F TEST (A) = F.TC ELSE ER 28 EXT TV.F TAG VARIABLE 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 * * LIBRARUY EXTERNALS * * A EQU 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, BACKSPLACE, 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 * CPB B42 '"'? JMP FMTP6 CPB B47 "'" ? 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 STB COUNT MUST MATCH SAME TYPE QUOTE. FMTP0 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 COUNT CLOSE QUOTE? JMP FMTP2 YES GET NEXT ELEMENT JMP FMTP0 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.Fj< 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 " B47 OCT 47 ' 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 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 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' 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' JMP RTN.F,I * F.REL NOP SUBPROG RETURN LOCATION .DLD DEF .TBL+7 DOUBLE LOAD 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 * * * *********************************** * * 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 CLA INPUT ANY KIND OF STMT #. JSB ISN.F 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.{0.*F INPUT CHARACTER LDA K79 'O' JSB TCT.F F.TC-TEST JSB IIV.F INPUT INTEGER VARIABLE LDA K37 LDB F.AT CPB DUM JSB WAR.F ILLEGAL USAGE OF DUMMY VARIABLE JSB MAP.F GEN $EMAP CODE IF REQUIRED STA T1STF SET A.T. POINTER FOR LATER LDA LDA.. GEN A LDA LDB T0STF OF THE DEF JSB SOA.F LDB T1STF NOW LDA STAI. 'STA' JSB SOA.F OUTPUT OA (STA) JMP CRT.F C/R TEST * STAI. OCT 72000 K37 DEC 37 DUM OCT 5000 AT=5 T0STF NOP SAVE ASSI PTR OF STMT FUNC NAME T1STF NOP END 0ASMB,Q,C HED FTN4 COMPILER CODE OUTPUT TO PASS 2 NAM OA.F,8 92060-16092 REV.2001 791101 * *************************************************************** * (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. * *************************************************************** * NAME: OA.F, PART OF FTN4, PART OF FTN4 COMPILER. * * SOURCE: PART OF 92060-18092 * * RELOC: PART OF 92060-16092 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ABT ABORT COMPILE EXTRY EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.BUF A BUFFER ENT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.D DO TABLE POINTER EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.D0 ARRAY ELEMEXT SIZE EXT F.DID ADDRESS OF F.IDI EXT F.DO LWAM - END OF DO TABLE EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.IU CURREXT ITFEM USAGE (DUM., RELATIVE, ECT.) ENT F.LLO CURRENT RELOCATAION ADDRESS(TWO WORDS) EXT F.NT NAME TAG 0 = VAR, 1 = CONSTANT. EXT F.RPL PROGRAM LOCATION COUNTER EXT F.SLF STATEMEXT LEVEL FLAG ENT F.SRL SAVE RPL AT BEGINNING OF RECORD * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT DAF.F DEFINE (F.AF) EXT DL.F DEFINE LOCATION SUBROUTINE EXT FA.F FETCH ASSIGNS ENT GPE.F GENERATE SUB. PROG. EXTRANCE ENT IN2.F INIT FOR OA.F MODULE ENT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND ENT OAI.F OUTPUT ABS. INSTRUCTION ENT OC.F OUTPUT CONSTANT ENT ODF.F OUTPUT DOT FUNCTION ENT OLR.F OUTPUT LOAD ADDRESS ENT OMR.F OUTPUT MEMORY REF. INSTRUCTION ENT OS.F OUTPUT SECTOR TO INTERPASS FILE ENT OW.F OUTPUT WORD ENT OZ.F OUTPUT ZREL (OP *+N) ENT PDF.F PRODUCE DEF SUBROUTINE ENT SOA.F STORE AND OUTPUT (OA.F) * * * COMPILER LIBRARY ROUTINES * EXT WRT.C WRITE RECORD EXT C.SC1 SCRATCH FILE CONTROL BLOCK * A EQU 0 B EQU 1 .TBL EQU 0 SPC 1 ADDR OCT 70000 F.IM=7 ADDRESS SPC 1 * SKP * ******************************************* * * OUTPUT ASSIGNMENT TABLE POINTER OPERAND * * ******************************************* SPC 1 OA.F NOP STA T0OA TEMP CELL TO HOLD OPCODE WORD LDB F.A IF F.A IS SZB ZERO THEN PRODUCE AN CPB K1 (ONE ALSO) JMP OA03A ABSOLUTE INSTRUCTION * JSB FA.F NO, F.A POINTS TO ASSIGN. TABLE LDA T0OA GET THE OP CODE LDB F.IM IF THIS IS ADB F.NT A DEF ENTRY CPB SIGN THEN SKIP THE REST OF THE CHECKS JMP OA015 AND PUT OUT THE CODE * LDB F.AT CPB DUM IS OPERAND TAGGED DUMMY? CCE,RS+S YES SKIP JMP OA01 NO. * ELA,RAR IN THE FIRST WORD INST. STA T0OA SAVE THE NEW INSTRUCTION LDA F.SLF IF PROCESSING A STMT. FUNCTION CPA K3 THEN WE MUST LOOK FOR LOCAL DUMMYS RSS YES IT IS A STMT. FUNCTION JMP OA00 NO NOT STMT. FUNCTION SEND TBL REF. * LDB F.D MUST SCAN THE DO TABLE FOR LOCAL OA1 CPB F.DO DUMMYS JMP OA00 NOT IN TABLE SO SEND STD. TBL. REF. * ADB K3 INDEX TO THE LOCALS F.A LDA B,I GET IT CPA F.A THIS THE CURRENT ONE? JMP OA2 YES DO SPECIAL CODE * INB NOT THIS ONE TRY JMP OA1 THE NEXT ONE * OA2 LDA T0OA RESTORE THE INSTRUCTION AND SEND TRUE ADDRESS OA.F5 LDB F.AF SET (B) = F.AF AND JMP OA02 OUTPUT INSTRUCTION. * OA03A SZA,RSS IF DEF THEN USE NOP (OR 1) JMP OA04 * AND C2000 CLEAR THE CURRENT PAGE BIT IOR SIGN AND SET THE INDIRECT BIT ADA F.A IF B REG SET IT UP OA04 JSB OAI.F SEND ABS INSTRUCTION JMP OA.F,I RETURN SPC 1 OA01 LDA F.IU CPA SUB IS OPERAND AN EXTERNAL NAME JMP OA03 YES, GEN. EXT. REF. INSTRUCTION * LDB F.AT IS OPERAND CPB BCOM LABELED COMMON? JMP OA10 YES GO DO SPECIAL * LDA T0OA LOAD FIRST WORD OF INSTRUCTION CPB COM. IN COMMON? ADA K2 YES, SET BIT 2 OF FIRST WORD ON. LDB F.IM DOES OPERAND HOLD CPB ADDR ARRAY ELEMENT ADDRESS? JMP OA05 YES GO CHECK IF DEF * OA07 LDB F.IU IS OPERAND CPB ARR AN ARRAY NAME? JMP OA.F5 YES, OUTPUT INSTR. WITH RPL OA015 LDB F.A NO, OUTPUT THE ADB KK01 INSTRUCTION WITH (B) _ F.A,I OA02 JSB OMR.F JMP OA.F,I * OA05 IOR KK01 ADD THE SIGN BIT CPA KK01 IF IT IS A DEF RSS SKIP TO DEFINEɖ IF POSSIBLE JMP OA07 * JSB DL.F SET F.AT TO REL LDA F.LLO GET THE CURRENT LOAD ADDRESS SSA,RSS IF DIRECT ADA ADON GET THE ACTUAL ADDRESS JSB DAF.F DEFINE ADDRESS OF ADCON LDA F.LLO GET THE BASE ADDRESS AGAIN LDB ADON IF A SYMBOL TABLE POINTER SSA,RSS THEN WE MUST CLB (NO USE ZERO) LDA F.A INCLUE THE OFFSET ADA K2 SET THE NAME STB A,I IN THE A.T. LDA KK01 RESTORE THE DEF ,I JMP OA015 GO SEND IT * OA00 LDA T0OA GET INSTRUCTION JMP OA015 GO SEND IT AS POINTER ADDRESSED SPC 1 OA03 LDB F.A F.IU IS SUBPROG; GEN. EXT. REF. INB (B) POINTS TO AF FOR JSB GETEX GET EXT NO FOR IT JMP OA00 GO SEND * OA10 LDB F.AF LABELED COMMON REF. INB GET INFO. ENTRY ADDRESS LDA B,I GET OFFSET ADA F.C ADD THE THE CURRENT OFFSET STA F.C AND SAVE IT INB GET ADDRESS OF LDB B,I THE EXT NO INB AND JSB GETEX GO SET IT UP ADB N1PS SUBTRACT ONE AND ADD THE SIGN LDA T0OA AND THE INSTRUCTION JSB OW.F PUT OUT A R111 OCT 160000 R=111 3- WORD EXT WITH OFFSET JMP OA.F,I RETURN * T0OA BSS 1 COM. OCT 4000 F.AT=COM C2000 OCT 175777 COMPLEMENT OF 2000 (THE CURRENT PAGE BIT) K1 DEC 1 DUM OCT 5000 AT = 5 SUB OCT 200 IU = 1 ARR OCT 600 IU = 3 K2 DEC 2 B10 OCT 10 BCOM OCT 3000 F.AT=BCOM SIGN DEF 0,I NT=1,IM=0 => 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 * WR 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 * ************************ * * 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 FIRST 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 * EP 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.zC 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 RPTR BSS 1 RECORD R1R2R3R4R5 LOCATION RNO BSS 1 R NUMBER KM5. DEC -5 T0OW BSS 1 SAVE ENTRY (A) T1OW BSS 1 SAVE ENTRY (B) R BSS 1 INTERMEDIATE CODE RECORD TYPE K3 DEC 3 KM63 DEC -63 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 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 uP<:66<  92060-18093 1913 S C0122 &FFTN4 FTN4 SEGMENT ID SUB.             H0101 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. 1913 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 4  92060-18094 2026 S C0322 &0FTN4 SEGMENT 0             H0103 9ASMB,Q,C HED ** 16K FTN4 COMPILER (SEG: F4.0) SPECIFICATION STATEMENTS ** NAM F4.0,5 92060-16094 REV.2026 800423 * ***************************************** * 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. * *************************************************************** * NAME: F4.0, PART OF FTN4 COMPILER. * * SOURCE: 92060-18094 * * RELOC: 92060-16094 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ABT ABORT COMPILE EXTRY EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.ARF NO. OF SUB. FUN. ARGUMEXTS EXT F.AT ADDRESS TYPE OF CURREXT F.A  EXT F.AT. SUBSCRIPT INFO FLAG EXT F.BGN RETURN FROM F4.0 EXT F.CC CHARACTER COUNT EXT F.CIN CURREXT CI BUFFER LINE NUMBER EXT F.CLN INPUT ITEM CURREXT LINE # EXT F.CSZ COMMON SIZE EXT F.D DO TABLE POINTER EXT F.D0 ARRAY ELEMEXT SIZE EXT F.D1 DIMENSION 1 EXT F.D2 DIMENSION 2 EXT F.DCF DIM, COM FLAG EXT F.DEF DATA EXISTS FLAG EXT F.DID ADDRESS OF F.IDI EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE 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.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.EQE EQUVALENCE ERROR FLAG EXT F.EQF EQUIVALENCE FLAG EXT F.EXF EXTERNAL STATEMEXT FLAG EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.INT TEMP VARIABLE ARRAY EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.L # WORDS ON STACK 2 EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LPR ( LOC OF EQUIVALENCE GROUP EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.MFL TYPE STMT. MODE FLAG EXT F.ND NUMBER OF DIMENSIONS EXT F.NEQ # OF EQUIVALENCE GROUPS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.OPF OUTPUT PACK FLAG EXT F.PAK PACK BUFFER WORD EXT F.RPL PROGRAM LOCATION COUNTER EXT F.RPR ) LOC OF EQUIVALENCE GROUP EXT F.S02 RETURN FORM RCOM |F.1 EXT F.S03 LOAD F.1 AND PASS CONTROL 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.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SLF STATEMEXT LEVEL FLAG EXT F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL EXT F.SPS STATEMEXT PROCESSOR SWITCH EXT F.SXF COMPLEX CONSTANT FLAG EXT F.TC NEXT CHARACTER EXT F.TYP TYPE STATEMEXT FLAG * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT BNI.F CLEAR NID TO BLANKS 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 ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT EXN.F EXAMINE NEXT CHARACTER EXT FA.F FETCH ASSIGNS EXT FXC.F CHECK IF SUB. IN FIX-EXT TABLE EXT GNA.F GET NEXT SYMBOL TABLE EXTRY 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 IN6.F INIT FOR IC.F MODULE EXT INM.F INPUT NAME EXT IOP.F INPUT OPERATOR EXT ISY.F INPUT SYMBOL EXT ITS.F INTEGER TEST EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) 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 OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT OLR.F OUTPUT LOAD ADDRESS EXT OW.F OUTPUT WORD EXT PAK.F PACKK SUBROUTINE EXT RP.F INPUT ')' EXT SCC.F SAVE F.CC SUBROUTINE 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) * * ENT F.COM ENT F.CPX ENT F.DAT ENT F.DBL ENT F.DIM ENT F.EMP ENT F.EQU ENT F.EXT ENT F.FUN ENT F.IMP IMPLICIT PROCESSOR ENT F.INP ENT F.LOG ENT F.PRO ENT F.RCO ENT F.REA ENT F.SUB ENT F.BLK SPC 1 * * * * * * COMPILER LIB. ROUTINES * EXT GMS.C GET SEGMENT FREE MEMORY BOUNDS * * * OTHER LIB ROUTINES * EXT .MVW * A EQU 0 A-REGISTER B EQU 1 B-REGISTER SUP SPC 1 DEC 0 OVERLAY # SKP * *-----------------------* * * START HERE. * * *-----------------------* * F4.0 LDA F.DNB ADA K9 STA PROK1 LDA F.SLF IF BACK IN TO DO CPA K2 A DATA STATEMENT JMP F.DAT JUST GO DO IT * LDA F..DP SET UP TO MOVE THE ADA KM98 ADJUST FOR CARD BUFFER STA FL.F SAVE IT FOR A WHILE CMA,INA SYMBOL TABLE DOWN TO ADA F.LO ITS FINAL RESTING PLACE STA F4.0 SAVE ITS CURRENT SIZE LDA FL.F CURRENT LOCATION TO A LDB F.IDI FINAL LOCATION FROM F4.4 TO B ADB KM98 ADJUST FOR CARD BUFFER STB FL.F SAVE IT JSB .MVW DO MOVE WORDS DEF F4.0 NUMBER OF WORDS NOP LDA F..DP NOW COMPUTE CMA,INA THE DISTANCE ADA F.IDI MOVED LDB F..DP AND ADJUST ADB A THE POINTERS STB F..DP FOR THE NEW LOCATION LDB F.LO ADB A STB F.LO STB F.S2B STB F.S2T ST8ACK POINTERS TOO ADA F.DP ADJUST USER ORGIN ALSO STA F.DP DONE SO CONTINUE WITH REAL WORD CCA,CLE NOW TELL LDB FL.F WHERE THE CARD BUFFER IS JSB IN6.F TO THE ONE WHO MUST KNOW * JSB GMS.C GET START OF FREE MEMORY STA F.LLT AND SET FOR EQU X-REF. JMP F.BGN BACK TO READ THE FIRST CARD SPC 1 K9 DEC 9 KM98 DEC -98 PROK1 NOP PROGRAM TYPE CODE POINTER SPC 2 * ************** * * FETCH LINK * * ************** SPC 1 FL.F NOP STB F.A LDA B,I AND KK04 CPA ARR INB,RSS IU(F.A)=ARR RSS LDB B,I (B)=GF(F.A) XOR F.A,I GET THE AND B7000 AT FIELD CPA BCOM IF A BLOCK COMMON INB,RSS ELEMENT RSS INDEX ONE LDB B,I MORE LEVEL INB LDA B,I STA NXL NXL=GF(B) JMP FL.F,I SPC 1 NXL BSS 1 NEXT LINK LOCATION KK04 OCT 600 EXTRACT F.IU FIELD B7000 OCT 7000 EXTRACT F.AT FIELD. SKP * ************ * * EXTERNAL * * ************ SPC 1 F.EXT CLA,INA STA F.EXF SET EXT FLAG JSB INM.F INPUT NAME LDB F.AT DUMMY ? CPB DUM RSS JMP EXT01 NO. LDA F.AF,I EMA DUMMY ? AND B7000 LDB A LDA K22 CPB BCOMI JSB ER.F YES, ERROR 22. EXT01 JSB TS.F TAG SUBPROGRAM SPC 1 * ***************** * * , OR C/R TEST * * ***************** SPC 1 CCRT CLB STB F.LSF CLEAR THE EXPECT FIRST STMT. FLAG STB F.EFG CLEAR E FLAG LDA F.TC CPA B54 ',' ? JMP F.SPS,I YES. MORE TO PROCESS * CPA B57 IF A '/' JMP CCRT1 GO TEST IF COMMON STMT. * CCRT0 STB F.EXF CLEAR EXTERNAL FLAG JMP CRT.F C/R TEST  SPC 1 CCRT1 LDB F.SPS GET COMMON FLAG CPB COMK1 IF COMMON JMP COM04 GO PROCESS NEW LABEL * JMP CCRT0 ELSE IT IS AN ERROR * K22 DEC 22 B54 OCT 54 SPC 2 * ****************** * * EXCHANGE LINKS * * ****************** SPC 1 * EXCHANGE AF(F.A) & AF(F) SPC 1 EL.F NOP LDA F.A STA T1EL LDB F OLD LINK ADDRESS TO B JSB FL.F FETCH LINK STB T1LF LINK FIELD LDB T1EL SWAP POINTERS STA T1EL JSB FL.F FETCH LINK STA T1LF,I SET CURRENT IN OLD LDA T1EL AND OLD IN STA B,I CURRENT JMP EL.F,I SPC 1 T1EL BSS 1 T1LF BSS 1 F BSS 1 OLD LINK SPC 2 * ************ * * IMPLICIT * * ************ * F.IMP JSB ICH.F GET THE TYPE FOLLOWING THE 'IMPLICIT' LDB KM5 FIVE POSIBILITIES STB T0IMP SET THE COUNTER LDB DTBL GET THE TABLE ADDRESS IMP01 CPA B,I THIS THE TYPE? JMP IMP02 YOU BETCHA GO DO IT * INB NOPE STEP THE ADDRESS ISZ T0IMP END OF LIST? JMP IMP01 NOPE TRY NEXT ENTRY * LDA K10 YES YOU RUMMY WE DON'T HAVE THIS TYPE JSB ER.F B-Y-E * KM5 DEC -5 B55 OCT 55 * IMP02 ADB K5 INDEX INTO THE DEF TABLE LDB B,I GET ADDRESS OF THE STRING STB T0IMP AND SAVE IT LDA B,I GET THE STRING LENGTH AND B377 ISOLATE THE LENGTH STB T1IMP SAVE THE ADDRESS CMA,INA SET COUNT NEGATIVE STA T2IMP AND SAVE IT TOO IMP1 JSB ICH.F BEGIN THE SPELLING TEST ALF,ALF MOVE TO HIGH END AND SAVE STA T3IMP IT JSB ICH.F GET THE NEXT CHAR IOR T3IMP MIRGE WITH THE OTHER ISZ T1IMP STEP THE STRING ADDRESS CPA T1IMP,I IS THIS THE RIGHT CHAR? JMP IMP2 YES STEP THE POI<NTERS * LDA K10 NO- SEND SPELLING ERROR MESSAGE JSB ER.F B-Y-E * IMP2 ISZ T2IMP STEP THE COUNT JMP IMP1 MORE TO DO AROUND WE GO * LDA F.TC THE TEST IS OK SO FAR CPA B50 "(" IF LAST CHAR WAS '(' RSS SKIP READING IT JSB ICH.F NOPE READ THE '(' CPA B50 IS IT? JMP IMP03 YES ALL OK * LDA K9 UNEXPECTED CHAR JSB ER.F TOO BAD * IMP03 JSB ICH.F GET FIRST CHAR OF SET STA T1IMP SET IT SZB IF IT IS NOT SEZ ALF JMP TYP11 GO REPORT THE ERROR * JSB ICH.F GET THE NEXT CHAR CPA B55 '-' IF '-' THEN PART OF RANGE JMP IMP05 SO GO SET UP * CCA ELSE ASSUME SIMPLE CHAR STA T2IMP SET COUNT TO 1 * IMP04 LDB T1IMP GET THE CHARACTER ADB BM101 SUBTRACT 'A' CLE,ERB COMPUITE TYPE ADDRESS IN THE TABLE ADB F.DTY AND GET CURRENT LDA B,I TYPE SEZ ROTATE ALF,ALF IF NEEDED STA T3IMP SAVE RESULT FOR DUP IMPLICIT TEST XOR T0IMP,I GET THE NEW TYPE AND B377 KEEP THE OLD LOW ORDER BYTE XOR T0IMP,I RULES OF WOO CHAR REPLACE SEZ IS CHAR IS TO BE IN LOW WORD ALF,ALF PUT IT THERE STA B,I RESTORE WORD TO THE TABLE LDA K5 WARNING 5 LDB T3IMP IF SECOND REF TO SAME SSB CHAR JSB WAR.F * ISZ T1IMP STEP TO THE NEXT CHAR ISZ T2IMP STEP THE COUNT (DONE?) JMP IMP04 N0 - DO NEXT CHAR * LDA F.TC YES - GET DELIMITER CPA B54 ',' IF COMMA JMP IMP03 GO DO NEXT CHAR * CPA B51 ')' IF CLOSE THEN RSS OK ELSE JMP TYP11 UNEXPECTED CHAR * JSB ICH.F GET THE NEXT CHAR JMP CCRT GO TEST FOR COMMA * IMP05 JSHZB ICH.F GET THE FINAL CHAR OF A RANGE SZB TEST FOR SEZ ALF JMP TYP11 NOPE BITCH * CMA COMPUTE NEG. NO TO DO ADA T1IMP AND STA T2IMP SET FOR THE LOOP SSA,RSS IF LETTERS BACKWARD JMP TYP11 REPORT ERROR * JSB ICH.F GET NEXT CHAR. JMP IMP04 AND GO DO IT. * * DTBL DEF TYTBL ADDRES OF THE TYPE SPEC TABLE T0IMP NOP T1IMP NOP T2IMP NOP T3IMP NOP BM101 OCT -101 K10 DEC 10 SPC 2 * ******* * * EMA * * ******* SPC 1 F.EMP CLA,INA SET DIMENSION FLAG. STA F.DCF JSB INM.F INPUT NAME. LDA F.IU USAGE ALREADY ARRAY ? CPA ARR RSS YES. LEAVE IT. JSB TV.F NO. FORCE TO VARIABLE. LDA F.AT VERIFY A DUMMY CPA DUM RSS JMP EMP2 NO, ERROR LDA F.AF,I LINK TO BCOM OR NEXT DUMMY AND B7000 CPA BCOMI PREVIOUSLY DECLARED ? JMP EMP1 YES, ERROR. LDA F.A SAVE F.A & SET UP FOR EL.F STA F LDA K2 BUILD BCOMI ENTRY JSB DDE.F LDA F.EMA LINK TO EMA MASTER ENTRY LDB F.A ADB K2 STA B,I JSB EL.F INSERT BCOMI ENTRY LDA BCOMI SET F.AT TO BCOMI JSB DAT.F LDA F RESTORE F.A STA F.A JSB FA.F RESTORE A.T. STUFF EMP1 JSB IDC.F PROCESS ANY DIMENSION INFO. JMP CCRT CHECK FOR "," OR "C/R" * EMP2 LDA K94 ERROR 94: NOT DUMMY OR MENTIONED TWICE. JSB ER.F JMP EMP1 SKIP DIM INFO. * K94 DEC 94 SKP * *********************************** * * NON-DUMMY & NON-SUBPROGRAM TEST * * *********************************** SPC 1 NDS.F NOP JSB NST.F NON-SUBPROGRAM TEST LDB F.A MUST NOT CPB F.SBF SUBPROGRAM NAME JSB ER.F A SET BY NST.F TO 25 LDA K37 LDB F.AT CPB DUM DUMMY? JSB ER.F ILLEGAL USE OF DUMMY VARIABLE JMP NDS.F,I SPC 1 K37 DEC 37 SPC 1 * *********** * * INTEGER * * *********** SPC 1 F.INP LDA INT JMP TYP02 SPC 1 INT OCT 10000 F.IM=1, INTEGER SPC 1 * ******** * * REAL * * ******** SPC 1 F.REA LDA REA JMP TYP02 SPC 1 REA OCT 20000 F.IM=2, REAL SPC 1 * ******************** * * DOUBLE PRECISION * * ******************** SPC 1 F.DBL LDA DBL JMP TYP02 SPC 1 DBL OCT 60000 F.IM=6, DOUBLE PRECISION SKP * *********** * * COMPLEX * * *********** SPC 1 F.CPX LDA KKCPX JMP TYP02 SPC 1 KKCPX OCT 50000 F.IM=CPX LOG OCT 30000 F.IM=3, LOGICAL SPC 1 * *********** * * LOGICAL * * *********** SPC 1 F.LOG LDA LOG TYP02 STA F.MFL F.MFL SET TO THE MODE TYPED LDA F.LSF LAST STATEMENT FLAG SZA JMP TYP06 1ST STATEMENT OF PROGRAM CLA,INA STA F.TYP SET TYPE FLAG JSB INM.F INPUT NAME TYP03 LDB F.A CHECK IF IN FIX.EXT TBL CMB,INB IF SO ADB F.DP CAN NOT USE THE E-BIT TEST LDA F.MFL GET TYPE IN CASE IT IS SSB,RSS WELL? JMP TYP04 YES FIX.EXT SYMBOL DON'T USE E-BIT * LDA F.A,I GET OLD EXPLICIT TYPE FLAG AND K8 (CAN'T USE F..E INCASE IT IS DUM,ARR ALREADY) SZA,RSS IF NOT SET THEN JMP TYP05 PROCEED ALL OK * LDA F.IM GET OLD MODE CPA F.MFL SAME AS NEW ONE?? JMP TYP05 RETYPE IM THE SAME * LDA K83 JSB WAR.F RETYPE DIFFERENTLY JMP TYP08 SPC 1 TYP05 LDA F.MFL IOR K8 SET EXPLICID TYPE FLAG TYWP04 JSB DIM.F DEFINE F.IM JSB FA.F FETCH ASSIGN LDB F.IU LDA VAR SZB JMP TYP08 LDB F.AT CPB STRAB JMP TYP08 JSB DIU.F SET F.IU=VAR/CON TYP08 CLA STA F.EFG CLEAR E FLAG IN CASE STA F.TYP RESET TYPE FLAG TO INPUT DIMENSION. JSB IDC.F INPUT DIMENSION IF THERE. JMP CCRT SPC 1 TYP06 JSB EXN.F STRIP OFF PRECEDING BLANKS AND JSB IDN.F INPUT DNA: EAT SIX CHARS. LDA F.TC CPA B117 IS NEXT CHAR "O"? JMP TYP0F YES. "O" IN "FUNCTION". CLA,INA STA F.TYP SET TYPE FLAG LDA F.IM SZA JSB AI.F ASSIGN ITEM SZA JMP TYP01 LDA K17 NO MODE: JSB ER.F ILLEGAL OPERAND SPC 1 TYP0F JSB NTI.F PACK NAME TO F.IDI LDB F.DID GET DEF TO IT LDA B,I TEST FOR 'FUNCTION' CPA "FU" INB,RSS SO FAR SO GOOD JMP TYP11 BAD NEWS * LDA B,I NOW CPA "NC" "NC" INB,RSS OK JMP TYP11 BAD * LDA B,I LAST ONE HERE CPA "TI" OK? JSB ICH.F GET THE "N" CPA "N" IF NOT "N" JMP F.FUN * TYP11 LDA K28 ILLEGAL STATEMENT JSB ER.F TERMINATE STATEMENT (NO RETURN) SPC 1 TYP01 LDA F.A STA TYP.A SAVE F.A LDA K18 LDB F.NT SZB,RSS JMP TYP10 JSB WAR.F OPERAND NOT A NAME. RSS TYP10 JSB CRP.F OUTPUT CROSS REF. PAIR. LDA TYP.A STA F.A RESTORE F.A JMP TYP03 SPC 1 VAR OCT 400 F.IU=2, VARIABLE OR CONSTANT STRAB OCT 2000 F.AT=2, STR-ABS - UNDEFINED TYP.A NOP SAVE F.A K83 DEC 83 K17 DEC 17 K18 DEC 18 B117 OCT 117 'O' "N" OCT 116 "FU" ASC 1,FU "NC" ASC 1,NC "TI" ASC 1,TI K28 DEC 28 SKP * *********************************** * 8 * INPUT DIMENSION (CONDITIONALLY) * * *********************************** SPC 1 IDC.F NOP LDA F.TC NEXT CHAR '(' ? CPA B50 JSB IND.F YES, INPUT DIMENSION. JMP IDC.F,I EXIT. SPC 1 ARR OCT 600 F.IU=3, ARRAY SPC 1 * ************* * * DIMENSION * * ************* SPC 1 F.DIM CLA,INA STA F.DCF SET DIM FLAG JSB INM.F INPUT NAME JSB IND.F INPUT DIMENSION. JMP CCRT CHECK FOR ',' OR 'C/R' . * IND.F NOP LDA F.AT DUMMY CHECK CCB CPA DUM CLB STB T0DIM T0=0 IF DUMMY, ELSE =-1 LDA F.AF STA T1DIM T1=AF LDA F.A STA T2DIM T2=F, SAVE F JSB NST.F NON-SUBPROGRAM TEST LDB F.A CHECK IF NAME OF CURRENT MODULE CPB F.SBF IF SO SEND JSB ER.F ERROR 25 (A SET BY NST.F) * LDA K54 LDB F.IU CPB ARR JSB ER.F ARRAY NAME DEFINED TWICE LDA B52 LDB F.TC CPB B50 '(' RSS JSB ER.F ERR 42: ARRAY WITHOUT DECLARATOR LDA T0DIM JSB ISP.F INPUT SUBSCRIPT LDA F.DID COMPUTE ADDRESS OF ADA K2 THIRD DIM LDB S3 AND STB A,I IN F.IDI+2 LDA S1 NOW LDB S2 STORE THE DST F.IDI THE OTHER TWO DIMS LDA NS NO. OF SUBSCRIPTS JSB DDE.F DEFINE THE DIMENSION ENTRY ISZ T2DIM EXCHANGE LINKS LDA F.A (USE LOCAL BECAUSE LDB T2DIM,I FETCH LINK IS FOLLED BY STA T2DIM,I POSSIBLE BCOM INA FLAG STB A,I CCB RECOVER ORGIONAL ADB T2DIM F.A STB F.A F.A=ORIGONAL F.A LDA ARR JSB DIU.F DEFINE F.IU=ARR JMP IND.F,I SPC 1 K3 DEC 3 T0DIM BSS 1 SET T0 0(DUMMY) OR -1 T1DIM BSS 1 SAVE F.AF O T2DIM BSS 1 SAVE F K54 DEC 54 NS BSS 1 NUMBER OF SUBSCRIPTS S3 BSS 1 SUBSCRIPT NUMBER 3 .. S2 BSS 1 SUBSCRIPT NUMBER 2 . S TABLE S1 BSS 1 SUBSCRIPT NUMBER 1 ..!!DO NOT REARRANGE S1/0 S0 BSS 1 SUBSCRIPT NUMBER 0 .. (EXTEND SIZE FOR EMA) B6000 OCT 6000 * * * *********************************************** * * DEFINE DIMENSION ENTRY (ALSO BCOMI ENTRIES) * * *********************************************** * * DDE.F NOP RAR,RAR MOVE NO. DIMENSIONS RAR,RAR TO THE 'IM' FIELD JSB ESC.F SET F.IM=NS LDA B6000 (A)=DIM STA F.AT. SUBSCRIPT INFORMATION FLAG SET CLA STA F.IU F.IU=0 JSB AI.F ASSIGN ITEM JMP DDE.F,I RETURN SKP * ********************** * * INPUT LIST ELEMENT * * ********************** SPC 1 * TO INPUT AN ITEM THAT CAN BE CONTAINED WITHIN A LIST * AND INSURE THAT THE ITEM HAS NOT BEEN TYPED AS DUMMY * OR SUBPROGRAM SPC 1 ILD.F NOP JSB NDS.F NON-DUMMY & NON-SUBPROGRAM TEST LDA F.IU CPA ARR JMP ILE04 F.IU=ARR JSB TV.F TAG VARIABLE CLA ILE02 STA S1 JMP ILD.F,I SPC 1 K38 DEC 38 SPC 1 ILE04 JSB ISP.F INPUT SUBSCRIPTS JSB FA.F FETCH ASSIGNS LDA K38 LDB NS NO. OF SUBSCRIPTS CMB,INB (B)=-(B) ADB F.ND # OF DIMENSIONS SSB JSB ER.F MORE SUBSCRIPTS THAN DIMENSIONS * LDA DS3 SET UP DEF OF 'S' LIST STA DS IN LOCAL TEMP LDA DFD2 GET DEF OF DEF LIST STA DFD AND SET IT FOR LOOP LDA KM3 SET FOR THREE SUBSCRIPTS STA DDE.F SET COUNTER CLA,CLE INITILIZE STA ILET0 TEMPS STA S0 AND EXTENDED SIZE WORD ILE01 LDA DS,I GET NLHSUBSCRIPT ADA ILET0 ADD WHAT WE HAVE ALREADY RAL,CLE,SLA,ERA PROP THE SIGN (LOW WORD IS 15 BITS) ISZ S0 STEP IF CARRY MPY DFD,I MULTIPLY BY THE DIMENSION DFD EQU *-1 RAL,CLE,ERA CLEAR THE SIGN STA ILET0 SET LOW PART OF RESULT ELB,CLE EXTEND SIGN OF A INTO B STB ILET2 SET TEMP LDA S0 SET CURRENT LOW PART MPY DFD,I MUL TIMES DIMENSION ADA ILET2 ADD THE HIGH BITS FROM BEFORE STA S0 SET THE NEW HIGH ORDER BITS ISZ DS STEP THE ADDRESSES ISZ DFD AND ISZ DDE.F JMP ILE01 ARROUND WE GO * LDA ILET0 GET LOW PART OF RESULT JMP ILE02 AND GO STORE IT * DS3 DEF S3 DFD2 DEF *+1,I DEF F.D2 DEF F.D1 DEF F.D0 DS NOP ILET0 NOP ILET2 NOP FN SKP * ******************* * * INPUT SUBSCRIPT * * ******************* SPC 1 * TO INPUT THE SUBSCRIPT LIST FROM THE OPENING ( TO THE * CLOSING ). * ENTRY: (A)=0 IF DIMENSIONS DUMMY * (A) .GT. 0 IF DIMENSION CONSTANT INTEGER * (A) .LT. 0 IF DIMENSION INTEGER OR VARIABLE SPC 1 * EXIT: NS=NO. OF SUBSCRIPTS * S-TABLE=POINTERS INTO THE ASSIGNMENT TABLE * OR THE CONSTANTS THEMSELVES SPC 1 ISP.F NOP STA T0ISP SAVE (A) CLA STA T2ISP STA S1 STA S2 SUBSCRIPT 2 =0 STA S3 SUBSCRIPT 3 =0 STA NS NO. OF SUBSCRIPTS =0 LDA F.TC LDB F.EQF SSB IN EQUIV. GROUP? JMP ISP01 NO. CPA B54 ',' JMP ISP.F,I CPA B51 ')' JMP ISP.F,I ISP01 CPA B50 '(' JMP ISP02 LDA K82 JSB ER.F ARR NAME IN GP NOT FOL BY (,,,) SPC 1 K82 DEC 82 SPC 1 ISP02 LDA T0ISP RESTORE (A) SZA JMP ISP06 DIMENSIONS NOT DUMMY. JSB EXN.F EXAMINE NEXT CHARACTER SZB,RSS JMP ISP06 CHARACTER IS A DIGIT * JSB IOP.F INPUT THE JSB TV.F DIMENSION JSB NCT.F MUST NOT BE A CONSTANT LDA F.AT CPA DUM JMP ISP04 LDA K39 NON-DUMMY DIMENSION VARIABLE JSB ER.F NAME USED WITH DUMMY ARRAY NAME SPC 1 K39 DEC 39 DUM OCT 5000 F.AT=5, RELATIVE WITHIN DUMMY LOC K8 DEC 8 K19 DEC 19 SKP ISP04 LDA K16 STA T2ISP LDB F.S2B LDA F.L # OF ITEMS IN STACK SZA JMP ISP20 ISP05 LDA F.A PTR OF DUMMY JSB PU2.F STORE INTO STACK LDA INT JSB ATC.F ALLOCATE TEMP CELL LDA F.A PTR OF TEMP CELL JSB PU2.F STORE INTO STACK CCA ADA F.INT NEVER RELEASE TEMP CELeL: STA F.INT F.INT=F.INT-1 JMP ISP10 SPC 1 * * INPUT INTEGER * SPC 1 ISP06 JSB IDN.F INPUT DNA JSB ITS.F INTEGER TEST LDA K19 LDB F.NT IS IT A CONSTANT? SZB,RSS JSB ER.F NO. LOSE. LDA T0ISP RESTORE ENTRY (A) SZA,RSS JMP ISP08 DIMENSIONS DUMMY. SSA,RSS JMP ISP16 DIMENSIONS CONSTANT. ISP08 JSB AI.F ASSIGN ITEM ISP10 LDA F.A ISP12 LDB NS NUMBER OF SUBSCRIPTS SO FAR CMB,INB USE NEGATIVE OFFSET ADB K1ISP FROM ADDRESS OF S1 STA B,I S(NS+1)=(A) ISZ NS NS=NS+1 LDA NS CPA K3 JMP ISP14 NS=3 LDA F.TC CPA B54 F.TC=',' ? JMP ISP02 YES ISP14 LDA T2ISP END OF DIMENSIONS. STA F.EFG NOT ALL DIMENSIONS CONSTANT. JSB RP.F ) - INPUT OPERATOR JMP ISP.F,I SPC 1 ISP16 CCA INTEGER JUST INPUT ADA F.IDI (A)=F.IDI-1 JMP ISP12 SKP ISP20 INB LDA B,I INB CPA F.A JMP ISP22 MATCHED CPB F.S2T JMP ISP05 END OF STACK JMP ISP20 TRY NEXT ENTRY SPC 1 ISP22 LDA B,I F.AOF TEMP CELL JMP ISP12 SPC 1 K16 DEC 16 T0ISP NOP SAVE ENTRY (A) VALUE K1ISP DEF S1 T2ISP OCT 0 SPC 2 * ************************ * * 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 1 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 B57 OCT 57 / SKP * TEMP CELL NAME TABLE HAS ONLY A LOCATION FOR * INTEGER TEMP CELL NAMES IN THIS SEGMENT * BECAUSE THAT IS ALL THAT IS USED. * TEMP CELL NAMES FOR DUMMY DIMENSIONS * ARE -1, -2, -3, ETC. RATHER THAN -1001, * -1002, -1003, ETC. FOR INTEGER VARIABLE * TEMPORARIES USED IN EXPRESSION EVALUATION. * IN THE LISTING OF THE OBJECT PROGRAM THEY * LOOK LIKE REGULAR INTEGER TEMPORARIES AND * ANY INTEGER TEMPORARIES THAT ARE NEEDED START * WITH NAMES -100N, WHERE N = NUMBER OF DUMMY * DIMENSION TEMP CELLS NEEDED - 1. SPC 1 TEMPS DEF * ADDR OF TEMP CELL NAME TABLE - 1 NOP TEMP CELL NAME FOR DUMMY DIMS. 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 JMP PU2.F,I SKP * ******************** * * COMMON PROCESSOR * * ******************** SPC 1 F.COM CLA,INA STA F.DCF SET COMMON FLAG JSB ICH.F INPUT A CHAR. CPA B57 '/' JMP COM04 F.TC=/ * JSB UC.F UNINPUT COLUMN COM00 LDA LCOM SET FOR DEFAULT OF STA CT02 NOT FIRST VARABLE IN COMMON STATEMENT LDB F.SPS IF THIS IS NOT CPB COMK1 FIRST ELEMENT JMP COM12 THEN LCOM IS OK * LDB FCOM FIRST UNLABELED COMMON JMP COM10 USE FCOM HEAD AND GO TRACK DOWN * COM04 JSB ICH.F POSSIBLE LABEL LDB FCOM IS IT NULL? CPA B57 '/' WELL?? JMP COM10 YES BLANK COMMON * JSB UC.F NO BACK OUT CHAR JSB IDN.F INPUT COMMON LABEL. LDB F.NT MAKE SURE IT'S A NAME. SZB,RSS I.E., F.NT=0 SZA,RSS AND F.IM#0. JMP COM09 IF NOT. LDA F.DNI,I YES. SET RENAME BIT. IOR B200 STA F.DNI,I JSB AI.F ENTER IN ASSIGNMENT TABLE. LDA F.AT GET ITS TYPE CPA BCOMI IF ALREADY BCOMI THEN JMP COM08 ADDING TO EXISTING LABEL * LDA BCOMI DEFINE F.AT JSB DAT.F TO BCOM JSB TS.F FLAG AS A SUBROUTINE (IT IS EXTERNAL) LDA F.A NOW REDEFINE F.AF JSB DAF.F (TS.F SETS IT TO ZERO) COM08 LDB F.A SET FOR TRACK DOWN LDA F.TC DO WE HAVE THE PROPER DELIMITER? CPA B57 WELL '/' JMP COM10 GOOD GO TRACK DOWN THE END OF TH LIST * COM09 LDA K4 ERROR WRONG DELIMITER OR REUSE OF VAR. NAME JSB ER.F OR MORE THAN 6 CHAR. ABANDON THE STMT. * COM10 STB CT01 SET HEAD COM11 STB CT02 SET CURRENT ADDRESS JSB FL.F FETCH LINK CPA CT01 POINT AT HEAD? JMP COM12 YES THIS IS IT * STA B NO AROUND JMP COM11 WE GO. * COM12 JSB INM.F GET THE VARABLE NAME LDA F.A UP DATE STA LCOM LAST COMMON STA F SET FOR EXCHANGE LINKS IN CASE BCOM LDA COMK1 SET RETURN ADDRESS STA F.SPS FOR NEXT VARABLE IN LIST JSB NDS.F < NON-DUMMY & NON-SUBPROGRAM TEST LDA K36 LDB F.AT CPB COM. JSB ER.F ILLEGAL USE OF COMMON NAME * CPB BCOM IF ALREAD IN COMMON JSB ER.F ILLEGAL TO RE-ENTER IT. * LDA F.IU IF NOT YET TAGED SZA,RSS TAG JSB TV.F TAG AS VARIABLE LDA CT01 IF NOT IN CPA FCOM LABELED COMMON JMP COM13 CONTINUE * CPA F.EMA THIS EMA COMMON?? CLA,INA,RSS YES RESERVE EXTRA WORD FOR OFFSET CLA LABELED COMMON ENTRY BUILD JSB DDE.F A BCOMI ENTRY IN THE ASSIGNMENT TABLE LDA CT01 TO DESCRIBE IT LDB F.A SET POINTER ADB K2 TO STA B,I THE MASTER ENTRY JSB EL.F EXCHANGE LINKS LDA BCOMI SET F.AT TO JSB DAT.F BCOMI LDA LCOM RESTORE STA F.A F.A OF THE VARABLE LDA BCOM GET BCOM AND RSS SKIP TO DEFINE AT COM13 LDA COM. JSB DAT.F DEFINE F.AT=COM OR BCOM LDA CT02 SET EXCHANGE STA F LINK FLAGS JSB FA.F RESTORE ASSIGNS FOR DIM PROCESSOR JSB IDC.F INPUT DIMENSION (IF THERE) JSB EL.F EXCHANGE LINKS. JMP CCRT CHECK FOR ',' OR 'C R' . SPC 1 F.LCM NOP LABELED COMMON FLAG COMK1 DEF COM00 LOC. TO PROC NAME IN COMMON BLCK LCOM BSS 1 LAST COMMON ASSIGNMENT POINTER K36 DEC 36 COM. OCT 4000 F.AT=4 (COMMON) BCOM OCT 3000 F.AT=BCOM BCOMI OCT 7000 F.AT=BCOMI CT01 NOP CT02 NOP K2 DEC 2 K4 DEC 4 B15 OCT 15 B200 OCT 200 SPC 1 * ************************* * * EQUIVALENCE PROCESSOR * * ************************* SPC 1 F.EQU JSB EXN.F EXAMINE NEXT CHAR. CPA B50 '(' JMP EQU01 EQU.F LDA K70 JSB ER.F 1ST CHAR. OF GROUP NOT '(' SPC 1 EQU05 LDB F.OPF LDA KK24 ', ' CPB K2 EQU03 STA F.E,I STORE INTO EQUIVALENCE TABLE EQU04 ISZ F.NEQ LDA F.TC CPA B15 C/R JMP CRT.F F.TC=C/R JSB UC.F UNINPUT COLUMN EQU01 LDA K2 A NEW GROUP STA F.OPF SET OUTPUT F.PAK FLAG TO 2 EQU02 JSB ICH.F INPUT CHARACTER CPA B15 JMP EQU08 F.TC=C/R CPA B54 ","?? RSS JMP EQU02 NO GET NEXT CHAR. JSB ICH.F INPUT CHARACTER CPA B50 "(" ?? JMP EQU05 YES START NEW GROUP CPA B15 CR/LF ?? JMP EQU.F YES ERROR. JMP EQU02 NO GET NEXT CHAR. SPC 1 K70 DEC 70 KK24 ASC 1,, KK25 ASC 1,), SPC 1 EQU08 LDA KK25 '),' LDB F.OPF CPB K2 JMP EQU09 F.OPF=2 LDA B54 ',' STA F.PAK LDA B40 BLANK CHARACTER JSB PAK.F CLA STA F.OPF TERMINATE PAK.F JMP EQU04 SPC 1 EQU09 CLB STB F.OPF RESET OUTPUT FLAG JMP EQU03 SPC 1 NOP 1ST COMMON ASSIGN PTR. DEF *-1 DUMMY LINK TO SELF FCOM DEF *-2 LINK TO DUMMY B40 OCT 40 SPC 2 * ******************************* * * INPUT LIST ELEMENT AND SIZE * * ******************************* SPC 1 * INPUT LIST ELEMENT FOR DATA STATEMENT SPC 1 ILS.F NOP LDA XRFLG IS CROSS REF PAIR TO BE GENERATED? SZA,RSS JMP ILS03 NO. CCA COMPUTE CURRENT ADDRESS WHERE ADA F.EQF WE ARE SCANNING ADA F.E IN EQUIVALENCE TABLE. CMA,INA MAKE IT NEGATIVE STA ETADD CCB (B) POINTS TO LOCATION WORD ADB F.LLT OF LAST ENTRY IN LLTAB. ILS01 LDA ETADD COMPUTE LOC IN LLTAB-ETADD. ADA B,I ADB KM2 SSA FOUND IF ETADD<=LOC JMP ILS01 INB LDA B,I (A)=LINE NO. STA F.CIN SAVE IT ? STA F.CLN JSB ISY.F INPUT SYMBOL. JSB CRP.F CREATE CROSS REFERENCE PAIR. RSS END OF XREF SPECIAL PROCESSING. ILS03 JSB ISY.F INPUT SYMBOL. JSB ILD.F INPUT LIST ELEMENT FOR DATA JSB NWI.F F.D0: # WDS FOR ITEM JMP ILS.F,I SPC 1 ETADD NOP XRFLG NOP SAVE1 NOP SAVE2 NOP SKP * *********************** * * RELATE COMMON ITEMS * * *********************** SPC 1 T0RCO EQU SAVE1 SIZE OF COMMONS T1RCO EQU SAVE2 NTATI OCT 107600 MASK TO ISOLATE NT,AT,IU FIELDS B7200 OCT 7200 NT=0,AT=BCOMI,IU=SUB SPC 1 RCO03 LDB FCOM END OF LABELED COMMON CLA CLEAR THE FLAG STA F.LCM JMP RCO02 GO DO BLANK COMMON * RCO04 LDA T1RCO GET CURRENT MASTER ENTRY ADDRESS STA F.A RESTORE IT FOR GNA.F CLA SET UP TO ZAP THE F.AF OF THE MASTER LDB F.SFF AND IF BLOCK DATA SUBPROGRAM CPB K2 LDA T0RCO SET F.AF OF MASTER TO SIZE JSB DAF.F SET MASTER ENTRY F.A LDB T3RCO B = UPPER WORD. LDA F.EMA GET EMA FLAG CPA F.A THIS THE EMA ENTRY? JMP RCO07 YES, SKIP. LDA K84 IF TOO BIG, ERROR 84. SZB JSB ER ISSUE ERROR JMP RCO01 NO LOOK FOR NEXT BLOCK * RCO07 LDA T0RCO YES GET AND SET THE DOUBLE WORD DST F.EMS COMMON SIZE FOR EMA JMP RCO01 LOOK FOR NEXT BLOCK * F.RCO ISZ F.LCM DO LABELED COMMON FIRST LDA F..DP SEARCH THE SYMBOL TABLE FOR STA F.A THE LABELS RCO01 JSB GNA.F SSA,RSS END OF TABLE?? JMP RCO03 YES GO DO BLANK COMMON * LDA F.A,I CHECK IF LABELED COMMON MASTER AND NTATI =B107600 ISOLATE NT,AT,IU FIELDS CPA B7200 IF NT=0 & AT=BCOMI & IU=SUB RSS THIS IS A MASTER ENTRY JMP RCO01 NOT SO TRY NEXT ENTRY * LDB F.A SA}VE THE ADDRESS OF MASTER RCO02 STB T1RCO ENTRY JSB FL.F FETCH LINK CLB SET COMMON SIZE STB T0RCO TO ZERO STB T3RCO ZERO THE SECOND WORD OF THE DOUBLE RCO05 LDA NXL STA F.A F.A=NEXT LINK CPA T1RCO END OF LIST? CLB,INB,RSS YES SKIP OUT JMP RCOM2 NO DO NEXT ENTRY * CPB F.LCM DOING LABELED COMMON?? JMP RCO04 YES SET FOR NEXT ENTRY * LDA K84 ERROR 84 IF SIZE OVERFLOW. LDB T3RCO UPPER WORD. SZB JSB ER YES. LDA T0RCO NO SET COMMON SIZE STA F.CSZ SIZE OF COMMON JMP GREQU DO EQUIV. GROUPS * RCOM2 JSB FA.F FETCH ASSIGN JSB NWI.F F.D0: # WDS FOR ITEM LDB F.A JSB FL.F FETCH LINK LDA T0RCO JSB DAF.F DEFINE F.AF=T0 LDA T1RCO GET THE F.A OF THE MASTER ENTRY ADB K2 IS IN EMA CPA F.EMA THEN RSS SKIP TO SET IT UP JMP RCO06 NOT IN EMA SKIP IT * LDA T3RCO GET THE HIGH ORDER BITS STA B,I SET IN THE SYMBOL TABLE RCO06 DLD F.D0 GET ELEMENT SIZE ADA T0RCO ADD WHAT WE HAVE ALREADY RAL,CLE,SLA,ERA IF CARRY ISZ T3RCO CARRY IT STA T0RCO T0=T0+D0 ADB T3RCO ADD THE HIGH PARTS STB T3RCO AND SAVE THEM LDA K84 ERROR 84 IF SIZE OVERFLOW. SSB JSB ER YES. JMP RCO05 DO NEXT ONE IN THE LIST * T3RCO NOP SPC 4 ER NOP LDB ER SET ER.F RETURN ADDR. STB F.EQE JSB ER.F REPORT ERROR AND RETURN. SKP * ********************* * * GROUP EQUIVALENCE * * ********************* SPC 1 GREQU LDA F.CIN SAVE CURRENT LINE NO. STA SAVX1 LDA F.CLN SAVE THIS LINE NO. ALSO. STA SAVX2 JSB SCC.F SAVE F.CC LDA F.NEQ NO. OF EQUIVALENCE GROUPS SZA,RSS JMP GRE27 TO ASSIGN SPECIFICATION * LDA DERTN SET RETURN DEF FOR STA F.EQE THE ERROR ROUTINE LDB F.E LDA B,I AND KK07 =B177400 CPA KK26 ',' LEFT JUSTIFIED JMP GRE24 LDA KK28 ),C/R JMP GRE02 SPC 1 KK07 OCT 177400 K81 DEC 81 DERTN DEF GRE27 RETURN DEF FOR ERROR ROUTINE KK26 OCT 26000 ',' LEFT JUSTIFIED KK28 OCT 24415 '),C/R' CRCR OCT 6415 C/R,C/R SPC 1 GRE24 LDA CRCR C/R,C/R GRE02 STA B,I STORE INTO EQUIVALENCE TABLE ADB KM1 STB F.E F.E=F.E-1 LDA CRCR STA B,I STORE INTO EQUIVALENCE TABLE GRE04 JSB SEC.F F.EQF=F.DO-E , F.CC=121 CLA STA COMF RESET COMMON FLAG STA XRFLG TURN OFF CROSS REFERENCE. GRE06 JSB ICH.F INPUT CHARACTER GRE03 LDA K70 LDB F.TC CPB B50 '(' RSS JSB ER.F 1ST CHAR OF GROUP NOT '(' JSB LRP.F (A)=F.E+F.EQF-1 STA F.LPR '(' LOCATION LDA F.EQF EQUIV TABLE PTR FLAG STA SEQF SAVE F.EQF GRE08 JSB ILS.F INPUT LIST ELEMENT & SIZE LDA F.AT CPA BCOM IN COMMON RSS CPA COM. EITHER TYPE RSS F.AT=COM JMP GRE09 * STA COMF SET COMMON FLAG = F.AT LDB F.AF GET AF OF THE ITEM CPA COM. IF IN COMMON JMP GRE11 THIS IS WHAT WE WANT * STB T2GRE ELSE IT IS A POINTER TO THE BCOMI ADB K2 INDEX TO THE MASTER ENTRY POINTER LDA B,I COMMON ENTRY? INB STEP TO SIZE WORD TWO CPA F.EMA IF EMA SET TO GET THE UPPER WORD RSS CLA,RSS NO SET HIGH ORDER PART TO ZERO LDA B,I GET HIGH ORDER PART FROM A.T. ADB KM2 BACK UP TO THE LOW PART LDB B,I GET THE OFFSET OF THE ITEM GRE05 ADB S1 ADD THE DIMENSION OFFSET RBL,CLE,SLB,ERB CLEAR SIGN SKIP IF NOT SET INA CARRY SIGN TO A STB T0GRE AND SAVE T0=ACTUAL OFFSET ADA S0 ACCUMULATE HIGH ORDER BITS STA T5GRE AND SAVE T5=HIGH ORDER BITS OF OFFSET GRE09 LDA F.TC CPA B54 ',' JMP GRE08 F.TC=, JSB RP.F )-INPUT OPERATOR CPA B54 JMP GRE12 F.TC=, CPA B15 JMP GRE10 F.TC=C/R GRE07 LDA K81 JSB ER.F ILL. TERM. FOR AN EQUIV. GROUP SPC 1 GRE11 CLA CLEAR HIGH BITS FOR STD. ARRAY JMP GRE05 GO CONTINUE CACULATION * GRE97 LDA F.NEQ NO. OF EQUIV GROUPS SZA,RSS JMP GRE27 JSB SEC.F F.EQF=F.DO-E, F.CC=121 CLA,INA STA XRFLG TURN ON CROSS REFERENCE GRE98 JSB ICH.F INPUT '(' OF EQUIV GROUP LDA B50 CHECK FOR IT. JSB TCT.F GRE99 JSB ILS.F INPUT NEXT NAME IN GROUP LDA F.TC IF F.TC=',' CPA B54 JMP GRE99 INPUT NEXT NAME IN GROUP. JSB RP.F ELSE INPUT ')' OF GROUP END. CPA B54 IF MORE FOLLOWS, JMP GRE98 LOOK AT NEXT GROUP. CLA TURN OFF CROSS REFERENCE. STA XRFLG LDA SAVE1 RESTORE LINE NO. TO F.CIN. STA F.CIN LDA SAVE2 RESTORE LINE NO TO F.CLN. STA F.CLN GRE26 LDA F.NEQ NO. OF EQUIV. GROUPS SZA JMP GRE28 JMP GRE27 SPC 1 SEQF BSS 1 SAVE F.EQF SPC 1 GRE10 LDA COMF ANY COMMON IN GROUP? SZA,RSS JMP GRE97 NO. GRE12 JSB LRP.F (A)=F.E+F.EQF-1 STA F.RPR ')' LOCATION LDA COMF ANY COMMON IN GROUP? SZA,RSS JMP GRE06 NO. LDA SEQF STA F.EQF RESTORE F.EQF LDA K120 STA F.CC F.CC=121 STA XRFLG TURN ON CROSS REFERENCE. CCA SET FLAG IN STA T3GRE T3 GRE14 JSB ILS.F INPUT LIST ELEMENT & SIZE LDA F.AT CPA COMF THIS THE ONE WE WANT? JMP GRE20 F.AT=COM OR BCOM * CPA BCOM IF COM OF OTHER TYPE JMP GRE20 GO SEND ERROR * CPA COM. SHOULD NOT BE IN COMMON IF HERE JMP GRE20 IF SO SEND ERROR * LDB S0 GET DOUBLE WORD LDA S1 SIZE THIS CMA,INA INDEX AND SET NEGATIVE RAL,CLE,SLA,ERA SKIP IF NO CARRY CMB,RSS CMB,INB CARRY INTO B IF NEEDED ADA T0GRE SUBTRACT FROM ARRAY 1 RAL,CLE,SLA,ERA INB ADB T5GRE AND STA T1GRE SAVE NEW BASE OF STB T6GRE THIS ARRAY LDA B51 SSB JSB ER.F ERR 41: COMMON BASE .LT. 0 * LDA BCOM IS THIS A BLOCK COMMON ENTRY? CPA COMF WELL? CLA,RSS YES SKIP TO THE PROCESSOR JMP GRE13 NO DO STANDARD THING * LDB F.A MUST DEFINE A NEW BCOMI ENTRY FOR THIS GUY STB SAVE2 SAVE HIS F.A LDB T2GRE GET BCOM A.T. ADDRESS ADB K2 INDEX TO MASTER ENTRY ADDRESS STB T4GRE SAVE IT LDB B,I GET ADDRESS OF MASTER STB T7GRE SAVE MASTER'S ADDRESS CPB F.EMA EMA COMMON? INA YES ALLOCATE AN EXTRA WORD FOR THE BCOMI ENTRY JSB DDE.F GO ALLOCAT SPACE IN THE TABLE LDB T7GRE GET THE MASTER ENTRY ADDRESS LDA F.A AND THE ADDRESS OF THE NEW BCOMI ENTRY ADA K2 ADDRESS OF SLOT FOR MASTER POINTER STA T4GRE SAVE ADDRESS FOR POSSIBLE EMA SET UP STB A,I AND SET IN THE NEW ENTRY LDA BCOMI DEFINE THE F.AT JSB DAT.F TO BCOMI LDA F.A GET THE ADDRESS OF THE ENTRY LDB SAVE2 GET THE ELEMENT ADDRESS STB F.A RESTORE IT JSB DAF.F SET LINK TO THE BCOMI ENTRY LDA T6GRE GET HIGH ORDER BITS OF SIZE (IF ANY) LDB T7GRE GET MASTER ENTRY ADDRESS ISZ T4GRE SET TO POINT AT HIGH BITS IF SOME CPB F.EMA EMzuA ARRAY? STA T4GRE,I YES SET THE REST OF THE SIZE INFO. JSB FA.F RESTORE THE ASSIGNS JSB NWI.F INCLUDING THE ITEM SIZE. GRE13 LDA COMF SET THE CORRECT JSB DAT.F F.AT FOR THE ELEMENT LDA T1GRE NEW F.AF JSB DAF.F DEFINE F.AF LDA F.IU CPA ARR RSS F.IU=ARR JSB TV.F TAG VARIABLE JMP GRE15 SPC 1 GRE20 LDA B50 IF WE WERE HERE BEFORE ISZ T3GRE THEN JSB ER.F WE HAVE AN ERROR JMP GRE16 NO ERROR CONTINUE SPC 1 GRE15 LDB DCSZ SET DEF LDA COMF IF BLOCK COMMON CPA COM. THEN MUST WORK HARDER 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 T1ENLHGRE 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. * * 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 N 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 STA T8GRE REMEMBER IF FOUND. SZA IF FOUND, STA COMF SET COMMON FLAG NON ZERO JMP GRE32 T1=S1 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 T8GRE 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 LDB T8GRE IS THE ITEM REDUNDANT ? SZB,RSS I.E., WAS IT FOUND ON STACK ? JMP GRE33 NO. * STA T8GRE YES. SAVE THE NEW OFFSET. JSB FA.F GET THE OLD ONE. CPA T8GRE SAME ? (A=OLD OFFSET, F.AF) JMP GRE33 YES. NO HARM DONE. * LDA B50 NO. IMPOSSIBLE EQUIV. JSB ER.F * GRE33 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 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 j 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 K5 DEC 5 KM7 OCT -7 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 * * ********************************** * 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 '(' 'YJSB 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 ADA K8. SET UP THE NAM BUFFER STOP STA T2PRO 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 BLOaCK 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 LDu:A 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 BASE 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 INPUT 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( NLH CONTAINS FIRST ( OF IMPLICIT REAL(... ASDBL OCT 160007 TYPE DOUBLE PRECISION WITH SIGN 7 WORDS FOLLOW ASC 7,OUBLEPRECISION END F4.0 A`N -4 92060-18095 2001 S C0522 &1FTN4 SEGMENT 1             H0105 ;ASMB,Q,C HED ** ** 16K FTN4 COMPILER (F4.1:EXPRESSION EVALUATOR) ** NAM F4.1,5 92060-16095 REV.2001 791101 * *************************************** * 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. * *************************************************************** * NAME: F4.1, PART OF FTN4 COMPILER. * * SOURCE: 92060-18095 * * RELOC: 92060-16095 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.ACC TEMP ACCUMULATOR FLAG EXT F.AF ADDRESS FIELD CURREXT F.A EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.C OFFSET FOR CURRENT MR INSTRUCTION EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.D DO TABLE POINTER EXT F.DID ADDRESS OF F.IDI EXT F.DLF DELIMETER FLAG EXT F.DNI ADDRESS OF NID EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.IDI INPUT ARRAY NON-NUMERIC 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.L # WORDS ON STACK 2 EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.NC NAME CHANGE FLAG. EXT F.ND NUMBER OF DIMENSIONS EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.OFE DATA POOL OVERFLOW ERROR EXTRY. EXT F.R JSB ERR0 FLAG EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER 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.SEE RETURN FROM F4.1 EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 EXT F.SRL SAVE RPL AT BEGINNING OF RECORD 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.X1 F.A OF F.D1 EXT F.X2 F.A OF F.D2 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AI.F ASSIGN ITEM EXT BNI.F CLEAR NID TO BLANKS EXT CDI.F CLEAR IDI ROUTINE EXT CRP.F CROSS REF PAIR SUB. EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT DIM.F DEFIND (F.IM) 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 IDN.F INPUT DO NOT ASSIGN (GET NEXT OPERAND) EXT II.F INPUT ITEM EXT NST.F TEST FOR NOT A SUBROUTINE NAME EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT OA.F OUTPUT ASSIGNMEXT TABLE OPERAND EXT OAI.F OUTPUT ABS. INSTRUCTION EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OMR.F OUTPUT MEMORY REF. INSTRUCTION EXT OW.F OUTPUT WORD EXT OZ.F OUTPUT ZREL (OP *+N) EXT PSL.F PRINT LINE ON PRINTER EXT SOA.F STORE AND OUTPUT (OA.F) 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 L.INT INITIALIZE TEMP CELL BASE NAMES. RAL,CLE,SLA,ERA (INDIRECT ? CLEAR IT) LDA A,I (YES. REMOVE IT)c2 LDB LT.IN JSB .MVW DEF K7 NOP 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 F.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 * STA T1FER SAVE F.A OF DUMMY. JSB FA.F FETCH ASSIGNS JSB CTYP CHECK IF IMPLICIT STMT CHANGED TYPE FER02 LDB F.AF SAVE LINK TO NEXT ONE LDA B,I IF NEXT IS BCOMI, AND B7000 CPA BCOMI INB,RSS JMP FER11 NO. LDA B,I YES. SAVE LINK. STA NXT STB T2FER SAVE ADDR 2ND WD BCOMI ENTRY. LDA F.RPL SAVE F.RPL OF NOP IN WORD 5. ADB K3 STA B,I JSB DRT.F CREATE STACK ENTRY FOR NON-ARRAY. LDA T1FER,I GET F.IU OF DUMMY. AND B600 CPA ARR ARRAY ? RSS JMP FER10 NO. ISZ T2FER YES. ANOTHER TEMP FOR ARRAY USE. ISZ T2FER JSB DRT.F LDA F.ND # DIM (SHOULD BE INTACT) CMA,INA STA T2FER COUNTER FOR LOOP. LDB T1FER F.A OF DUMMY INB LDB B,I OF ITS DIM ENTRY. ADB K3 ^OF FIRST DIM SIZE ENTRY. STB T3FER FER08 LDA T3FER,I ADDR SIZE ENTRY THIS DIM LDB A,I CHECK F.NT SSB NAMED ? JMP FER09 NO, CONSTANT, LEAVE IT. JSB PU2.F TEMP. IS DUPLICATE, STACK IT. LDA T3FER JSB PU2.F AND ADDR DIM SIZE ENTRY. FER09 ISZ T3FER LOOP THRU ENTRIES. ISZ T2FER JMP FER08 * FER10 LDA T1FER RESTORE F.A OF DUMMY STA F.A LDA BCOM TYPE IT "BCOM" JMP FER12 * FER11 STB NXT SAVE LINK LDA F.RPL DEFINE LOC OF NORMAL DUMMY JSB DAF.F LDA DUM TYPE IT "DUM" FER12 JSB DAT.F * 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 SKP * AT THIS POINT WE SCAN STACK 2 AND PRODUCE ENTRY CODE. * THE ENTRIES ON THE STACK HAVE THE FOLLOWING FORMATS: * * 1) WORD1: F.A OF DUMMY USED AS VARIABLE DIM SIZE. * WORD2: F.A OF TEMP TO COPY VALUE INTO. * * 2) WORD1: F.A OF TEMP PREV USED IN TYPE 1 ENTRY. * WORD2: ADDR TO STORE F.A OF NEW TEMP WHICH * HAS SAME VALUE AS EARLIER TEMP. * * 3) WORD1: COMPL OF REL ADDR OF A SUBR PARAM ADDR. * WORD2: F.A OF TEMP TO COPY (2-WD) VALUE INTO. * * THE LIST IS TERMINATED BY A ZERO WORD. ENTRIES ARE * DELETED BY SETTING BOTH WORDS TO +1. * CLA PUT END MARKER ON STACK 2. STA T2FER (RELATIVE POSITION IN STACK) JSB PU2.F FER04 JSB S2NXT GET NEXT ELEMENT. FER17 SZB,RSS END ? JMP FER05 YES. CPB K1 DELETED ?  JMP FER04 YES. SSB EMA DUMMY ENTRY ? JMP FER15 YES. STB F.A IN EMA ? JSB EA?.F JMP FER19 NO. LDA K48 YES. ERROR 48. JSB ER.F * FER19 LDA LDAI OUTPUT A JSB OA.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 CHAR COUNT (SET ZERO TO FLAG PRIOR LINE) FER07 LDA STAI AND A STA JSB S2NXT IN THE TEMP. JSB SOA.F (F.A = B) LDA T2FER SET UP TO SCAN REST OF STACK FOR DUPLICATES. STA T3FER (REMEMBER WHERE WE WERE) FER13 JSB S2NXT NEXT ITEM. SZB,RSS DONE ? JMP FER18 YES. LDA F.S2B GET ORIGINAL TEMP. ADA T3FER CPB A,I SAME AS ONE NOW WORKING ON ? CLE,RSS YES. (E=0) JMP FER13 NO, GO ON TO NEXT. CPB F.A FIRST ONE ? JMP FER14 YES, USE ORIGINAL. (E=0) LDA INT NO, ALLOCATE NEW ONE. JSB ATC.F CCA PERMANENTLY. ADA F.INT (E=1) STA F.INT FER14 LDA F.S2B T1FER = ADDR CURRENT WORD. ADA T2FER STA T1FER CLA,INA DELETE FIRST WORD OF ENTRY. STA T1FER,I ISZ T1FER GET SECOND WORD. LDA T1FER,I STB A,I USE IT TO PLACE ADDR TEMP IN DIM TABLE. CLA,INA DELETE SECOND WORD. STA T1FER,I LDA STAI GEN "STA" INTO TEMP SEZ IF FIRST ONE, HAS ALREADY BEEN DONE.  JSB SOA.F CLA DON'T REUSE TEMP FROM DIM PROCESSING. STA F.A JMP FER13 LOOK FOR MORE. FER18 LDA T3FER RESTORE POSITION. STA T2FER JMP FER04 * FER15 STB T1FER SAVE FIRST WORD. LDB .DLD GEN "DLD" JSB ODF.F LDB T1FER CMB LDA KK01 JSB OMR.F FER16 LDB .DST GEN "DST TEMP" JSB ODF.F JSB S2NXT JSB DEF.F JSB S2NXT LOOK AT NEXT ENTRY. CPB T1FER SAME AS THIS ONE ? JMP FER16 YES, ISSUE ANOTHER "DST" JMP FER17 NO, LOOP. (B = NEXT WORD) * S2NXT NOP GET NEXT ELEMENT ON STACK 2. ISZ T2FER BUMP RELATIVE POINTER. LDB F.S2B BASE ADB T2FER PLUS OFFSET LDB B,I ELEMENT JMP S2NXT,I * FER05 LDA F.LO CUT BACK STA F.S2B THE STACK STA F.S2T CLA STA F.L JMP FER.F,I RETURN SKP 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 TEMPS T1FER NOP T2FER NOP T3FER NOP KK01 OCT 100000 B7000 OCT 7000 BCOMI EQU B7000 K5 DEC 5 K48 DEC 48 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 SPC 2 DRT.F NOP CREATE STACK ENTRIES FOR EMA F.P. LDA F.RPL PUSH COMP. OF LOAD ADDR CMA JSB PU2.F LDA REA GET REAL TEMP JSB ATC.F CMB COMP: FLAG IS REALLY DUMMY STB T2FER,I PUT IN BCOMI ENTRY CCB MAKE TEMP PERMANENT. ADB F.INT+1 STB F.INT+1 JSB PU2.F PUT TEMP ADDR ON STACK. JMP DRT.F,I EXIT. 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.INT+0 LT.IN DEF T.INT B1000 OCT 1000 REL EQU B1000 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. X 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'? * ! ! 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) * ! ! ! ! '<'OR '[' * ! ! !<<<<<< ARR SUB * ! ! ! (P=0 IF (SIGN * ! ! PU1.F(F.A) EMA<'=') IF * ! ! ! INT * ! O<<<< ! FUN * ! ! * ! 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 * ! 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+1X! ! ! ! * ! ! ! ! ! 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) ! `NLH* ! ! * GET CPRIO FROM TABLE ! * CCODE FROM TABLE ! * CPRIO>PRIOR? ! * 1! 0! ! * PU2.F ! ! * (OP) ! ! * LASTC_F.TC ! ! * ! ! * TOP CENTER ! ! N* ! ! * ---------------------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! / ! ! * ^ (TOP CENTER) ! 1! 0! ^<<<<<<<<)! /(<<<< ! * ^ ! ! ERR.F ! ! / * ^ !OPCODE < 0? (16)ILL. DELIM. ! ! / * ^ ! 0! 1O<<<<<<<<<<<<<<<<<<<<)!(< ! * ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<)!(<< ! ! ! * ! ! ! ! * 4 O<<<<<<<< ! ! * ! ! ! * !<<<<<<<<<<<<<<<<<<<<<<<<< ! ! * ! ! ! * TYPE=DO INIT(-2) ! ! * OR ASSIGNMENT(-6)? ! ! * 1! 0! ! ! * RETURN O<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ! * ! ! * STK1T=0? ! * 0! 1! ! * NOT SUB ! ! * TEST ! !<<<<<<<<<<<<<<<<<<< * ! ! ! * O<<<<<<< SUARC * ! ! * TYPE=IF(-7)? ! * 0! 1! ! * ! ! ! * ! STK1T=0? ! * ! 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 (OPSTK 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 ! STYPE0 ?) (E=1) RSS (STMT FCT OR DUMMY) JMP EE04C NO. LDB F.AT MAYBE... WHICH ? CPB REL IOR B40K STMT FCT. SET BIT 14. JMP EE06 STMT FCT OR DUMMY, BUT NOT FIX-EXT. EE04C LDB F.A NOT STMT FCT. EXEC ? CPB .EXEC JMP EE06 YES, DISAVOW KNOWLEDGE. CMB,INB ELSE ADB F.DP WE KNOW HIM IF CCE,SSB,RSS ONLY IF IN FIX.EXT TABLE RAL,ERA SET SIGN BIT ON OPCODE TO INDICATE KNOWLEDGE JMP EE06 GO PUSH RESULT ON STACK 2 * EE05 CCE RAL,ERA (A)= F.A,I JSB PU1.F STACK OPERAND LDA KK43 STACK '[' AS CODE=33, PRIOR=1. LDB F.IU IF SUB CPB K.SUB THEN JMP EE04B STACK '<' AS CODE=33, PRIOR=1. * LDB EMAFL IF THIS IS A TARGET EMA VARIABLE SSB THEN RAR,CLE,ELA STACK AT PRIORITY 0 TO HOLD OFF. EE06 JSB PU2.F STACK OPERATOR JMP EE03 INPUT NEXT ELEMENT SPC 1 EE08 CPB B50 IS F.TC = '('? JMP EE11 YES, IT MUST START A SUB EXPRES. EE09 LDA F.IM F.IM OF PRESENT ITEM IS 0? SZA JMP EE095 NO - PROCESS OPERAND-TC COMBINATION. LDA LASTC YES - PREVIOUS CHARACTER IN THIS CPB NO IF PRESENT OPE|RATOR IS .NOT. JMP EE096 CPA B51 2 ADJACENT SPECIAL CHARACTER RSS COMBINATION MUST BE A ')' OR JMP EE16 ERROR 53 - MISSING OPERAND. EE095 CPB B51 F.TC = ) ? JMP EE12 YES CPB B54 NO, IS F.TC = ',' JMP EE12 YES CPB B15 NO, IS F.TC = 'C/R' ? JMP EE115 YES CPB B52 F.IM # 0. IS F.TC = '*'? RSS YES, SEE IF OPERATOR IS '**' JMP EE13 NO, TEST FOR - INTEGERE * JSB EXN.F EXAMINE NEXT CHARACTER LDA B52 CPA F.TC IS NEXT CHARACTER AN '*'? JMP EE02 YES, MUST BE EXPONENT OPERATION JMP EE14A NO, RESTORE F.TC = '*' SPC 1 EE096 CPA NO IF PREVIOUS OPERATOR IS .NOT., JMP EE16 ERROR 53 - ADJACENT OPERATORS JMP EE14 PROCESS DIRECTLY SPC 1 B52 OCT 52 B75 OCT 75 KK41 BYT 31,1 CODE=31, PRIORITY=1 (LEFT PAREN) SPC 1 EE11 STB F.SXF SET TO NON-ZERO AS A FLAG LDA KK41 STACK '(' AS CODE=21,PRIOR=1. JSB PU2.F STACK THE '(' JSB II.F INPUT NEXT ITEM LDB F.NT (B)= ITS NAME TAG CPA CPX IF ITS ITEM MODE IS COMPLEX AND SZB,RSS IT IS A CONSTANT, JMP EE110 NOT A COMPLEX CONSTANT STACK WAS RIGHT * JSB PO2.F SHOULD NOT HAVE STACKED THE '(' SO FIX IT JMP EE035 A COMPLEX CONSTANT WAS INPUT. * EE110 LDA LASTC IF PREVIOUS F.TC IS A ')' CPA B51 JMP EE16 ERROR 53 - MISSING OPERATOR. LDA B50 STA LASTC SET PREVIOUS F.TC TO '('. LDA F.IM GET F.IM OF ITEM JUST INPUT. SZA JMP EE035 LDB F.TC IF CHAR INPUT IS CPB B53 UNARY +, THEN JMP EE01 IGNORE IT AND INPUT NEXT ITEM. CPB B55 UNARY -, THEN JMP EE033 PROCESS AS UNARY MINUS JMP EE035 OTHERWISE PROCESS CURRENT ITEM SPC 1 EE115 CLA,RSS EE12 LDA K3 SET CURRENT PRIORITY OF DELIMITER STA CPRIO TO 3 AND CURRENT OPCOD=0, THEN CLA GENERATE CODE USING F.TC LATER STA CCODE TO 'REMEMBER' WHAT DELIMITER JMP EE40 WAS SCANNED. * EE13 CPB B55 "-"? RSS YES TRY TO COMBINE WITH WHAT FOLLOWS JMP EE14 NO - LOOK UP IN OP TABLE * JSB EXN.F GET NEXT CHARACTER LDB B55 RESTORE THE CURRENT STB F.TC "-" LDA F.DLF DELIMETER INPUT? SZA IF SO JMP EE14 FORGET THE LOOK AHEAD * JSB IDN.F INPUT DO NOT ASSIGN LDB F.TC SAVE THE NEW F.TC STB T4EE FOR LATER STA T6EE SAVE THE MODE ALSO CPB B52 "*" IF '*' OR '**' OR '/' JMP EE13A THEN FIX VIOLATES PRECEDENCE * CPB B57 "/" SO DON'T DO IT JMP EE13A * LDB F.NT NAME TAG TO B CPA INT INTEGER AND SZB,RSS A CONSTANT?? JMP EE13A NO. GO UN DO THE DAMAGE * LDB F.IDI YES - COMBINE WITH CMB,INB THE '-' WE ARE HOLDING STB F.IDI AND RESET LDB B53 RESET TO STACK A '+' RSS AS THE CURRENT OPERATOR * EE13A LDB B55 NOT A INTEGER CONSTANT SO STB T5EE SAVE THE F.TC VALUE FOR AFTER THE ASSIGNMENT SZA IF F.IM IS NOT ZERO CPA TWPE OR 'H' STRING HANGER JMP EE13B THEN * JSB AI.F ASSIGN ITEM LDA F.NT IF NAMED ITEM SZA,RSS GENERATE JSB CRP.F A XREF FOR IT EE13B LDB F.A SAVE ITS LDA T5EE (GET THE SAVED F.TC) STB T5EE LOCATION FOR NEXT TIME AROUND JMP EE14A GO STACK THE OPERATOR * B40K OCT 40000 TWPE EQU B40K F.IM=TWPE B57 OCT 57 "/" SKP EE02 LDA DSTAR CHANGE F.TC TO '**' ISZ F.CC SHOVE F.CC PAST SECOND '*' EE14A STA F.TC EE14 CLA (A) WILL BE !CODE FOR OPERATOR LDB OPTBL INB EE15 STB T0EE SEARCH OP. TABLE FOR INA MATCH WITH F.TC. LDB B,I CPB F.TC JMP EE17 FOUND IT. * LDB T0EE ADB K3 CPB EOPTB END OF TABLE JMP EE16 YES * JMP EE15 SPC 1 KM2 DEC -2 K3 DEC 3 B15 OCT 15 EOPTB DEF EOPT B51 OCT 51 SPC 1 EE17 CPB B75 IS OPERATOR AN '='? RSS YES, MAKE SURE IT IS LEGAL. JMP EE18 NO, PROCESS OPR ISZ EQFLG IS '=' ALLOWED AND NONE SEEN YET? JMP EE16 NO,'=' IS ILLEGAL IN PRESENT EXP EE18 ISZ T0EE YES, OPERATOR IS LEGAL, PROCESS. LDB T0EE,I (B) _ PRIORITY OF OPERATOR STA CCODE SAVE OPCOD OF CURRENT OP. STB CPRIO SAVE PRIORITY OF CURRENT OP. ALF,ALF IOR B (A) _ CODE, PRIORITY CMB,INB CHECK OP PRIORITY AGAINST TOP OP ADB PRIOR SSB,RSS IS PRIORITY > TOP OP. PRIORITY? JMP EE20 NO, GENERATE CODE JMP EE06 YES, STACK OP, INPUT NEXT ITEM SPC 1 K10 DEC 10 DSTAR ASC 1,** CCODE NOP CURRENT OPERATOR CODE CPRIO NOP CURRENT OPERATOR PRIORITY OPTBL DEF TABLE-1 OPERATOR TABLE SPC 1 * WORDS TO HOLD BASE NAMES OF TEMP CELLS * DURING EXPRESSION EVALUATOR EXECUTION SPC 1 T.INT BSS 3 NOP BSS 3 K4. DEC 4 SKP EE42 SSA IF OPCOD < 0, JMP EE60 END OF INPUT EXPRESSION. EE20 LDA OPCOD NEXT OPERATOR CODE CPA SOP< IF '<' '(' OF ARRAY JMP EE49 ERROR - MISMATCHED PARENS. * CPA SOPPR IF '(' JMP EE44 ERROR - MISMATCHED PARENS. * CPA SOP[ IF '[' JMP EE44 ERROR - MISMATCHED PARENS. * LDB K2 ASSUME NO. OF OPERANDS IS TWO. CPA K4. IS OPERATION A UNARY MINUS? CLB,INB YES - 1 OPERAND CPA K10 UNARY .NOT.? HFB CLB,INB YES - 1 OPERAND STB PNUM SAVE NO. OF OPERANDS. CPB K1 IF ONLY 1 OPERAND JMP EE21 CHECK ONLY F.S1T,I. LDB STK1N,I IF NEXT-TO-TOP OPERAND IS SZB,RSS IN REGISTERS, JMP EE21 CHECK TOP OPERAND DIRECTLY. STB F.A OTHERWISE MAKE SURE NEXT TO TOP JSB FA.F OPERAND IS NOT A SUBPROGRAM JSB NST.F NAME. IF IT IS, ERROR 25. EE21 LDB F.S1T,I IF TOP OPERAND IS IN REGISTERS SZB,RSS JMP EE22 CONTINUE - GENERATE CODE. STB F.A OTHERWISE MAKE SURE JSB FA.F TOP OPERAND IS NOT JSB NST.F SUBPROGRAM NAME. IF IT IS, ERROR. EE22 LDA OPCOD STA LOPCD SAVE AS LAST OPCODE ALS ADA OPCOD ADA OPTBL (A) = OPTBL + 3*OPCOD LDA A,I (A) = ADDRESS OF CODE GENERATOR. JSB A,I JUMP TO CODE GENERATOR JSB PO1.F POP OPERANDS OFF STACK 1. LDA RESLT JSB PU1.F PUSH RESULT ON OPERAND STACK 1. JSB PO2.F POP OPERATOR OFF STACK 2. EE40 LDA CPRIO CMA,INA ADA PRIOR COMPARE OPERATOR PRIORITIES SSA,RSS IF PRIOR=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 PH 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 F.TC IF THIS IS A CPA B54 ',' OR RSS CPA B51 ')' THEN ISZ EAC.F RETURN TO P+2 INSTEAD. JMP EAC.F,I RETURN * * 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. JSB PO2.F POP '<' OFF OP STACK 2. JMP EE51 EE07 JSB PO2.F POP '<' OFF SO AEA RECOG. CALL-BY-REF. JSB AEA.F GEN. ARRAY ELEMENT ADDR CALC. EE51 JSB PO1.F POP OPERANDS OFF STACK 1. LDA RESLT JSB PU1.F PUSH RESULT ON STACK 1 JMP SUARC,I RETURN * * EE46 SZB,RSS IF PRIORITY ZERO GEN. DO IT LATER JMP EE50 * JSB EXN.F SKIP BLANKS & SET F.TC FOR EAC.F JSB SUARC GENERATE SUB. OR ARRAY 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 RESULT 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 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 U 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 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 h 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. SSAI SSA IF TEMP CELL, JMP NEG04 GENERATE JSB ..DCM OR ..CCM NEG03 LDA TTYPE STA T2TAS SAVE THE TYPE FOR TAS LDA F.TC GET THE CURRENT CHAR LDB STK1N GET POINTER TO NEXT OPERAND JSB TAS.F ALLOCATE DBL OR CPX TEMP CELL.IF NEEDED LDB F.S1T,I SOURCE OF JSB .DFER OR .CFER STA F.S1T,I SAVE TEMP DESTINATION ON STACK CPA B IF MOVE IS TO SELF RSS SKIP IT 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,wI 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 FORCE 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 Sh 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? LDB .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  STA RESLT RESULT WILL BE IN REGISTERS JMP EXP08 GENERATE REMAINDER OF CALL. SEQ. SPC 1 EXP07 JSB ATM.F ALLOCATE TEMP FOR DEF RESULT IF NEEDED 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 OUTPNLHUT 'CLA,RSS' 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 !+N 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 COMMUTE 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 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 STA T2TAS SAVE TYPE FOR TAS LDA F.TC SAVE THE CURRENT CHAR STA T1TAS SO WE CAN LOOK AHEAD JSB EXN.F GET THE NEXT CHAR LDB T1TAS RESTORE THE STB F.TC LAST TC LDB S1LOC GET LOCATION OF NEXT OPERAND INB JSB TAS.F ALLOCATE DBL OR CPX RESULT TEMP IF NEEDED 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 LD HA 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 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 ADDRESS * * ************************* 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 K3|8 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,INA 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 LDA 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 .ERES DEF .TBL+55 AS ABOVE BUT WITHOUT MAPPING. 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 Z? 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 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 EAC.F IS IT CALL-BY-REF ? JMP AEA26 NO. LDA T7AEA IS IT ZERO-DIM CASE ? SSA JMP AEA25 YES. USE ADDRESS DIRECTLY. LDB .ERES NO. USE ADDRESS RESOLVER. AEA26 JSB ODF.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 JSB EAC.F CALL-BY-REF ? STB F.RF NO, SHOW REGS CONTAIN AN 'EMA' ADDRESS LDA BMAX OUTPUT 77777B INSTEAD OF DEF TO EMA MASTER. JSB OW.F OCT 0 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 sF.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 CLB,INB SET FOR RESULT TO BE IN B-REG. JSB EAC.F CALL-BY-REF ? JMP AEA24 NO, SET UP AS ADDR & EXIT. CLA YES, SET UP AS REAL IN A&B & EXIT. JMP AEA27 * AEA25 LDA REA SET UP REAL CONST JSB ESC.F LDB T1AEA A.T. PTR INB GET DIM OR BCOM PTR LDB B,I LDA T1AEA,I CHECK IF ARRAY. AND B600 CPA ARR IF SO, INB,RSS SKIP THE DIM ENTRY RSS TO GET TO THE LDB B,I BCOM ENTRY. INB LOAD EMA OFFSET. LDA B,I A = LSB. CMA,SSA,RSS DUMMY ? JMP AEA27 YES, JUST POINT TO TEMP. CMA ADB K2 LDB B,I B = MSB. CLE,ERB DELETE BIT 15. RAL,ERA DST F.IDI SET CONSTANT VALUE. JSB AI.F ENTER IN TABLE. LDA F.A GET A.T. PTR FOR CONSTANT. AEA27 STA RESLT NOTE LOCATION OF 2-WORD ADDRESS. LDA REA SET IT TO BE REAL. STA TTYPE STA F.TA_C JMP AEA.F,I RETURN. * AEA11 LDA ADAI. JSB OMR.F GENERATE ADA BASE OF VECTOR AEA06 CLB SET RESULT FOR A-REG. AEA24 STB 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 BMAX OCT 77777 VALUE TO FAKE OUT .EMAP KM2. DEC -2 F.RF NOP SKP * ************************* * * 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 * * * ******************************************** * * LOOK AHEAD FOR ASSIGNMENT TO AVOID TEMP * * ******************************************** * * THE TAS ROUTINE LOOKS AHEAD TO SEE IF A TEMP IS REALLY NEEDED * FOR DOUBLE OR COMPLEX. IF NOT THE FINAL DESTINATION IS SET UP. * * CONDITIONS CHECKED ARE: * * NEXT CHAR (IN A) IS A C/R * WE ARE WORKING ON AN ASSIGNMENT STMT. * THE NEXT OPREATOR IS = * THE NEXT OPERAND IS OF THE SAME TYPE AS THE REQUESTED TEMP * * CALLING SEQUENCE: * * SET T2TAS TO THE REQUIRED TYPE * SET A (REG) TO THE NEXT CHAR. * SET B (REG) TO POINTER TO THE NEXT OPE.RAND * JSB TAS.F * ON RETURN A=B= POINTER TO A.T. OF TEMP OR NEXT OPERAND AS REQUIRED * TAS.F NOP STB T1TAS SAVE THE OPERAND POINTER CPA B15 IF NOT A C/R RSS THEN GO JMP TAS01 ALLOCATE THE TEMP * LDA TYPEX IF NOT CURRENTLY WORKING CPA KM6 ON AN ASSIGNMENT STMT. CCB,RSS THEN JMP TAS01 GO ALLOCATE THE TEMP * ADB F.S2T BACK DOWN THE OPREATOR STACK LDA B,I GET THE NEXT OPERATOR CPA EQOPC IF NOT AN = CLB,INB,RSS THEN GO JMP TAS01 ALLOCATE THE TEMP * ADB F.SVL NOW MAKE SURE WE DON'T HAVE ADB F.S2B AN EMA INVERSE ASSIGN ALSO LDA B,I IF CPA INASS INVERSE ASSIGN JMP TAS01 MUST NOT TOUCH * LDB T1TAS,I GET THE A.T. POINTER FOR THE NEXT OPERAND JSB FT.F CHECK ITS TYPE CPA T2TAS IF THE SAME JMP TAS02 ALL TESTS PASS GO FIX IT UP * TAS01 LDA T2TAS TEST FAILED MUST ALLOCATE THE TEMP JSB ATC.F DO IT JMP TAS.F,I AND RETURN * TAS02 ISZ PNUM SET TO POP ONE MORE OPERAND JSB PO2.F POP THE EXTRA OPERATOR LDA T1TAS,I USE THE NEXT OPERAND AS THE DESTINATION LDB A PUT IN BOTH REGS. JMP TAS.F,I AND RETURN * * T1TAS NOP T2TAS NOP EQOPC OCT 401 = CODE WITH PRIORITY * * **************************************** * * 2 OPERAND LOOK AHEAD FOR ASSIGNMENT * * **************************************** * THIS ROUTINE CALL TAS FOR 2 OPERANDS * ATM.F NOP CONDITIONAL TEMP (NONE IF = NEXT) STA T2TAS SAVE THE REQUIRED TEMP TYPE LDA F.TC GET THE NEXT CHAR LDB STK1N GET ADDRESS OF THE NEXT OPERAND INB TO B JSB TAS.F CALL TAS TO TEST IT AND ALLOCATE JMP ATM.F,I RETURN SKP * ******************** * * PREPARE OPERANDS * * ******************** SPC 1 PO.F NOP SET UP OPERANDS FOR OBJ CODE GEN JSB MAT.F MATCH OPERAND TYPES,GEN CONV COD 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 ATM.F ALLOCATE TEMP FOR DBL OR CPX IF NEEDED 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 .DyLD 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; USE 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 .NLHJMP 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 pON 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/CPX 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 ADDR8ESSED 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 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 BASE 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 EITHER 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 * * P*************************** 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 AND KK37 CLEAR POSSIBLE BITS 15 & 14. ALF,ALF STA OPCOD OPCOD _ CODE OF TOP OPERATOR JMP SPC.F,I * KK37 OCT 37777 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 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 PRIORITY=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 ENB@K3 OCT 3 K9 DEC 9 K19 DEC 19 K35 DEC 35 B40 OCT 40 B2000 OCT 2000 DUM OCT 5000 KK01 OCT 100000 SPC 1 SUB OCT 200 VAR OCT 400 COM. OCT 4000 INT OCT 10000 REA OCT 20000 LOG OCT 30000 CPX OCT 50000 LO1 DEF LO1A LO2 DEF LO2A LO3 DEF LO3A LO4 DEF LO4A LO5 DEF LO5A IM1 DEF IM1A IM2 DEF IM2A IM3 DEF IM3A IM4 DEF IM4A IM5 DEF IM5A * DLBU. DEF LBUF ADDR DBL LBUF+5 ADDR2 DBR LBUF+7 USAGE DEF LBUF+12 TYPE DEF LBUF+22 LOCAT DEF LBUF+27 * IU1 DEF IU1A IU2 DEF IU2A IU3 DEF IU3A IU4 DEF IU4A IU5 DEF IU5A IU6 DEF IU6A IU7 DEF IU7A IU8 DEF IU8A SKP * ** PROCESSING COMPLETED ** * * *********************** * * 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 LABLE DEF SYTH HEADR DEF SYTH2 K7. OCT 7 * * * CLEAR LIST BUFFER * SPC 1 CLR1 NOP LDA LABLE,I 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 SLBUF DEF 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 ^640 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 KM5 DEC -5 "0" OCT 60 * SPC 2 * * ******************************** * * 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 SPC 1 SKP * *************************** * * VARIABLES AND CONSTANTS * * *************************** |6 SPC 1 SYTH ASC 7, SYMBOL TABLE * SYTH2 ASC 6, NAME ASC 6,ADDRESS ASC 10,USAGE ASC 5,TYPE ASC 4,LOCATION * IU1A ASC 9,STATEMENT NUMBER IU2A ASC 9,STATEMENT FUNCTION IU3A ASC 9,SUBPROGRAM IU4A ASC 9,VARIABLE IU5A ASC 9,ARRAY(*) IU6A ASC 9,ARRAY(*,*) IU7A ASC 9,ARRAY(*,*,*) IU8A ASC 9,COMMON LABEL * IM1A ASC 4,DOUBLE PRECISION IM2A ASC 4,COMPLEX IM3A ASC 4,INTEGER IM4A ASC 4,LOGICAL IM5A ASC 4,REAL * LO1A ASC 4,EXTERNAL LO5A ASC 1,L L FOR LABELED COMMON LO2A ASC 4,COMMON LO3A ASC 4,DUMMY LO4A ASC 4,LOCAL LO6A ASC 3,(EMA) LBUF ASC 1, BSS 46 LIST BUFFER K16 DEC 16 HED F4.3 XREF SECTION XREF JSB EJP.F FINISH OFF THE SYMBOL TABLE LDA F.CCW CHECK IF XREF AND K16 REQUIRED LDB K4 LOAD INIT SEG FOR NEX MODULE IN CASE SZA,RSS WELL? JMP F.SEG NO XREF REQUESTED GO DO NEXT MODULE * CLA XREF REQUESTED SET UP FOR IT JSB SKL.F SKIP LINE DEBUG ONLY JSB RWN.C REWIND XREF DISC FILE DEF C.SC1 JMP FERR ERROR REPORT AND EXIT SPC 1 * THE MEMORY AREA USED IN THIS SEGMENT IS IN THREE PARTS * PART 0 IS FROM THE BEGINING OIF THE SEGMENT DOWN TO 'PAS1' BELOW * PART 1 IS FROM THE END OF THIS SEGMENT (AS DEFINED BY GMS.C) * TO THE BEGINING OF THE ASSIGNMENT TABLE. PART TWO IS FROM * THE END OF THE ASSIGNMENT TABLE TO THE END OF AVAILABLE MEMORY * (THESE ARE DEFINED BY F.LO AND F.DO). * * THESE AREAS ARE FILLED WITH THE CROSS REFERENCE PAIRS GENERATED * IN PASS ONE IN CIRCULAR FASHION SO THAT WE ALWAYS HAVE THE LAST * N RECORDS IN MEMORY. THIS MEANS THAT FOR LARGE PROGRAMS WHERE * THERE IS NOT ENOUGH MEMORY TO CONTAIN ALL THE CROSS REFERENCE PAIRS * WE NEED ONLY READ THE BEGINNING OF THE FILE TO GET THE RECORDS THAT * ARE NOT IN MEMORY. * * TO DO ALL THESE WONDERS WE USE THE FOLLOWI*NG POINTERS: * * STM0 START OF MEMORY POOL (F4.3) * ENDM0 END OF POOL ZERO ~ 'PAS1' * STMEM START OF MEMORY * ENDM1 END OF FIRST MEMORY * F.LO START OF SECOND MEMORY * ENDM2 END OF SECOND MEMORY AREA * FREC NUMBER OF LOWEST NUMBERED X-REF RECORD IN MEMORY * FRLOC THE ABOVE RECORDS ADDRESS * SPC 1 * THE CODE BELOW USES FOUR ADDRESSES: * PLIST AND ULIST ARE DEFINED AT THE * END OF THIS SEGMENT; * F.LO = END OF ASSIGNMENT TABLE + 1 AND * F.DO = END OF MEMORY. SPC 1 * IF F.DO - F.LO > 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 * NEXTP NOP 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 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 P* * ************* 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 COUNTER 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 XRLOC DEF LINE+6 RFLOC NOP COUNT NOP K32 DEC 32 K8 DEC 8 STM0 DEF F4.3 START OF MEMORY POOL 0 ENߕDM0 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 POOL? 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 OUT 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 * T 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 IS 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 INp640 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 TO 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 KM2 DEC -2 K33 DEC 33 KM16 DEC -16 SAV BSS 1 ORG * END F4.3 ݢ6 & 92060-18098 2026 S C0222 &4FTN4 SEGMENT 4             H0102 @ASMB,Q,C HED ** FTN4 COMPILER (SEG: F4.4) INITIALIZE THE COMPILER ** NAM F4.4,5 92060-16098 REV.2026 800423 * ***************************************** * 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. * *************************************************************** * NAME: F4.4, PART OF FTN4 COMPILER. * * SOURCE: 92060-18098 * * RELOC: 92060-16098 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ABT ABORT COMPILE EXTRY EXT F.AT. SUBSCRIPT INFO FLAG EXT F.CC CHARACTER COUNT  EXT F.CCW FTN OPTION WORD EXT F.D DO TABLE POINTER EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DO LWAM - END OF DO TABLE EXT F.DP BASE OF USER SYMBOL TABLE EXT F.DTY IMPLICIT TYPE TABLE EXT F.E EQUIVALENCE TABLE POINTER EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE 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.IDI INPUT ARRAY NON-NUMERIC EXT F.INT TEMP VARIABLE ARRAY EXT F.HDL LENGTH OF HEAD MESSAGE EXT F.LLT ADDRESS OF LINE LOCATION TABLE (SET BY INIT) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.LSF EXPECT FIRST STATEMEXT FLAG EXT F.LSP LAST OPERATION FLAG EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NXN NO INPUT FLAG EXT F.PAK PACK BUFFER WORD 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.SEG LOAD A NEW SEGMENT EXT F.SID STATEMEXT ID PHASE FLAG EXT F.STA FLAG THAT IS ZERO UNTIL THE FTN STATEMEXT IS READ EXT F.TC NEXT CHARACTER EXT F.TIM TIME ARRAY ADDRESS IN HEAD * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT BOM.F DISASTOR ERROR REPORT (NO RETURN) EXT CDI.F CLEAR IDI ROUTINE EXT DAF.F DEFINE (F.AF) EXT DAT.F DEFINE (AT) EXT ER.F ERROR PRINT SUBROUTINE 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 IN2.F INIT FOR OA.F MODULE EXT IN3.F INIT FOR ENX:u.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 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 NTI.F MOVE NID TO F.IDI (PACKS) EXT SNC.F START NEXT CARD SUBROUTINE EXT TS.F TAG SUBPROGRAM SUB. * * 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 EXT Z$DBL 3/4 WORD DEFAULT OPTION * 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 PRM.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 K98 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 T1o SAVE IT ADA LFIX CHECK IF ROOM ABOVE ADA K8 FOR FIX-EXT-TBL ADA K98 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 KM98 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 K98 (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 K49 DO FOR BOTH BUFFERS STB A,I JMP NEWMD GO FINISH UP * ERR3 LDA K3 03 SYMBOL TABLE OVERFLOW 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 K98 DEC 98 KM98 DEC -98 KM8 DEC -8 K49 DEC 49 * 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.~lSTA 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 COMPENSATE 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): * * QXY EFD BCT AML * * Q = LIST LOAD ADDRESS OF EACH STATEMENT. * X = USE 48 BIT DOUBLE PRECISION (VS 64-BIT) * 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 CME05 JSB ICH.F NEXT CHARACTER. 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) JSB CCO.F CONVERT CONTROL OPTION. SZA,RSS FOUND ? JMP CME10 NO. IOR NLTEM YES. SET THE OPTION(S) STA NLTEM AND B3000 X & Y OPTIONS. CPA B3000 BOTH SET NOW ? JMP CME08 YES, ERROR. LDA B THE OPTION BY ITSELF. IOR DUPS REPEATED ? CPA DUPS JMP CME08 YES, ERROR. STA DUPS JMP CME05 GO FOR MORE. CME10 LDB OPTSE B = CHAR. CPB B15 JMP PCONT ENDS ON COMMA. 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 CME05 SPC 1 CME08 LDA K2 JMP F.ABT ERROR IN FTN CONTROL CARD SPC 1 PCONT CLA END OF CTRL STMT. STA F.NXN LDA NLTEM X OR Y SELECTED ? AND B3000 SZA JMP PCON1 YES. LDB Z.DBL NO... Y DEFAULT ? CPB K4 LDA B1000 YES, SET Y. PCON1 STA NEWOP IOR NLTEM SET THE STA F.CCW CONTROL WORD SPC 1 JSB IN2.F INITIALIZE OA.F AGAIN CLA JSB IN7.F GET IDN TO PICK THE 'Y' BIT JSB PRM.C GET THE OPTIONAL CONTROL PRAMS DEF K5 STB AD SET THE PARAMETER ADDRESS LDA KM6 SET COUNTER FOR NO. OF PRAMS STA COUNT CLOP LDB AD START LOOP CLE,ERB CONVERT TO A WORD ADDRESS LDA B,I GET THE WORD SEZ,RSS ROTATE IF ALF,ALF NEEDED  AND B377 ISOLATE THE WORD SZA,RSS ANY ZERO'S INVALIDATE THE WHOLE THING JMP NIXOP SO BAIL OUT * LDB A PUT CHAR TO B JSB CCO.F CONVERT CONTROL OPTION. AND KK01 DISALLOW X,Y. IOR NEWOP STA NEWOP SET DOWN THE NEW WORD ISZ AD STEP THE ADDRESS ISZ COUNT AND THE COUNT JMP CLOP DO THE NEXT CHAR. * STA F.CCW IF WE GET HERE THEN SET THE NEW CONTROL WORD NIXOP LDA DNIX SET F.EQE TO POINT TO HERE INCASE STA F.EQE OF ERROR 90 (FIRST STMT. IS A CONTINUE) CLE CLEAR E FOR IN6.F (NOT A NEW MODULE) JSB INIT SET UP TO CHECK FOR CONTINUED LINES JSB SNC.F DISMISS THE FTN STATEMENT CLA CLEAR THE ERROR SWITCH STA F.EQE SO OTHER ERRORS DO STD. THING LDA F.CCW MODIFY THE CONTROL WORD IOR B40 ALWAYS DO BINARY LDB BFLG UNLESS SZB,RSS NO XOR B40 FILE GIVEN FOR OUTPUT STA F.CCW SET THE FLAG WORD * JMP PPNM FINISH SETTING UP * DNIX DEF NIXOP * ERROR LDA K99 ERROR ON PASS FILE WRITE IT JMP ABT IS AN ERROR 99 * BERR CPA KM201 IF NO BINARY FILE JMP NOBIN GO SET IT UP * LDA K97 OPEN ERROR ON BINARY FILE JMP ABT * NOBIN CLA CLEAR THE STA BFLG BINARY FLAG JMP BERX CONTINUE THE SET UP SPC 2 CCO.F NOP CONVERT CONTROL OPTIONS. LDA DOPTS SET UP POINTER. STA T1CME STB OPTSE USE ORIGINAL VALUE TO END TABLE. CLA,INA START WITH L=1. CCO01 CPB T1CME,I THIS ONE ? JMP CCO02 YUP. RAL NO. TRY NEXT. ISZ T1CME JMP CCO01 CCO02 LDB A SAVE ACTUAL OPTION. CPA K2 M ? IOR B14 YES, SET A & T. CPA K4 A ? IOR B10 YES, SET T. CPA B4000 Q ?  IOR K1 YES, SET L. CPA OPTSX NOT FOUND ? CLA IF SO, RETURN A=0. JMP CCO.F,I EXIT. A=OPTIONS, B=SINGLE OPTION. * DOPTS DEF *+1 OPTIONS TABLE. OCT 114 L = 1 OCT 115 M = 2 OCT 101 A = 4 OCT 124 T = 10 OCT 103 C = 20 OCT 102 B = 40 OCT 104 D = 100 OCT 106 F = 200 OCT 105 E = 400 OCT 131 Y = 1000 OCT 130 X = 2000 OCT 121 Q = 4000 OPTSE BSS 1 MISSING = 10000 OPTSX OCT 10000 * N35 DEC -35 ************DBUG ONLY************************** PRMPT ASC 1,]_ PROMPT WITH ']' NLTEM NOP T1CME NOP TEMP FOR CME & CCO. DUPS NOP FOR CATCHING DUPLICATES. BM61 OCT -61 KM9. DEC -9 "N" OCT 116 'N' "FT" ASC 1,FT ERR0 OCT 51072 ASC 1,R0 +10 Z.DBL DEF Z$DBL+0 3/4 WORD DEFAULT. KM6 DEC -6 AD NOP COUNT NOP B377 OCT 377 NEWOP NOP B15 OCT 15 B14 OCT 14 B54 OCT 54 ',' K8 DEC 8 B10 EQU K8 K55 DEC 55 KN10 DEC -10 K99 DEC 99 K67 DEC 67 KM201 DEC -201 B40 OCT 40 B1000 OCT 1000 B3000 OCT 3000 B4000 OCT 4000 KK01 OCT 174777 BFLG OCT 40 BINARY FLAG (SET FOR BINARY) K97 DEC 97 DMAN DEF NOFTN ERROR RETURN ON INPUT ERROR * INIT NOP CALL ALL THE INIT SUBS IN THE MAIN LDA NOLIN PASS THE LINE COUNT LDB F.CRB AND THE CARD BUFFER ADDRESS JSB IN6.F TO IC.F CCA SET THE STA F.EQF NOT PROCESSING EQU'S FLAG CLA JSB IN2.F OA.F CLA JSB IN3.F ENX.F CLA JSB IN4.F FA.F CLA JSB IN5.F EX.F CLA JSB IN7.F IDN.F JMP INIT,I RETURN * * NOFTN CLE JSB INIT CALL INIT SUBS LDA MFLC MOVE "FTN. " JSB MPN.F TO NBUF,ERBF,HEADL LDA DMAN SET UP ERROR RETURN STA F.EQE FOR POSSIBLE INPUT ERROR JSB SNC.F TEST FOR END$ CARD CLA,INA STA F.CC SET CC=1 STA F.NXN SET NO INPUT FLAG LDA K2 JSB IA.F INPUT 2 CHARS. LDA F.PAK CPA EN 'EN' ? RSS YES JMP MAIN4 NO * LDA K2 JSB IA.F INPUT 2 CHARS. LDA F.PAK CPA EN+1 'D$' ? JMP TRM YES. NO MORE; WRAP IT UP. * MAIN4 CLA STA F.EQE CLEAR THE ERROR RETURN FLAG STA F.NXN RESET NO INPUT FLAG STA SUBFN CLEAR CARD INPUT FOR PROGRAM. INA STA F.CC SET CC=1 STA F.SID AND THE SCAN FLAG SKP * ************************* * * POSSIBLE PROGRAM NAME * * ************************* SPC 1 PPNM JSB IN4.F MAKE SURE FA.F GETS THE Y BIT LDA F.ER0 STA ER.R0 NAME OF ERROR ROUTINE. LDA F.CCW Y OPTION ? AND B1000 SZA,RSS JMP PPNM1 NO. LDA .DSIN YES, ADD ERROR RETURNS FOR IOR B60 .SIN, .COS, & .ATN2 STA .DSIN LDA .DCOS IOR B60 STA .DCOS LDA .DAT2 IOR B60 STA .DAT2 STA .DAT3 PPNM1 LDB F..DP SET UP TO MOVE IN THE LDA DFIX FIX-EXTERNAL SYMBOLES JSB .MVW USE MOVE WORDS DEF LFIX LENGTH OF TABLE NOP LDB F.DNB GET ADDRESS OF NAM RECORD BUFFER LDA PRNM GET ADDRESS OF PROTO NAM RECORD JSB .MVW MOVE PROTO TO BUFFER DEF K17. 17 WORDS NOP LDA DTYP SET UP THE IMPLICIT TYPE LDB F.DTY TABLE JSB .MVW IN F.IDN DEF K13 IT IS 13 WORDS LONG NOP LDA MFLC GET THE DEFAULT NAME JSB MPN.F AND REINSERT IT IN THE NAM BUFFER LDB INITB CLEAR RBL,CLE,SLB,ERB LDB B,I CLA STA B,I LDA F.AT.-1 GET SIZE OF AREA STA RSAVE SAVE IT STB A INB JSB .MVW CLEAR THE AREA DEF RSAVE NOP JSB CDI.F SET F.IDI TO 0. LDA PPNK3 MOVE FROM KK36 LDB PPNK4 TO F.INT RBL,CLE,SLB,ERB REMOVE POSSIBLE INDIRECT LDB B,I JSB .MVW INITIALIZE TEMP CELL START LOCS. DEF K7 NOP LDA F..DP DATA POOL START LOCATION ADA LFIX STA F.LO END OF ASSI TABLE LOC. +1 STA F.S2B STA F.S2T F.S2T=F.S2B=LO STA F.LSF F.LSF NON-0 (EXPECT 1ST STATEMNT) STA F.LSP ADA N1 COMPUTE START OF USER SYMBOL TABLE STA F.DP AND SET IT LDA F.DO LAST AVAILABLE MEMORY LOCATION STA F.E STA F.D STA F.S1B STA F.S1T F.S1T=F.S1B=D CCA STA F.EQF F.EQF=-1 STA F.EMA NO EMA IS -1 SUBFN JSB IC.F READ THE "PROGRAM" STATEMENT. CLA,INA SET F.CC STA F.CC TO 1 STA F.NXN SET NO INPUT FLAG JSB IC.F GET THE FIRST CHAR. IN THE LINE CPA "$" IS IT A CONTROL STMT.? JMP EMA YES GO TEST FOR EMA * NOEMA LDA L..DP PASS THE ACTUAL S.T. BASE TO F4.0 STA F.IDI IN F.IDI CLB GO TO SEGMENT STB F.NXN CLEAR THE NO INPUT FLAG CLA,INA RESET STA F.CC THE COLUMN COUNTER JMP F.SEG 0. * MFLC DEF KK32 KK32 ASC 3,FTN. DEFAULT OBJ PROG NAME PPNK3 DEF KK36 PPNK4 DEF F.INT INITB DEF F.AT. INIT. TO 0 AREA BEGIN ADDR. EN ASC 2,END$ * PRNM DEF *+1 PROTO NAM RECORD K17. DEC 17,0,0,0,0,0,0,0,0,3,99,0,0,0,0,0,0 K13 DEC 13 B60 OCT 60 DTYP DEF *+1 BLNK ASC 4, BLANKS HAPPEN TO BE REAL (A-H) OCT 10020,10020,10020 THESE ARE INTEGER (I-N) ASC 6, MORE REALS (M-Z) K1 DEC 1 K7 DEC 7 KK36 OCT -1000,-2000,-3000,-4000,-5000,-6000,-7000 K14 DE%C 14 K20 DEC 20 K25 DEC 25 F.CRB NOP CARD BUFFER ADDRESS "$" OCT 44 ** * LSE.F NOP LOCAL SEGMENT NAME FINDER LDA LSE.F,I TO FIND ALL BUT ISZ LSE.F SEGMENT 2 LDA A,I GET NUMBER OF REQUESTED SEGMENT CPA K4 IGNOR 4 (CURRENT) CLA CPA K2 AND 2 CLA SET TO 0 STA LS2.F SET FOR CALL JSB SEG.F CALL THE EXTERNAL NAME FINDER DEF LS2.F JMP LSE.F,I RETURN * * LS2.F NOP ROUTINE TO FINE NAME OF SEGMENT 2 ONLY JSB SEG.F USE EXTERNAL NAME FINDER DSNO DEF K2 PASS 2 AT ALL TIMES ISZ LS2.F JMP LS2.F,I RETURN * INERR JSB OPN.C ERROR ON SOURCE FILE TRY LIST DEF C.LST JMP TRMSL IF PROBLEMS SKIP ON OUT * LDA K67 INPUT FILE PROBLEMS ABT JSB BOM.F DISASTOR SEND THE MESSAGE TRM LDA F.CCW CHECK IF BINARY FILE AND B40 IF SO SZA,RSS THEN JMP NXBIN * JSB EOF.C MUST EOF ON IT DEF C.BIN JMP EOFBE ERROR REPORT IT * NXBIN DLD F.ERN+1 ACCUMULATE THE ERROR TOTALS ADA F.ERF ADB F.ERF+1 STA ERMX SET THE NUMBER OF ERRORS STB TOTER AND THE TOTAL ERROR COUNT LDA BOM.F DISASTOR EXIT? SZA SKIP IF NOT CLA,INA SET DISASTOR COUNT OTHERWISE STA DISCT PUT COUNT IN MATRIX ADA ERMX SUBTRACT CMA,INA THE ERRORS FROM THE TOTAL COUNT ADA B TO GET THE WARNINGS STA WAR SET THE # OF WARNINGS JSB EOF.C CLOSE THE LIST FILE DEF C.LST JMP EOFLI IF ERROR REPORT IT * TRM1 CLA CLEAR CLB THE ERROR COUNTERS DST F.ERN+1 FOR POSSIBLE RE RUN STA F.STA ALSO THE BEEN HERE FLAG LDA DISCT GET THE DISASTER COUNT JSB ASC.F CONVERT IT CPA "00" IF NONE LDA "NO" NLHUSE NO STA ENMES+6 SET IN THE MESSAGE DLD "NOX" DST ENMES+12 DST ENMES+18 LDA ERMX GET THE ERROR COUNT SZA,RSS IF NONE JMP EXIT2 SKIP * JSB ASC.F ELSE CONVERT IT STA ENMES+13 SET STB ENMES+12 IN THE MESSAGE EXIT2 LDA WAR GET THE WARNNING COUNT SZA,RSS IF NONE JMP EXIT3 SKIP * JSB ASC.F CONVERT IT STA ENMES+19 STB ENMES+18 EXIT3 JSB WRT.C SEND THE NEWS DEF C.TTY TO THE TTY DEF ENMES DEF K25 NOP IGNOR ERRORS EXIT JSB END.C END IT ALL DEF TOTER SEND THE ERROR MATRIC JMP EXIT TRY AGAIN IF CLOSE ERROR * TOTER NOP DISCT NOP ERROR MATRIX ERMX NOP WAR NOP DEC 2026 DATE CODE * TRML LDA K14 GET COUNT FOR MESSAGE RSS SKIP DOUBLE FAILURE TRMSL LDA K20 BOTH SOURCE AND LIST FAILED TO OPEN CLB CLEAR THE STB ERMX ERROR STB WAR AND WARNING COUNTS STB TOTER ʱNEOFER STA LS2.F SET FOR CALL JSB WRT.C SEND TO THE TTY DEF C.TTY DEF ERMES DEF LS2.F NOP IGNOR ERRORS (WHAT ELSE CAN WE DO HERE?) LDA LS2.F GET THE ERROR COUNT CPA K14 SET UP THE ERROR COUNTS CLB,INB,RSS ONE ERROR LDB K2 TWO ERRORS STB DISCT SET THE DISASTOR COUNT ADB TOTER SET THE COUNTS STB TOTER JMP TRM1 NOW GO DO THE EXIT * ERMES ASC 20,/FTN4: ACCESS FAILED ON LIST AND SOURCE ENMES ASC 25, $END FTN4: NO DISASTRS NO ERRORS NO WARNINGS "NOX" ASC 1, DON'T SEPERATE "NO" ASC 1,NO THESE TWO "00" ASC 1,00 * EOFBE CLA CLEAR BIN FLAG TO PREVENT RE-REPORTING STA F.CCW LDB BOM.F HAVE WE ALREADY REPORTED THIS ERROR?? LDA K97 SZB,RSS JMP ABT NO DO SO NOW. * JMP NXBIN YES GO CLOSE THE LIST FILE * EOFLI LDA K14 SET MESSAGE LENGTH JMP EOFER AND GO SEND IT SKP EMA LDA LDEF SET RETURN ADDRESS FOR ERROR ROUTINE STA F.EQE INCASE THERE IS AN ERROR JSB IDN.F STMT. STARTS WITH "$" SO LDA F.NT CHECK FOR SZA "EMA" JMP EMA4 NOT NAMED SO NOT EMA STMT. * JSB NTI.F PACK IT UP DLD F.IDI GET THE TWO WORDS CPA "EM" TEST FOR "EMA " RSS SO FAR SO GOOD JMP EMA4 NOPE NOT AN EMA STMT. * CPB "ABL" "A " WELL? CLA,RSS LOOKS GOOD SO FAR * JMP EMA4 NOPE NOT EMA * STA F.NXN ALLOW IT TO BE CONTINUED (HELPS FLUSH IT LATER) LDA F.TC SHOULD HAVE CPA LPRN "(" HERE RSS OK JMP BEMA3 NO BAD STMT. * JSB INM.F GET NAME OF EMA COMMON (ERR TSTNG DONE) LDB F.A SET RENAME BIT. ADB K2 (CAN DO AFTER AI.F 'CUZ IT'S LDA B,I THE ONLY SYMBOL SO FAR) IOR KK100 STA B,I  LDA BCOMI AND JSB DAT.F SET UP AS COMMON JSB TS.F MASTER - TYPE SUB. LDA L.DP SAVE ITS INA STA F.EMA ADDRESS FOR LATER (MUCH LATER) JSB DAF.F SET TO POINT AT SELF (0 LENGTH LINKED LIST) LDA F.TC MUST BE CPA RPRN ")" OR JMP CRTS YES OK * CPA B54 "," COMMA IF WINDOW SIZE TWO FOLLOW RSS JMP BEMA3 ERROR GO REPORT IT * JSB IDN.F NPUT DIGITS LDB F.NT IF NAME CPA INT OR NOT SZB,RSS INTEGER JMP BEMA4 BITCH * LDA F.EMA SET UP IN] LDB F.IDI EMA DST F.EMA FLAG LDA F.TC MUST NOW HAVE CPA RPRN ")" JMP CRTS THEN C/R * LDA K17 NO "(" FOUND BAD LINE JSB ER.F SEND ERROR * CRTS JSB ICH.F GET THE NEXT CHAR. CPA B15 IS IT A C/R JMP EMA3 GOOD GO WRAP IT UP * BEMA3 LDA K28 UN EXPECTED CHARACTER JSB ER.F * BEMA4 LDA K19 INT. CONSTANT REQUIRED JSB ER.F * LDEF DEF ER.FR DEF TO LOCAL ER.F RETURN * ER.FR CCA ER.F RETURNS HERE AFTER ERROR REPORT CLB CLEAR THE EMA DST F.EMA FLAGS EMA3 JSB SNC.F DISMISS THE EMA STATEMENT EMA4 JSB MCC.F FOR OTHER "$" STATEMENTS, BACK UP. CLA CLEAR STA F.EQE ER.F RETURN OPTION JMP NOEMA GO LOAD SEG 0 * K19 DEC 19 K28 DEC 28 K17 DEC 17 KK100 OCT 100000 RPRN OCT 51 INT OCT 10000 BCOMI OCT 7000 LPRN OCT 50 "ABL" ASC 1,A "EM" ASC 1,EM SKP * ********************** * * FIX EXTERNAL TABLE * * ********************** SPC 1 DFIX DEF *+1 ADDRSS OF TABLE SPC 1 OCT 1 NW=1 SPC 1 OCT 62204 IM=DBL, NC=00 , R=0, NW=4 OCT 0 ASC 2,DABS SPC 1 OCT 62204 IM=DBL, NC=00 , R=0, NW=4 OCT 0 ASC 2,DBLE SPC 1 .DCOS OCT 62204 IM=DBL, NC=00 , R=0, NW=4 OCT 0 ASC 2,DCOS SPC 1 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DMAX1 SPC 1 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DMIN1 SPC 1 OCT 62204 IM=DBL, NC=00 , R=0, NW=4 OCT 0 ASC 2,DMOD SPC 1 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DSIGN SPC 1 .DSIN OCT 62204 IM=DBL, NC=00 , R=0, NW=4 OCT 0 ASC 2,DSIN SPC 1 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DATAN SPC 1 .DAT2 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DATN2 SPC 1 OCT 62264 IM=DBL, NC=01($), R=1, NW=4 OCT 0 ASC 2,DEXP SPC 1 OCT 62264 IM=DBL, NC=01($), R=1, NW=4 OCT 0 ASC 2,DLOG * OCT 62265 IM=DBL, NC=01($), R=1, NW=5 OCT 0 ASC 3,DLOGT SPC 1 OCT 62265 IM=DBL, NC=01($), R=1, NW=5 OCT 0 ASC 3,DSQRT SPC 1 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DDINT SPC 1 OCT 52205 IM=CPX, NC=00 , R=0, NW=5 OCT 0 ASC 3,CMPLX SPC 1 OCT 52205 IM=CPX, NC=00 , R=0, NW=5 OCT 0 ASC 3,CONJG SPC 1 OCT 52205 IM=CPX, NC=00 , R=0, NW=5 OCT 0 ASC 3,CSQRT SPC 1 OCT 52324 IM=CPX, NC=10(#), R=1, NW=4 OCT 0 ASC 2,CCOS SPC 1 OCT 52324 IM=CPX, NC=10(#), R=1, NW=4 OCT 0 ASC 2,CEXP SPC 1 OCT 52324 IM=CPX, NC=10(#), R=1, NW=4 OCT 0 ASC 2,CLOG SPC 1 OCT 52324 IM=CPX, NC=10(#), R=1, NW=4 OCT 0 ASC 2,CSIN SPC 1 OCT 22364 IM=REA, NC=11(%), R=1, NW=4 OCT 0 ASC 2,SIN SPC 1 OCT 22364 IM=REA, NC=11(%), R=1, NW=4 OCT 0 ASC 2,COS SPC 1 OCT 22364 IM=REA, NC=11(%), R=1, NW=4 OCT 0 ASC 2,EXP SPC 1 OCT 22364 IM=REA, NC=11(%), R=1, NW=4 OCT 0 ASC 2,TAN SPC 1 OCT 22364 IM=REA, NC=11(%), R=1, NW=4 OCT 0 ASC 2,SQRT SPC 1 OCT 22364 IM=REA, NC=11(%), R=1, NW=4 OCT 0 ASC 2,ALOG SPC 1 OCT 22344 IM=REA, NC=11(%), R=0, NW=4 OCT 0 ASC 2,TANH SPC 1 OCT 022365 IM=REA, NC=11(%), R=1, NW=5 OCT 0 ASC 3,ALOGT SPC 1 OCT 22344 IM=REA, NC=11(%), R=0, NW=4 OCT 0 ASC 2,ATAN SPC 1 OCT 22344 IM=REA, NC=11(%), R=0, NW=4 OCT 0 ASC 2,ABS SPC 1 OCT 22344 IM=REA, NC=11(%), R=0, NW=4 OCT 0 ASC 2,AINT SPC 1 OCT 22345 IM=REA, NC=11(%), R=0, NW=5 OCT 0 ASC 3,FLOAT SPC 1 OCT 22344 IM=REA, NC=11(%), R=0, NW=4 OCT 0 ASC 2,SIGN SPC 1 OCT 22204 IM=REA, NC=00 , R=0, NW=4 OCT 0 ASC 2,SNGL SPC 1 OCT 22204 IM=REA, NC=00 , R=0, NW=4 OCT 0 ASC 2,REAL SPC 1 OCT 22204 IM#REA, NC#00 , R#0, NW#4 OCT 0 ASC 1,ER ER.R0 ASC 1,R0 SPC 1 OCT 22204 IM=REA, NC=00 , R=0, NW=4 OCT 0 ASC 2,EXEC SPC 1 OCT 22205 IM=REA, NC=00 , R=0, NW=5 OCT 0 ASC 3,CLRIO SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,IOR SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,IAND SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,NOT SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,IS@SW SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,IABS SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,INT SPC 1 OCT 12344 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 2,IFIX SPC 1 OCT 12345 IM=INT, NC=11(%), R=0, NW=4 OCT 0 ASC 3,ISIGN SPC 1 OCT 62265 IM=DBL, NC=01($), R=1, NW=5 NOP ASC 3,DLOG10 STANDARD NAME FOR DLOGT SPC 1 OCT 022365 IM=REA, NC=11(%), R=1, NW=4 NOP ASC 3,ALOG10 STANDARED NAME FOR ALOGT SPC 1 .DAT3 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 NOP ASC 3,DATAN2 STANDARD NAME OF DATN2 SPC 1 OCT 62264 IM=DBL, NC=01($), R=1, NW=4 OCT 0 ASC 2,DTAN SPC 1 OCT 62205 IM=DBL, NC=00 , R=0, NW=5 OCT 0 ASC 3,DTANH SPC 1 OCT 12205 IM=INT, NC=00 , R=0, NW=5 NOP ASC 3,IDINT SPC 2 * ************************* * * DATA POOL STARTS HERE * * ************************* SPC 1 *.DP. EQU * SPC 1 OCT 1 NW=1 LFIX ABS *-DFIX-1 LENGTH OF INITIAL SYMBOL TABLE SPC 2 END BEGIN s ( 92060-18099 1913 S C0122 &$CLBR HDR FOR RTE-II-III-IV LIB             H0101 bASMB,R,L,C HED COMPILER LIBRARY HEADER ROUTINE(RTE-II-III) NAM $CLIB,7 92060-12005 REV.1913 790105 $CLIB * END 5  92060-18100 1901 S C0122 &C.BIA BIN-A FCB COMPILER LIB             H0101 ASMB,R,L,C HED COMPILER LIBRARY FILE CONTROL BLOCK NAM C.BIA,7 92060-16102 780920 REV.1901 $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. * *************************************************************** SPC 2 * * SOURCE PART # 92060 - 18100 * * WRITE BINARY ABSOLUTE 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 * +-----------------------------------------------+ * 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.BIA * EXT C.BBI BINARY BUFFER ADDRESS EXT C.DUM $INCLUDE ROUTINE * AND WRITE AFTER READ PROCEDURE * * 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.BIA NOP LINK OCT 14005 DEFAULT PARAMETER #3, BINARY ABSOLUTE WRITE 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 v 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 z  92060-18101 1913 S C0322 &5FTN4 FTN4 SEGMENT 5             H0103 GzASMB,Q,C HED ** 16K FTN4 COMPILER (F4.5:PASS2) ** NAM F4.5,5 92060-16101 790103 REV. 1913 *************************************** * FORTRAN-4 COMPILER OVERLAY 5 *************************************** * * THIS OVERLAY TRANSLATES THE PSEUDOCODE GENERATED BY * PASS 1 INTO RELOCATABLE BINARY, AND GENERATES THE ASSEMBLY * LISTING. * * * * *************************************************************** * (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.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ABT ABORT COMPILE EXTRY EXT F.CCW FTN OPTION WORD EXT F.CSZ COMMON SIZE EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DP BASE OF USER SYMBOL TABLE EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.REL SUB. PROG. RETURN LOCATION I} EXT F.RPL PROGRAM LOCATION COUNTER EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT FA.F FETCH ASSIGNS EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT PSL.F PRINT LINE ON PRINTER EXT SKL.F SKIP LINES ON LIST EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * LIBRARY UTILITIES * EXT .MVW MOVE WORDS MACRO EXT IFBRK BREAK CHECK ROUTINE * * * OPSYSTEM INTERFACE: * EXT RED.C READ FILE ROUTINE EXT WRT.C WRITE FILE ROUTINE EXT RWN.C REWIND FILE ROUTINE EXT C.SC1 SCRATCH FILE FCB EXT C.BIN BINARY FILE FCB * COMPILER LIB ROUTINES * * * SUP SPC 1 A EQU 0 B EQU 1 SPC 1 K5 DEC 5 OVERLAY # SKP F4.5 LDA F.CCW CHECK IF 4 WORD DOUBLE? AND B1000 WELL SZA,RSS COME ON ... COME ON! JMP CRSEC NO SKIP THE WHOLE THING * LDB KM44 CHECK 44 SYMBOLES STB T2STF SET COUNTER LDB D.DTO ADDRESS OF .DTOI ENDPZ LDA B,I GET THE FIRST TWO CHAR OF SYMBOL CPA ".D" IF '.D' THEN RSS SKIP CPA ".X" IF '.D' OR '.X' LDA ".T" CHANGE TO '.T' STA B,I SET SYMBOL BACK ADB K3 INDEX TO THE NEXT SYMBOL ISZ T2STF IS THERE ONE? JMP ENDPZ YES GO DO IT * LDA ".D" RESTORE THOSE CHANGED BY THE SHOTGUN STA .DIO. STA .DTA. LDA "T" FIX THOSE THAT END IN D BUT SHOULD NOW BE T STA RTODX STA DTODX LDA "TB" NOW GET THE TWO WITH D'S IN THE MMIDDLE STA IDBLX STA CDBLX INA CHANGE TO 'TC' STA .DCMX AND GET ..DCM -> ..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 NAME 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 CLEAR BIT 15 IN NAME. ADB K2 LDA B,I RAL,CLE,ERA STA B,I 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 * ********************* * * OOUTPUT 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 ORD: 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 LDSY1 YES. PAD WITH BLANKS. LDA CWA,I AND KK757 FOR LABELLED COMMON, CLEAR BIT 15. STA CWA,I ISZ CWA LDSY1 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 * 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 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 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 * z 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 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. AND KK757 UNHIDE THE SYMBOL. 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 T640WO 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 ~t6 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 WORD 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 KK757 OCT 77577 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 ADJU_KST 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 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 ASC.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 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 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 * 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 7 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 AD\D 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 LOCATION 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 MAND 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 ENTRY 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 REBF 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 LDA CODE JSB ACOD1 PUT OPCODE INTO THE LIST BUFFER SKP * ** SUPPLY OPERAND SYMBOL ** SPC 1 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 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 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 LDB MR MR.F ROUTINE ADDS COMMON SYMBOL LD&640A "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 WORD 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 ^6R2 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 SIZE 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 DBR LBUF+17 y 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 0 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 * ALF,ALF POSITION TO GET LEAST RAL,RAL 3 DIGITS (LEFT 1+(6-#DIG)*3) STA STMV SAVE THE NUMBER. ADB KM2 GET THE ADDRESS OF THE LDA B,I IM AND GET IT ALF POSITION THE IM FIELD. 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 ROTATE 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 B 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 ENDS 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 * * *********************** * * 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 * * ******************************** * * 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. *y 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 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 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 a5640 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 6,.IAE. .ERES * NO.F EQU 56 NUMBER OF ENTRIES IN ABOVE TABLE SPC 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 E#6 !7 92060-18102 2001 S C0122 &WRT.C RTE-II,III,IV&L             H0101 yASMB,L,C NAM WRT.C,7 92060-16102 790822 REV. 2001 $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 LDA C.FID,I UNITRECORD FLAG IS THE SIGN BIT OF THE ID SSA,RSS ( A = LENGTH ) JMP L1 AND =B7 FCB TYPE CPA =D1 = 1, SZB AND LENGTH = 0, RS S (NO) JMP EXIT THEN IGNORE. * EXEC(2,LU,.UBUF,LENGTH) JSB EXEC DEF *+4+1 DEF .2 DEF C.FLU,I DEF .UBUF,I 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 E  92061-18001 2013 S C0422 &MICRO RTE MICRO ASSEMBLER             H0104 1ASMB,R,L,C HED RTE MICRO-ASSEMBLER -- PASS 1 NAM MICRO,3 92061-16001 REV.2013 800131 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 10,REV.2013 800131 TIME BSS 16 * EXT EXEC EXT C.SOR,C.TTY,C.LST,C.BIN CMPLR LIB FCB EXT SUP.C,OPN.C,PRM.C,GMM.C,WRT.C,RWN.C CMPLR LIB EXT RUN.C,END.C,SPC.C,EOF.C,RED.C CMPLR LIB * * ****************************** * * PASS 1 STARTS HERE. * * HERE WE GET THE PARAMETERS, IF ANY, FROM THE * USER'S RUN COMMAND: * :RU,MICRO,,,, * MICRO NOP JSB SUP.C DEF TIME JMP ABRT ERROR RTN JSB PRM.C DEF .3 SZA JSB PUNCH LDA PRMPT SET A = "]_" JSB OPN.C DEF C.SOR JMP ABRT ERROR RTN JSB OPN.C DEF C.LST JMP ABORT ERROR RTN JSB PRM.C DEF .4 SZA,RSS LDA .56 DEFAULT STA LPP LINES PER PAGE FOR MXREF CMA -((LPP-3)+1): REMAINING STA LINE3 LINES+1 AFTER HEADER JSB EJECT PRINT HEADER JSB EXEC SWAP WHOLE DISC PARTITION DEF *+3 (NO SUCH FUNCT IN CMPLR LIB)UNLESS AUTO DEF .22 DEF .3 JSB GMM.C GET FWA,LWA DEF .0 STA @SYMB Ә STA @SYMT ADA .4 STA @VAL INA STA @TAG CMB STB LWA -LWA-1 * * INPUT AND EXAMINE A RECORD. * 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 .10 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 INTO 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 JS_B SYMAD JMP INPUT * * CONTROL CARD PROCESSOR * B= BPTR TO COMMAND * CNTRL JSB PSRCH DBL CTBL DEC 10 CPA .7 $CODE COMMAND? JMP FDESG YES SZA JMP INPUT NO: IGNORE COMMAND IN PASS1 * * BAD CONTROL STATEMENT OR PSEUDO-OP * LDA ERR18 BAD COMMAND JMP *+2 BAD.2 LDA ERR19 BAD LABEL EXPRESSION BAD.3 JSB ERROR JMP INPUT * * $CODE PARAMETERS ARE NOW INCLUDED IN RUN STRING FDESG LDA ERR12 $CODE -> RUN STRING LDB ANYER STB TEMP JSB ERROR LDB TEMP STB ANYER RESTORE FLAG JMP INPUT TEMP BSS 1 * * ****************************** * * END STATEMENT * END1 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 .2 JSB SPACE LDA .M12 JSB PRINT DEF HED1 LDA .2 JSB SPACE PR1 LDA .9 FILL THE PERTINENT PART OF LDB @CARD ASCII OUTPUT BUFFER WITH JSB CLEAN SPACES. * 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 .15 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 .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. * * OPEN BINARY FILE * JSB OPN.C DEF C.BIN RSS ERROR RTN JMP OK NORMAL RTN CLA STA FILE? RESET OUTPUT FLAGS STA FILE LDA ERR13 JSB ERROR * * INITIALIZE FLAGS, COUNTERS, ETC, FOR 2ND PASS. * GENERATE LEADER. * OK LDA BASE RESET ORIGINAL ORG STA PCNTR JSB RWN.C DEF C.SOR JMP ABORT ERROR RTN ISZ PASS# CLA STA LINE# * * READ A SOURCE RECORD. * 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-ORIGINED 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 .M37 STA COUNT MAX CHAR COUNT LDA @HFD2 STA @DEST P.GET JSB LOADB MOVE TITLE INTO HEADER STB @INP LDB @DEST JSB STORB STB @DEST LDB @INP ISZ COUNT JMP P.GET * * $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 FILE? JMP P21A * * $LIST: TURN ON LISTING * $LST JSB $LIST ENABLE LISTING JMP P21A * * $PUNCH: TURN ON PUNCHING AND SET LEADER FLAG * $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 .2 GET SPECIAL FIELD LDB .3 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 * * ****************************** * * * 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 9 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 .2 GO GET A 'SPECIAL' CODE LDB .3 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 .4 GO GET AN 'ALU' CODE LDB .4 FROM FIELD 4. JSB CODE LDA .6 GO GET A 'STORE' CODE LDB .5 FROM FIELD 5. JSB CODE LDA .7 GO GET AN 'S-BUS' CODE LDB .6 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 .2 GET A 'SPECIAL' CODE LDB .3 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 .5 GO GET AN MODIFIER CODE LDB .4 FROM FIELD 4. JSB CODE LDA .6 GO GET A 'STORE' CODE LDB .5 FROM FIELD 5. JSB CODE LDB @FLD6 GET FLD 6 STARTING BYTE ADDRESS. j 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 .2 GET SPECIAL FIELD LDB .3 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 .3 GO GET A 'CONDITION' CODE LDB .4 FROM FIELD 4. JSB CODE LDA .9 GET SENSE CODE (STORE FIELD) LDB .5 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 LDA 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 H 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 .8 LDB .3 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 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 .6 WRITE CONSOLE END MSG LDA ANYER SZA LDB .12 STB BLEN JSB WRT.C DEF C.TTY DEF ENDMS DEF BLEN JMP ABORT ERROR RTN 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 JSB WRT.C PRINT ABORT MSG DEF C.TTY DEF AEND DEF .8 NOP ERROR RTN STOP JSB SPC.C EJECT PAGE DEF C.LST DEF .M2 NOP ERROR RTN LDA .M10 STA TEMP STOPX JSB END.C DEF ANYER ISZ TEMP TRY AGAIN FOR A WHILE JMP STOPX JMP 12 MP ABORT IF WE CAN'T QUIT NICE SPC 2 ABRT JSB WRT.C DEF C.TTY DEF AEND DEF .8 NOP JMP STOPX 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=BPTR 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 BLNK2 BRING IN BLANKS CLE0 STA B,I INB ISZ COUNT JMP CLE0 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. * 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 .8 PUT OCTAL BASE IN B. SZA WAMT DECIMAL? LDB .10 YES, PUT DECIMAL BASE INB. STB TMPC2 SAVE BASE. CLA CLEAR TEMPORARY STA TMPC3 STA CFLG CN1 LDB TMPC1 LOAD JSB LOADB BYTE. ADA .M48 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 RESULT 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 SIGNIFICANT. * 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 .6 JMP C01 CPB .7 JMP *+2 JMP C07 * VERIFY THAT IT'S OK IN S-BUS FIELD LDB A BLF,SLB JMP C07 OK JMP C06 * VERIFY THAT IT5b'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 .M1 BACK-UP OVER FIRST CHAR JSB OCT? TRAILING "B"? JMP C.DEC NO 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 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 .M4 NUMBER OF DIGITS STA DGITS DEC0 STBNLHB @DEST CLB LDA BINRY DIV .10 STA BINRY BINRY/10 LDA B BINRY MOD 10 ADA =B60 LDB @DEST JSB STORB ADB .M2 BPTR TO NEXT MOST-SIG DIGIT ISZ DGITS JMP DEC0 JMP DECML,I * * ****************************** * * D E F L T * * ENTRY: * JSB DEFLT * DEC * * 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 FILE RESET FILE STATE LDB FMGR IGNORE IF FILE ERROR SZB,RSS STA FILE? JSB EMBUF DUMP RECORD & WRITE END RECORD 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. EN* EJECT NOP LDA #LNS CPA LINE3 HAVE WE PUT TITLE OUT ALREADY? JMP EJECT,I YES: IGNORE REQUEST JSB SPC.C DEF C.LST DEF .M2 JMP ABORT ERROR RTN 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 .27 ...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 AS 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 .M1 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 .M33 IE.: FILL#-33+PNLEN >= 0? SSA JMP ECPAD NO: SIMPLY PAD BUFFER JSB EMBUF YES: DUMP (OR INITIALIZE) BUFFER LDA FILE? EMIT END-OF-FILE... LDB FRST? ...IF NOT FIRST BUFFER? SZA SZB,RSS JMP EC1 NO JSB EOF.C DEF C.BIN RSS ERROR RTN JMP EC1 NORMAL RETURN LDA ERR29 FILE ERROR! JSB ERROR CLA STA FILE? EC1 CLA STA FRST? JMP ECPAK * ECPAD LDA FILL2 PAD BUFFER WITH -1'S LDB FILL1 JSB STUF-F ISZ FILL# JMP ECPAD ECCHK LDB PNLEN FULL BUFFER? CPB .32 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 .M32 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 .52 STA RLEN JMP EMFIO * RFINI EQU * COMPLETE RELOCATABLE RECORD LDA PNLEN ALS LENGTH*2 ADA .5 STA RLEN PUNCH LENGTH ALF,ALF SHIFT INTO HIGH BYTE FOR STA PNLEN LENGTH WORD IN BUFFER * EMFIO LDA FILE? SZA,RSS JMP EMEND JSB WRT.C DEF C.BIN DEF PBASE,I DEF RLEN RSS ERROR RETURN JMP EMEND EMF. LDA ERR29 JSB ERROR CLA STA FILE? * EMEND LDA END? SZA,RSS JMP EMCLR LDB FMT LDA FILE SZB,RSS SIMULATOR FORMAT OR... SZA,RSS ...NO FILE I/O? JMP EMCLR YES: SKIP END RECORD JSB WRT.C DEF C.BIN DEF ENDRcLC DEF .4 RSS EROR RETURN JMP EMCLR LDA ERR29 JSB ERROR 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 .5 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 .M1 BACK-UP OVER TERMINATOR JMP EOS?,I TO ALLOW REDUNDANT TESTS * * ****************************** * * 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 FORMNAT 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 ELEN ADA MLEN JSB PRINT DEF EMSG LDA LAST# FIRST ERROR OF PASS? SZA JMP ER2 NO LDA .M6 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 .19 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 CAN BE RESET (EX. BEFORE ER2) @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,14 ASC 12,NO $CODE: USE RUN STRING ERR13 DEF *+1 BYT 15,14 ASC 12,CANNOT OPEN BINARY FILE 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 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,13 ASC 11,DUPLICATE MICRO OPTION ERR29 DEF *+1 BYT 35,17 ASC 15,I/O ERROR-BINARY OUTPUT SUSPENDED ERR30 DEF *+1 BYT 36,13 ASC 11,INVALID MICRO OPTIONS ERR31 DEF *+1 BYT 37,14 ASC 12,INVALID LABEL IN FIELD 1 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 LDA .2 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 .M37 JSB PRINT DEF FIN2 JMP FINI2 NOERR LDA PASS# ADA =B60 LDB @F1FD JSB STORB LDA .M24 JSB PRINT DEF FIN1 FINI2 CLA STA #ERRS STA LAST# LDB @EFD0 STB @EFD4 ELB ADB .M3 RESET ": " IN ERROR MSG LDA COLON JSB STORB LDA BLNK JSB STORB LDA BLNK JSB STORB LDA .14 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 * * **********************e******** * * 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 .M1 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 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 INCREMENTED UPON EXIT. * * 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 CURROhENT 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 .3 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 .M1 JSB OCTAL DEC 3 L2.1 LDA LINE# CONVERT LINE NUMBER LDB @LFD1 JSB DECML LDA CRLEN ADA .12 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 "MICMXE" COMMAND. RESETS * CERTAIN POINTERS AND VALUES FOR "MICMX". * MIC NOP ISZ LINE# JSB RDCRD LDA PAλSS# CPA .1 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 JSB ERROR JSB LSTR? JMP ABORT * M.MX ISZ MX? LDA @MXD SET UP MX FIELD DEFAULTS 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 .M1 BACK-UP OVER SEPARATOR STB MPTR JSB PRM.C DEF .5 SZA,RSS OVERRIDE WITH RUN STRING? LDB MPTR MPRM JSB LOADB CPA BLNK BLANK FLAGS THE END OF LIST JMP M.LST CPA COMMA COMMAS ARE IGNORED JMP MPRM 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.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 .4 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 INyTO COMMAND JMP MPRM * * LIST COMMAND * M.LST EQU * 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 ASC 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.SYM ADB .M1 BACK-UP OVER CHAR JSB SERCH VALID SYMBOL? SSA JMP N.ERR NO ADA .4 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 .M1 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 SAVBmNLH 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 .M2 BPTR TO NEXT MOST-SIG DIGIT ISZ DGITS JMP OCT0 JMP OCTAL,I * * ****************************** * * O R G D ? * * VERIFIES THAT FIRST "ORG" PSEUDO-OP HAS BEEN INPUT * ăNORGD? 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 FILE? PUNCHING OR GOING TO FILE? SZA JSB EMCDE YES: STUFF INTO BUFFER LDA PCNTR INA JSB SETP INCREMENT PCNTR JMP OUTPT,I * * ****************************** * * P O V F ? * * ENTRY: * JSB POVF? * * EXIT: * E=0 IF NO OVERFLOW (POVFL=0) * H1 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 PLUS NUMBER OF WORDS OR MINUS NUMBER OF BYTES. * PRINT NOP SSA,RSS JMP PR. CMA,INA SLA CONVERT TO PLUS WORDS INA ARS PR. STA PSIZE ISZ #LNS TOP OF FORM NEEDED? JMP PR.0 JSB EJECT YES: PRINT HEADING ISZ #LNS (CANNOT BE ZERO) PR.0 LDA PRINT,I STA P.BUF ISZ PRINT JSB WRT.C DEF C.LST P.BUF DEF * DEF PSIZE JMP ABORT ERROR RTN JMP 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 * * ****************************** * * * P U N C H * * 'PUNCH' SETS UP BINARY OUTPUT FLAGS * * CALLING SEQUENCE: * JSB PUNCH * * PUNCH NOP CLA,INA STA FILE STA FILE? JMP PUNCH,I * * ****************************** * * R D C R D * * 'RDCRD' CONTROLS SOURCE INPUT. * * CALLING SEQUENCE: * JSB RDCRD * * RDCRD NOP LDA .48 CLEAR BUFFER LDB @OUTB JSB CLEAN RD1 JSB RED.C DEF C.SOR DEF CARD DEF .36 JMP ABORT ERROR RTN SSB JMP RD3 EOF RETURN SZB,RSS EOT? JMP RD1 YES TRY AGAIN. RD2 STB CRLEN JMP RDCRD,I RD3 LDA ERR21 JSB ERROR LDA =A E FAKE END STA CARD+4 LDA =AND STA CARD+5 ISZ NOEND LDB .M4 JMP RD2 * * ****************************** * * 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 .M8 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 .6 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 .5 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 .4 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 .3 NO. POINT B REG. TO START OF JMP SR0 NEXT ENTRY. TRY AGAIN. SR1 LDA B YES, SUCCESS. ADA .M3 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 .M1 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 .M1 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 SPC.C THIS SPACES WITHOUT AUTO-EJECT. DEF C.LST THUS, WE CANNOT SPACE TO LAST DEF SLNS LINE SINCE WE ASSUME AUTO-EJECT JMP ABORT AFTER LAST LINE (ERROR RTN) 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. REFGpERENCING 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 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 .4 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 .3 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 MODI:FY RESULT FOR MX CPB .7 S-BUS FIELD? JMP $SCH4 CPB .8 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 * * ****************************** * * 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 MICROYWORD 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 NUMERIC 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 .M1 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 D&UPLICATE 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* * *************** * * 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 .M8 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 .4 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 .2 SYM TABLE OVERFLOW JMP SYMAD,I ALREADY REPORTED e 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 WRT.C DEF C.LST DEF HEADR DEF HSIZE JMP ABORT ERROR RTN * JSB SPC.C DEF C.LST DEF .2 JMP ABORT ERROR RTN * LDA LINE3 STA #LNS JMP TITLE,I @HFD1 DBL HEADR+4 @HFD2 DBL HEADR+5 HSIZE DEC 40 * * ****************************** * * 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 .4 BLANK TOKEN LDB @TOKN JSB CLEAN * 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 * * SCHEDULES MXREF. * WE PASS LAST PAGE# AND LINES PER PAGE TO MXREF. * THE SOURCE AND LIST ARE PASSED BY RUN.C * XREFޫ NOP JSB RWN.C REWIND THE DEF C.SOR SOURCE FILE JMP ABORT ERROR RETURN JSB RUN.C SCHEDULE MXREF DEF C.SOR DEF C.LST DEF MXREF DEF PARMS 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 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 TRNNT 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 2@ 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 .M60 DEC -60 .M48 DEC -48 .M37 DEC -37 .M33 DEC -33 .M32 DEC -32 .M24 DEC -24 .M18 DEC -18 .M12 DEC -12 .M10 DEC -10 .M8 DEC -8 .M6 DEC -6 .M4 DEC -4 .M3 DEC -3 .M2 DEC -2 .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 .8 DEC 8 .9 DEC 9 .10 DEC 10 .12 DEC 12 .14 DEC 14 .15 DEC 15 .18 DEC 18 .19 DEC 19 .22 DEC 22 .27 DEC 27 .32 DEC 32 .36 DEC 36 .48 DEC 48 .52 DEC 52 .56 DEC 56 .62 DEC 62 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 ERRORt B EQU 1 BASE DEC -1 BINRY BSS 1 FOR DECML & OCTAL CONVERSION BLEN BSS 1 TEMP BUFFER LENGTH 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 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 @DEST BSS 1 DFORG OCT 27000 MXE USER MODULE 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 @FLD1 DBL CARD ORIGINED @FLD2 DBR CARD+4 TABLE @FLD3 DBL CARD+7 OF @FLD4 DBR CARD+9 SOURCE @FLD5 DBL CARD+12 FIELD @FLD6 DBR CARD+14 BPTRS 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 FNAME ASC 3, FRST? OCT 1 CLEARED AFTER DUMPING 1ST BUFFER 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 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 PARMS BSS 1 :RU PARAMETERS PAGE# BSS 1 :RU PARAMETERS LPP BSS 1 :RU PARAMETERS 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-FMT) 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 PNTR BSS 1 POS? BSS 1 POVFL OCT 0 PCNTR OVERFLOW FLAG PRMPT ASC 1,]_ PROMPT CHARACTER FOR INTERACTIVE INPUT @PTR BSS 1 S.000 BSS 1 S.001 BSS 1 SAVA BSS 1 TEMPORARY STORAGE SAVB BSS 1 TEMP STORAGE 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 %k 4O 92061-18002 2013 S C0222 &MXREF RTE MICRO XREF             H0102 oASMB,R,L,C HED RTE MICRO CROSS-REFERENCE GENERATOR NAM MXREF,3 92061-16002 REV.2013 800131 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 11,PAGE .... MICRO XREF ASC 10,REV.2013 801031 TIME BSS 16 * EXT EXEC RTE \ RLIB EXT SUP.C,GMM.C,OPN.C,SPC.C CMPLR LIB EXT END.C,WRT.C,RED.C,PRM.C CMPLR LIB EXT C.SAU,C.LST,C.SON,C.TTY CMPLR LIB * * ******************** * * 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 GMM.C GET FWA,LWA DEF .0 (NO OF SEGMENTS) STA SBASE BASE OF SYM TAB (GROWS UP) STA SNEXT ADB .M1 BASE OF REF TAB (GROWS DOWN) STB RNEXT CMB,INB SUFFICIENT MEMORY? ADB SNEXT RNEXT-6>SNEXT? ADB .6 SSB,RSS ISZ SYMOV NO: ANTICIPATE OVERFLOW * * INITIATE I/O ON INPUT DEVICE * JSB OPN.C DEF C.SAU JMP IER ERROR RTN JMP INIT IER LDA .M20 ABORT - NO SOURCE JSB PRINT DEF NOLS JMP ABORT * * * INIT EQU * JSB INPUT GET MIC CMD. LIMITED CHECKING LDA MIC1 "MICMX "? LDtB 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 * ISZ ANYER BUMP ERROR COUNT LDA #REC MOVE LINE# INTO ERROR MSG LDB @OV1 JSB DECML DEC 4 LDA .M45 JSB PRINT DEF OVMSG LDA .2 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 * u LDB SBASE * SPART EQU * NEXT PARTITION CPB SNEXT JMP LIST DONE STB TOP STB LEAST * SFIND EQU * FIND LEAST IN PARTITION ADB .6 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 .6 TOP+6: NEXT PARTITION JMP SPART * * ******************** * * LIST PHASE * LIST EQU * JSB SUMRY LDA .1 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 .4 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 .M14 STA XRLEN JMP LREF LUND LDA @UND UNDEFINED SYMBOL LDB @XR2 JSB MVB DEC 15 LDA @XR6 STA @XR LDA .M26 STA XRLEN LREF EQU * LIST REFERENCES LDB SYM ANY REFERENCES? ADB .5 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 .M20 STA XRLEN JMP LLAST K 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 .10 NEXT REFERENCE POSTION STB @XR IN OUTPUT LDB XRLEN ADB .M6 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 .6 JMP LNXTS * * ******************** * * END OF CROSS-REFERENCE * LDONE EQU * LDA .M12 JSB DSPLY DEF ENDMS JMP STOP * ABORT EQU * ISZ ANYER BUMP ERROR COUNT LDA .M14 JSB DSPLY DEF ABMSG * STOP JSB SPC.C DEF C.LST DEF .M2 NOP ERROR RTN UNIMPORTANT IN ABORT * JSB END.C DEF ANYER RETURN ERROR COUNT JMP 12 ERROR RTN HERE ? - ABORT (MP) 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 .2 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 ASC 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 CBjLFT 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 CBLFT BSS 1 BPTR TO LEFT STRING CBRT BSS 1 BPTR TO RIGHT STRING * * ******************** * * 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 .10 STA DVAL ENTIER(VALUE/10) LDA B VALUE MOD 10 ADA "0" CONVERT DIGIT TO ASCII LDB DDEST STORE INTO STRING JSB STORB ADB .M2 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 SSA,RSS JMP DS CMA,INA SLA,ARaS INA DS STA DLEN LDA DSPLY,I STA DBUF ISZ DSPLY JSB WRT.C DEF C.TTY DBUF DEF 0 DEF DLEN JMP ABORT ERROR RTN 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 .35 LDB OUTBF JSB PAD LDB .M10 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 SPC.C DEF C.LST DEF .M2 JMP ABORT ERROR RTN 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 * * ******************** * * I N P U T * * ENTRY: * JSB INPUT * * READ SOURCE LINE FROM INPUT DEVICE. * INPUT NOP LDA .36 LDB CARD JSB PAD RETRY JSB RED.C READ SOURCE FROM DISC OR DEVICE DEF C.SAU DEF CARD+1 DEF .36 JMP ABORT EROR RTN SSB EOF ? JMP INEOF YES: ADD "END" CARD SZB,RSS BLANK RECORD (EOT)? JMP RETRY YES: IGNORE JMP INPUT,I * INEOF EQ5U * FAKE "END" LDA =A E STA CARD+5 LDA =AND STA CARD+6 JMP INPUT,I * * * ******************** * * 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 .4 JSB PAD LDA MLDST GET BPTR TO TARGET RAL STA MLDST LDA .M8 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 .M10 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 .8 # CHARACTERS MOVED JMP MVLBL,I MLCNT BSS 1 MLDST BSS 1 * * ******************** * * 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 R I N T * * ENTRY: * LDA * JSB PRINT * DEF * PRINT NOP SSA,RSS JMP PR1 CMA,INA SLA,ARS INA PR1 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 WRT.C DEF C.LST PBUF DEF 0 DEF PLEN JMP ABORT ERROR RTN JMP PRINT,I PLEN BSS 1 * * ******************** * * R A D D * * ENTRY: * LDB * JSB RADD * * EXIT: * O= 1 IF SYM TAB OVERFLOW * * ALLOUrCATE 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 .M2 STB RNEXT NEXT AVAIL ENTRY CMB,INB RNEXT-6<=SNEXT? ADB SNEXT ADB .4 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 P&UT 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 * * ****************************** * * 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". * * 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 .6 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 .6 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 .M1 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 SPC.C DEF C.LST DEF SLEN JMP ABORT ERROR RTN JMP SPACE,I * SP1 EQU * JSB EJECT JMP SPACE,I SLEN BSS 1 * * ******************** * * S T O R B * * ENTRY: * LDA * LDB * JSB STORB * * EXIT: ,, * * EFFECTIVE RUN COMMAND WHEN SCHEDULED FROM MICRO: * :RU,MXREF,<>,, * * GET :RU PARAMETERS AND INITIALIZE SUBSYSTEM I/O. * SYSIO NOP JSB SUP.C DEF TIME JMP ABORT ERROR RTN JSB OPN.C DEF C.LST JMP IER ERROR RTN - ABORT - NO LIST LDA C.SON SEE IF SCHEDULED BY MICRO SZA,RSS JMP SY SKIP IF NOT JSB PRM.C GET THE LAST PAGE NUMBER AND DEF .2 STA PAGE# STORE IN MY COUNTER * SY JSB PRM.C GET LINES PER PAGE DEF .3 SZA,RSS LDA .56 DEFAULT CMA -((LPP-3)+1): REMAINING LINES+1 STA LINE3 AFTER HEADER 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# YH PUT PAGE# INTO HEADER LDB @HDF1 JSB DECML DEC 4 (NO OF DIGITS REQ) JSB WRT.C WRITE TITLE... DEF C.LST DEF HEADR DEF HLEN JMP ABORT ERROR RTN JSB SPC.C ...FOLLOWED BY 2 BLANK LINES DEF C.LST DEF .2 JMP ABORT ERROR RTN LDA LINE3 RESET LINE COUNTER STA #LNS JMP TITLE,I @HDF1 DBL HEADR+4 PAGE# IN HEADER HLEN DEC 36 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 .4 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 .4 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 .M48 DEC -48 .M45 DEC -45 .M26 DEC -2W6 .M20 DEC -20 .M14 DEC -14 .M12 DEC -12 .M10 DEC -10 .M8 DEC -8 .M6 DEC -6 .M2 DEC -2 .M1 DEC -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 .22 DEC 22 .35 DEC 35 .36 DEC 36 .56 DEC 56 ASTER OCT 52 BLNK OCT 40 BLNK2 BYT 40,40 BYT 40,40 BYT 40,40 MINUS OCT 55 PLUS OCT 53 * * * A EQU 0 A-REGISTER ABMSG ASC 8, /MXREF: ABORTED ANYER DEC 0 ERROR COUNT 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 @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 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 MIC1 DEF *+1 MIC COMMANDS ASC 3,MICMX MIC2 DEF *+1 ASC 3,MICMX, MIC3 DEF *+1 ASC 3,MICMXE MLINP BSS 1 BPTR TO CHAR AFTER LABEL (MVLBL) MX? OCT 0 SET IF "MICMX" NOLS ASC 12,**SOURCE OR LIST MISSING 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 .... #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 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 [ 4 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 TO 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 NOX.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-OVE `RFLOW 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 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 Aa1B@ * 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 * X 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 * 5RE-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 MACRO 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 PARAMETER? 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 PROGRAMs 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" FO/R 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 SUBROUTINES 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 ENTRYZ{ 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 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? YdHFBBH 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 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 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 SBUF3 2 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 CON,DITION 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 .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 uTO 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 * l8 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 ACCԥOUNTED * 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 SZEA,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 w"CN" IS IT CNDX? JMP MIC3 YES.WORD TYPE III JMP MIC4 NO.WORD TYPE IV SKP 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 MOREB@< SZA,RSS PARAMETERS? JMP MDE10 YES.ILLEGAL MIC03 EQU * LDA SAVE6 WRITE NEW 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 zB 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 B3i7 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) 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 T YPE 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 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 * 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 8 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 > * < =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 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 V'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 BUFFER 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 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 9I 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 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 CHAHFBRACTER 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 H 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 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 SCsA06 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 RETURN 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 UOCTAL 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 # TO 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 H 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 * * 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 XPUTHFB,I HED XLIB ROUTINES-XCVAS * X C V A S * * INTEGER TO ASCII CONVERSION ROUTINES. FUNCTIONALLY * SIMILAR TO HP PART # 25311-80045. * H* 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 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 DIVSR E$ 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 =GOCT 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 .29 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 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 'CONDIT}ION' 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 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 3|74B 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 OCT 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 $CS5 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 -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 CH0~ARACTERIZING 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 ACCEPTABLE * 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 !HFB ASC 2,S11 H 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 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 0300823 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 AJLWAYS 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 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 20,COMPUTER TYPE: 1=M-SERIES, 2=E/F-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 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 wSTORAGE 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 RU#Z<:6N02 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 & XCVAS 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 o< . 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 2013 S C0122 &DVB12              H0101 d[ASMB,Q,N,C,L * * NAME: DVB12 * SOURCE: 92002-18004 * RELOC: 92002-16004 * PGMR: G.G.(BOISE) * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 DVB12,0 92062-16004 REV.2013 800117 2:30PM ENT IB12,CB12,.BLAB EXT $UPIO,.LBT * 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 * MODIFIED FOR HONISTY MODE BY C G GREGG 790326 * EXPECTED DATE CODE 1926 * * 16 JAN 1980 * MODIFIED BY GCG FOR 2 BUGS * 1. CLEAR EQT15 ON SPUR. INT TO GET RID * OF "ILL INT" MESSAGE * 2. PROTECT AGAINST NONSUPPORTED READS * * * IB12 NOP INITIATION ENTRY JSB SETIO CONFIGURE WITH CURRENT CHAN. # JSB TMOUT SET TIMEOUT VALUE LDA EQT11,I FORCE BIT15 = 0 SSA SET? XOR M100K YES - SO CLEAR IT STA EQT11,I 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 SC3 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 kM+ 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 AND M3400 ISOLATE NON USED BITS 8,9,10 SZA ANY OF THEM SET? JMP EXREJ YES - EXIT WITH ILL REQUEST LDA EQT6,I NO - PROCEED WITH OK READ 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 9TH 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 DONE 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 r 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 JMP 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 S 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 SPC 1 ******************************************************* * * NEXT FOUR INST. ADDED FOR HONISTY MODE * LDA EQT6,I GET ICNWD AND B2000 LOOK AT BIT 10 SZA IF SET JMP WRIT5 GO DO HONISTY MODE * ****************************************************** SPC 1 ) 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 ONE 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 * * EX5AD DEF EXIT5 COMMAND COMPLETE RETURN EXOTA LDB EX5AD RET ADD EXITI STB EQT12,I SAVE TIME OUT RTN ADD LDB EQT11,I SET FLAG FOR OUTPUT OF COMMAND SLB,RSS INB STB EQT11,I 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 d 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 JMP 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 STA B LDA EQX3,I SET "CHANGED PRIM/SEC" FLAG IOR M100K STA EQX3,I LDA B JMP EXOTA SEND CONTROL WORD * PCOL1 LDA EQT7,I REQED NUMBER OF SHIFTS AND M17 INSURE ONLY 4 BITS STA B LDA EQX1,I CLEAR STAT AND NOT15 BUT NOT BIT 15 XOR EQX1,I IOR B SAVE PROG COL 1 STAT STA EQX1,I AND M3777 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 OUTPUT 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 EQTvS11 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 M3200 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 CLB RESET TIME OUT TO 0 STB EQT15,I 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 CLE,ELB SET TO BYTE ADDRESS PRTA JSB .LBT GET BYTE JSB HMODE WRITE TO THE PRINTER JSB .LBT GET BYTE JSB HMODE WRITE TO THEPRINTER ISZ EQT12,I CHECK FOR LAST CHAR. PER PASS JMP PRTA RBR CHANGE TO WORD ADDR. STB EQT7,I SAVE BUFF. ADDR. JMP EXIT1 GO TO NEXT BLOCK SKP * ************************************************************** * * ROUTINES TO DETECT HONISTY MODE AND EXECUTE * CONTROL CHARACTERS CR LF FF * * HMODE NOP CPA .LF JMP ..LF DO A LINE FEED CPA .CR JMP ..CR DO A RETURN CPA .FF JMP ..FF DO A FORM FEED STB EQT7,I SAVE B COUNT LDB EQX1,I LOOK TO SEE IF THIS IS A NEW LINE SSB,RSS IF NOT JMP HMOD0 CONTINUE AS ALWAYS LDB EQT7,I RESTORE B JSB HMOD2 CHECK FOR HONESTY, RTN IF YES LDA EQX1,I CLEAR NEW LINE FLAG AND M100K XOR EQX1,I STA EQX1,I LDB EQX3,I GET NUM OF CHAR OUTPUT ON PREV LINE ELB,BRS SAVE SIGN BIT FOR FLAG CMB,INB MAKE TWOS COMP SZB,RSS IF THERE ARE NO BLANKS JMP HMOD0 THEN OUTPUT NOTHING LDA M40 FILL IN LINE WITH SPACES LF4 JSB OUTA UP TO LINE FEED INB,SZB JMP LF4 LDA TEMP1 HMOD0 LDB EQT7,I RESTOR LINE COUNT HMOD5 JSB OUTA WRITE IT TO PRINTER ISZ EQX3,I COUNT CHAR ON LINE SO FAR HMOD1 ISZ EQT13,I BUMP CHAR COUNT JMP HMODE,I CONTINUE IF NOT DONE LDA EQT6,I CHECK FOR HONESTY MODE AND B2000 SZA JMP EXIT1 THEN TAKE THE HNSTY EXIT LDA EQX3,I CLEAR CHAR COUNT IF NOT HNSTY MODE AND NOT15 XOR EQX3,I STA EQX3,I JMP EXIT0 EXIT * HMOD2 NOP STA TEMP1 SAVE A STB EQT7,I SAVE B LDA EQT6,I CHECK FOR HONESTY MODE AND B2000 SZA JMP HMOD3 LDA TEMP1 JMP HMOD0 NOT HNSTY, OUTPUT HMOD3 LDA HMODE STA EQT10,I SAVE RETURN JMP HMOD2,I * ..LF JSB HMOD2 RTN IF NOT HNSY MODE LDA EQX1,I SET NEW LINE FLAG IOR M100K STA EQX1,I LDA EQT9,I GET THE SET PRINT COMMAND LDB LF3 RETURN TO THIS ADDRS JMP EXITI WHEN DONE--- LF3 DEF CR3 * ..CR JSB HMOD2 IF HNSY MODE LDA EQX1,I LOOK TO SEE IF THIS IS A NEW LINE SSA IF SO JMP CR2+1 A NULL FIRST LINE IS NOT ALLOWED LDA M100K DO A PRINT AN SLEW 0 LDB CR2 RETURN TO ADDRS IN B REG JMP EXITI CR2 DEF *+1 LDA EQX3,I RESET CHAR COUNT AND NOT15 XOR EQX3,I STA EQX3,I CR3 LDA EQT10,I GET RTN ADDR STA HMODE LDB EQT7,I RESTORE B JMP HMOD1 * ..FF JSB HMOD2 IF IN HNSY MODE LDA EQX1,I SET NEW LINE FLAG IOR M100K STA EQX1,I LDA TOF GO TO TOP OF FORM LDB CR2 RETURN TO THIS ADRS IN B JMP EXITI WHILE WAITTING FOR COMP. 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 AND M17 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 LDA EQX3,I NO - LET CURRENT DEFINITION STAND AND M100K XOR EQX3,I 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 M3400 OCT 3400 M3700 OCT 3700 M3777 OCT 3777 NOT15 OCT 77777 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 8ljf1000 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 M3200 DEC -3200 M1153 DEC -1153 * * * * * VFC/SLEW CONSTANTS * TOF OCT 100200 * * * COMMAND BYTE VALUES * * CALPH EQU M100K ALPHA PRINT 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" .LF OCT 12 .CR OCT 15 .FF OCT 14 TEMP1 NOP 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 l 0G 92062-18011 1926 S C0122 &HELP              H0101 sc HELP 92062-18011 DATE CODE 1926 PREPARED BY RANDY ENGLUND 790612 HELP FILE FOR DRIVER SOURCE PROGRAMS FILENAME LANGUAGE PART NO. DATE CODE -------- -------- -------- --------- DRIVER PACKAGE &DVM72 ASMB 9580-18079 B &DSCHD ASMB 9580-18125 A &DVR15 ASMB 9601-18021 1901 &DVR33 ASMB 12732-18001 1805 &DVR10 ASMB 20808-80001 C &PLOT ASMB 20810-80001 C &DVR31 ASMB 29013-80001 1710 &DVR12 ASMB 29028-80002 1805 &DVR00 ASMB 29029-80001 1740 &DVR11 ASMB 29030-80001 1710 &DVR37 ASMB 59310-18005 1926 &HPIB ASMB 59310-18006 1926 &SRQ.P ASMB 59310-18007 1805 &MESS ASMB 59310-18011 1926 &1DV10 ASMB 72008-80001-4 A &2DV10 ASMB 72009-80001 A &DVA13 ASMB 91200-18001 1648 &CHARS ASMB 91200-18002 1648 &TVERF ASMB 91200-18004 1648 &DVA12 ASMB 92001-18020 1826 &DVR05 ASMB 92001-18026 1926 &DVA05 ASMB 92001-18035 1913 &DVR32 ASMB 92060-18031 1840 &LP31 ASMB    92062-18009 1805 &DVB12 ASMB 92062-18010 1926 &DVR23 ASMB 92202-18001 1913 &DVA47 ASMB 92900-18002 1913  18 92063-18001 1913 S 3522 IMAGE LIBRARY SOURCE              H0135 yASMB,R,L,C HED SUBROUTINE DBOPN NAM DBOPN,7 92063-12001 REV.1913 790220 * * ************************************************************** * (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 SHOWNl 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 * LDA AIDCB SET UP POINTER TO STA DCB DATA CONTROL BLOCK FOR RUN TABLE. * *** *** 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 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 ANoD INITIALIZE 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 % ISZ 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 INTERRUPTS 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. ELSE, EITHER OR BOTH * ARE SET TO ZERO. * CLA STA ENTAD STA EMPAD * STA TEMP1 SET TEMP1 TO 0 FOR CURNT. ENTRY CHECK * LDB ADBRN,I USE NEGATIVE OF # OF CMB,INB ENTRIES IN TABLE STB TABCT AS LOOP COUNTER. * * GO PRIVELEDGED FOR REMAINDER OF SEARCH AND/OR SET UP AS THIS IS * CRITICAL CODE. * NOP JSB $LIBR NOP * 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 LDB TABAD YES STB ENTAD SAVE ENTRY ADDRESS. ADB .5 INCREMENT USER COUNT, ISZ 1,I CCA SET TEMP1 TO -1 SIGNIFYING STA TEMP1 CURRENT ENTRY FOUND, JMP C28 AND BRANCH OUT OF CRITICAL CODE. * 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 EMPAD IS ZERO AT THIS POINT, ALL WE DID WAS FOR NAUGHT. IF NOT, * USE EMPAD AS NEW ENTRY. 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. * LDB EMPAD SZB JMP C27 LDB .131 STA TEMP1 SET TEMP1 TO ERROR CODE 131 JMP C28 THEN BRANCH OUT OF CRITICAL CODE. * * C27 LDA PARS,I BUILD NEW ENTRY: 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 LDB TEMP1 IF WE RAN INTO A CURRENT ENTRY SZB,RSS FOR THIS DATA BASE, OR NO EMPTY ENTRY JMP EXIT SSB CLB WE NEED TO DEALLOCATE THE STB PARS+4,I RN & CLASS WE ALLOCATED. * * * 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. * * 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 CPB .130 IF ERROR 130, DCB NOT SET UP YET, JMP DBOPN,I SO DON'T ATTEMPT TO ZERO IT OUT. 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 DATA 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 A 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 DEF 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 DENLHC -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 TEMP2 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  T6 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 hD 92063-18003 1913 S 0822 DBBLD SOURCE              H0108 FTN,L,C PROGRAM DBBLD(3,90),92063-16003 REV.1913 790126 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 CHANGE REV.1913 TO ADD OPFLG TO COMMON. 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,OPFLG 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,OPFLG 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$ Fx FTN,L,C PROGRAM BBLD(5,90),92063-16003 REV.1913 790126 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 CHANGE REV.1913 TO ADD OPFLG TO COMMON. 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 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,E1,E2,E3,E4,E5,CHAR,SYSTY,SCODE,BPUT INTEGER CHAR,PRE INTEGER BCLOS INTEGER CONRD INTEGER QTFLG,OPFLG 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,OPFLG 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 / 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 DEVICE 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 AND DATA BASE OPEN FLAG 104 ERROR=0 OPFLG=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) GO TO 1000 C GET SECURITY CODE AND CONVERT TO INTEGER 105 CALL KEYWD(SCODE) ISTAT=0 CALL CcATI(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) GO TO 1000 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 C CHANGE REV.1913 NO ERROR, SET OPEN DATA BASE FLAG C OPFLG=-1 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) GO TO 1000 111 CALL ERROT(I218) C C CHANGE REV.1913 CLEAN UP AFTER ERROR BY CLOSING INPUT FILE C 1000 CALL CLOSE(BUFF) STOP END END$ nFTN4,L,C PROGRAM BPUT(5,90),92063-16003 REV.1913 790126 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 CHANGE REV.1913 TO ADD OPFLG TO COMMON. 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,OPFLG 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,OPFLG 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, 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, 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) j_ 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 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$ jFTN4,L,C PROGRAM BCLOS(5,90),92063-16003 REV.1913 790126 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 CHANGE REV.1913 TO ADD OPFLG TO COMMON. 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,OPFLG 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,OPFLG 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,2HT ,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$ s 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,92063-16003 REV.1913 790126 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 CHANGE REV.1913 TO ADD OPFLG TO COMMON. 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,CHAR,QTFLG,OPFLG,BCLOS DIMENSION IOBUF(41),IAB(2),BCLOS(3) 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 COMMON L,CHAR,QTFLG,OPFLG DATA IBLNK/2H / DATA I1/1/ DATA I2/2/ DATA I13/13/ DATA I209/209/ DATA BCLOS/2HBC,2HLO,2HS / 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) d%  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 102 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) GO TO 1000 108 CALL ERROT(I209) C C CHANGE REV.1913 IF DATA BASE NOT OPENED, JUST CLOSE INPUT FILE C IGNORING ANY ERRORS. ELSE, BRING IN BCLOS TO PERFORM THE DATA C BASE CLOSE. C 1000 IF (OPFLG.NE.0) GO TO 2000 CALL CLOSE(BUFF) STOP 2000 CALL EXEC(8,BCLOS) END END$  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$  p! 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 %% **  z 92063-18011 1940 S C1422 &QS001 QUERY SOURCE #1             H0114 OFTN4 PROGRAM QUERY(3,90),92063-16011 REV.1940 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=IDC  B+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 $ { 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. 1940 790621 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.GE.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 $ _  N 92063-18012 1940 S C1422 &QS003 QUERY SOURCE #2             H0114 QFTN4 PROGRAM QS12(5,90),92063-16012 REV. 1940 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 OPNTION 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 SUBROUTINE INPUT,92063-16012 REV. 1940 790621 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/698/ 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,x  IERR,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 $ 2 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 ݐ C 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   92063-18014 1913 S 0122 SPACE UTILITY              H0101 1FTN,L,C PROGRAM DBSPA(3,90),92063-16014 REV.1913 790125 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.NEW  .0) GO TO 110 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,I6) 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$ g   92063-18019 1913 S 0122 &BAIMG IMAG SOURCE             H0101 "]ASMB,R,L,C HED <> NAM IMAG,7 92063-16019 REV.1913 790314 * * * ************************************************************ * (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 EXT GETBF,RETBF * * * * 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 LDB AIRUN MAKE SURE THAT THERE IS NOT SZB,RSS ALREADY AN ACTIVE RUN TABLE JMP OKAY IN OUR MEMORY SPACE. ADB .3 LDA B,I CPA =ALB JMP ER103 OKAY 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 * JSB GETBF SEE IF WE CAN GET A BUFFER DEF *+4 OF THAT SIZE. DEF LENTH DEF AIRUN DEF TMP SSA ALLOCATED? JMP E128 NO - NO MEMORY ERROR. * JSB GETBF TRY TO ALLOCATE A 272 WORD DCB DEF *+4 DEF .272 DEF AIDCB DEF TMP SSA,RSS ALLOCATED? JMP A272 YES - USE IT. * JSB GETBF NO - TRY TO ALLOCATE DEF *+4 A 144 WORD DCB DEF .144 DEF AIDCB DEF TMP SSA,RSS ALLOCATED? JMP A144 YES - USE IT. * JSB RETBF NO - DEALLOCATED RUN TABLE BUFFER DEF *+2 DEF AIRUN JMP E128 AND RETURN NO MEMORY ERROR. * A144 LDA M144 A 144 WORD DCB GOTTEN RSS A272 LDA M272 A 272 WORD DCB GOTTEN STA ISIZE * CLB CLEAR THE STATUS WORD LDA AIRUN FOR DBOPN. ADA .3 STB A,I * JSB ASCI CONVERT STRING TO ASCII DEF ILEVL PAs<SS 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 DMOPN,I TERMINATE OPEN CALL * ER103 LDA .103 A DATA BASE ALREADY OPEN. RSS 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 46R6 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 INFO 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 SET 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 G 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 # 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 HIGH 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,I 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 * *************************************************************** * 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 * * *************************************************************** * 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 CO:UNT 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 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 BUFFER 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#b 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 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 11 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 JMDwP 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 *+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 I/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 INFORMATION * 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 CCA GET WORD -1 OF CURRENT PARM. ADA VARS IT CONTAINS A NEG. # IF LDA A,I PARM. A CHARACTER STRING. CLE E USED AS INDICATOR OF PARM TYPE SSA 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 .5 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 ADA VARS NO, TEST IF WRITING IN NEXT PARM ADA TMP ADA .3 SSA,RSS (NEXT PARM = VARS+TMP+3) 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 .5 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 13 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 13 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 STPB 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 F*OR 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 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 * IVAL 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 YES, CONTINUE LDA VARS NO, TEST IF READING FROM NEXT PARM ADA .5 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 J 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 .5 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 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 IF MODE=0, RETURN RUN TABLE BUFFER JMP CLS1 JSB RETBF DEF *+2 DEF AIRUN JSB RETBF AND DCB BUFFER DEF *+2 DEF AIDCB * CLS1 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 * * UNPA`K-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 .144 DEC 144 .272 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 G $ 92064-18001 1940 S C0322 &MSC1 RTE-M1 SCHEDULER MODULE             H0103 ASMB,R,L,C ** RTE-M I SCHEDULER MODULE ** HED ** RTE-M I SCHEDULER MODULE ** * * NAME : $MSC1 * SOURCE: 92064-18001 * RELOC: 92064-16001 * PROGMR: E.J.W.,J.U.F. * BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.1940 790712 * 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 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 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 PR{AMS 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 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 9 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 * y 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 @ SU{SP". DL062 STA TEMPX AND SAVE TEMPORRIALLY. JSB DORM? SET UP LIST PRAMS & 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) * ************K************************************************* * 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 * 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 CU}HFBRRENT 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 ID ADDRESS OF PROG L0015 ISZ $LIST STEP TO RETURN ADDRESS JMP $LIST,I LOOK MA! NO LABEL! 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 "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 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 1940 S C0122 &MEX1 RTE-M1 EXECUTIVE MODULE             H0101 - ASMB,R,L,C ** RTE-M I EXECUTIVE MODULE ** HED ** RTE-M I EXECUTIVE MODULE ** * * NAME : $MEX1 * SOURCE: 92064-18002 * RELOC: PART OF 92064-16001 * PROGMR: E.J.W.,J.U.F * BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.1940 790629 * * 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 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. * * * $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 * RQP2UA DEF 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 p 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-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. * * * * *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  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 f 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 STC STA SW1 SET CONFIGURED STC 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 STC STC 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 EQ5UNLHU .+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 END EXEC *N  92064-18003 1901 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.1901 780721 * 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. LDA IOMSA 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,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 4 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: j* 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 ***** 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 JM P 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 ALLT 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 ERyROR, 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 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 * ************ HFB***************************************************** * $XXUP NOP 0 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< Q 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   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  92064-18006 2026 S C0422 &MSCOO RTE-MII/MIII SCHEDULER             H0104 5,ASMB,R HED RTE-M SCHEDULER/MESSAGE PROCESSOR *USE 'ASMB,R,N' (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.,J.U.F * 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.,J.U.F. * BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. 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 $MSC2,0 92064-16002 REV.2026 800321 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MSC3,0 92064-16003 REV.2026 800321 ******* 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 *************** 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*** QLDA 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 * J# ! ! ! ! ! ! * 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 NUMBERK 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 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 u 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 *---------!-----!-------!-------!-------!-------!-------!------ G * 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 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 C'ALLER 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 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 TO1 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 * * * ************************************************************ * * 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 ENyTERED 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 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 LDB WORK .RETURN 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 NNLHOT 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 I1N 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 OPERATOR SUSPEND, THEN STATUS ER(.ROR 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 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 Nm OT 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,...,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 * SKP * * 21. RUN REQUEST * RU,XXXXX * RU,XXXXX,P1,...,P5 * 22. BUFFER LIMIT PRINT/CHANGE * BL OR BL,N1,N2 * * 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. * * HED OPERATOR INPUT MESSAGE DECIPHER ROUTINE $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 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 LDB WSTAT,I IF NO PARAMETERS RBL,RBL BIT IS SET, THEN SSB,RSS B@< ILLEGAL STATUS 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 |B 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 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 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'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 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 D12 DEC 12 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 JMP M0150 EXIT SPC 2 B20K OCT 20000 HED MESSAGE PROCESSOR--GO COMMAND * * 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 fOPER 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 * 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 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 OCT 301 JMP $MSEX * D28 DEC 28 NRFL1 OCT 100001 NEW-RUN FLAG SET AND LU 1 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 SPC 1 IFN * BEGIN NON-DMS CODE ********** JMP M0550 CURRENT PGM *** END NON-DMS CODE ********** XIF SPC 1 IFZ ***** BEGIN DMS CODE ********** gz 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 $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 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 RECONFIGU%RATION 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 N 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 P5ROCESSOR * * 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 PRO-G 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 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 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 NLHHN 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+1  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 DB@ 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 EXECkUTIVE. * * 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 THEB@< 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 * tB 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 * 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 ADJUST '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-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 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 Z HERO) * 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 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 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 ******* BEGIN 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 * cTEMP9 = 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 ******* EN D 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 SUBROUTINE 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 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 *******8C* 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 SET 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 * CLA,CCE ** SET DUMMY ADDRESS TO STA TEMP1 AVOID PROBLEM ** * 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 SE]QUENCE : 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 HFBWITH 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 H 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 $SxDSK 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 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 * 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 $MPT4 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 * * 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 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 X " 92064-18008 2001 S C0622 &MIO00 RTE-MII/MIII I/O MODULE             H0106 ASMB,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.,J.U.F. * 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.,J.U.F. * BASED ON RTE-III VERSIONS G.A.A.,L.W.A.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.2001 791022 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM $MIO3 92064-16003 REV.2001 791022 ******* 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 f 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 AbLLOWS 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 INTERqRRUPT 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 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. * * 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 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/O 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 SZB TIME-OUT CLOCK STB EQT15,I IF USER SPECIFIED A TIME-OUT * * CALL I/O PROCESSOR, COMPLETION SECTION * * P+1 RETURN: INDICATES COMPLETION OF THE REQUE4ST. * P+2 RETURN: INDICATES CONTINUATION OF THE REQUEST. * P+3 RETURN: NEED/GIVE-UP DMA RETURN: * A-REG=5 TO GET DMA * A-REG=6 TO GIVE-UP DMA * * LDB EQT3,I CALL DRIVER ELB,CLE,ERB CLEAR FLAG BIT JSB B,I *COMPLETION* SECTION. * JMP IOCOM (P+1): *COMPLETION RETURN* JMP IOCON (P+2): *CONTINUATION RETURN* CPA .6 (P+3): *NEED/GIVE-UP DMA RETURN* JMP IODMA IF (A) .NE. 6 (SHOULD BE 5), IT'S A LDA EQT3,I NEED-DMA RETURN. SO FIRST SET THE IOR B100K DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. IFZ ***** BEGIN DMS CODE *************** JSB $RSM RESTORE USER MAP. ***** END DMS CODE *************** XIF ISZ CONFL FAKE *DRIVR* CALL, FLAG=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 JMP NOTRD (P+2) AT INITIATION. OK, RETURN TO (P+1). * IODMA JSB CLDMA IT WAS A GIVE-UP-DMA RETURN, SO DO IT. LDA EQT5,I CHANGE EQT STATE AND MSK14 FROM "WAITING-FOR-DMA" (BIN. 11) STA EQT5,I TO "BUSY" (BIN. 10). LDA EQT3,I THEN CLEAR THE DRIVER-EXITED-FROM- ELA,CLE,ERA CONTINUATION-SECTION- STA EQT3,I TO-GET-DMA FLAG. IFZ ***** BEGIN DMS CODE *************** JSB $RSM RESTORE USER MAP. ***** END DMS CODE *************** XIF JMP IOCX GO CHECK THE DMA QUEUE 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 Z[ 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 WSTB 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 1 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 B100K OCT 100000 MSK14 OCT 137777 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 > 5^HFB* 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: * ~H 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 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 CB4ONTENTS 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 - * * 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 (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 * * * * 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. * 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 @H6 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. * 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 h?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 NONET 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 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 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 E 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) = BUFFER 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 3IN 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 * xN 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 YNLHLDB 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) * 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) +N 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 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 * vL.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), 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. (U 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 jDMS 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. * ************************************************* **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 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 LDA EQT3,I IF HERE ONLY TO GET DMA SSA AT THE REQUEST OF DRIVER, JMP DRV4 SKIP SETTING UP EQT. * 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 DRV4 LDA EQT4,I GET THE 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, WITH (B)=TRANSMISSION LOG. * * = 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 * v = 5 DRIVER REQUIRES DMA BUT FLAG IS NOT SET IN EQT * = 6 INITIATION OK, BUT DRIVER WANTS TO GIVE UP DMA * STA TEMP6 SAVE DRIVER CODE. SPC 1 IFZ ***** BEGIN DMS CODE ************** JSB $RSM GO RESTORE USER MAP ******* END DMS CODE ************** XIF SPC 1 LDA EQT3,I CLEAR THE ELA,CLE,ERA DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. LDA TEMP6 RESTORE DRIVER CODE SZA,RSS IF SUCCESSFULLY INITIATED, JMP DRV05 CONTINUE * CPA .6 ELSE IF THIS WAS NOT A RSS GIVE-UP-DMA RETURN, JMP DRV06 INVESTIGATE REJECTION * JSB CLDMA GIVE UP DMA * * OPERATION INITIATED * DRV05 CCE SET (E) FOR WHAT FOLLOWS. 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 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 PRIORvITY * 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 LOGICAHFBL 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 *************** ADB .4 BUMP RETURN ADDR ******* END DMS CODE *************** XIF SPC 1 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 MH 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 > * 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 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. LDA EQT3,I CLEAR THE ELA,CLE,ERA DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG. * 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 = 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 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 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 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 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 V * 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 F]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 x 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 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. {HFB * * 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. * ********************************************************************** * H 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). * 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. LDA IOMSA 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.q * ****************************************************************** * 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 * q* 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 ***** 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 SPC 1 IFN * BEGIN NON-DMS CODE *************** BLF,SLB IF DRIVER TO HANDLE TIME-OUT JMP CIC.8 CALL DRIVER. I/O SELECT CODE IN (A) *** END NON-DMS CODE *************** XIF SPC 1 IFZ ***** BEGIN DMS CODE *************** STA INTCD BLF,SLB IF DRIVER TO HANDLE TIME-OUT 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 D0ESCRIBED 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 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 $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 * ******************X^HFB******************************************************* * * 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. H 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 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 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 d 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 CONDOBITIONS 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 INXS 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. * * 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 * SKP * * * SPECIAL CONSIDERATION FOR "I/O CLEAR" * * * IF THE EQT IS DOWN OR FREE, I/O WAS NOT ONGOING, SO THERE * IS NO NEED TO ISSUE THE CLEAR REQUEST. * * * IF THE DRIVER WAS BUSY, WE CERTAINLY NEED TO ISSUE THE * CLEAR REQUEST. * * * IF BIT 14 AND 15 ARE SET (IN EQT5) THE DRIVER IS IN DMA-WAIT. * * IF THE "D" BIT IS SET IN EQT4 (DMA REQUIRED) DRIVER GETS DMA * AUTOMATICALLY ALLOCATED AT INITIAL ENTRY (DYNAMIC ALLOCATION * OF DMA IS NOT USED). HOWEVER, IOC NEVER CALLED THE DRIVER FOR * THIS CALL, BECAUSE DMA WAS UNAVAILABLE. HENCE, AGAIN THERE IS * NO NEED TO ISSUE THE CLEAR REQUEST. * * IF THE "D" BIT IS NOT SET, IT IS STILL POSSIBLE THAT THE DRIVER * ASKED FOR DYNAMIC DMA ALLOCTION FROM ITS CONTINUATION SECTION * (IF SO, THE "DRIVER-EXITED-FROM-CONTINUATION-SECTION-TO-GET-DMA" * FLAG, EQT3 BIT 15, WILL BE SET), AND IN THAT CASE, WE DO NEED  * TO ISSUE THE CLEAR REQUEST. * * IF NEITHER "D" (IN EQT4) NOR BIT 15 (IN EQT3) IS SET, THEN THE * DRIVER REQUESTED DMA FROM THE INITIATION SECTION. IN THIS CASE, * NOTHING WAS STARTED (HOPEFULLY) BY THE DRIVER FOR THIS CALL, AND * AGAIN WE DO NOT ISSUE THE CLEAR REQUEST. * * LDA EQT5,I GET CURRENT STATUS RAL GET AV BITS IN BIT 15 AND BIT 1 SLA,RSS IF DOWN (OR FREE), JMP $XEQ LEAVE THE EQT ALONE. * SSA,RSS IF BUSY, JMP IOC64 GO ISSUE THE CLEAR. * LDB EQT4,I IF THE D BIT SSB IS SET, JMP $XEQ LEAVE THE EQT ALONE. * LDB EQT3,I IF DRIVER-EXITED-FROM-CONTINUATION- SSB,RSS SECTION-TO-GET-DMA FLAG IS CLEAR, JMP $XEQ LEAVE THE EQT ALONE. * IOC64 LDA EQT5,I MAKE AND MASK THE EQT STA EQT5,I NOT BUSY 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 LDA EQT3,I CLEAR THE ELA,CLE,ERA DRIVER-EXITED-FROM-CONTINUATION- STA EQT3,I SECTION-TO-GET-DMA FLAG JMP $XEQ GO TO THE DISPATCHER * SPC 1 IOCL5 CLE IONCL6 NOP IOC50 NOP IOC51 NOP MASK OCT 37777 * .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 mB@ (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<  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 $   92064-18016 1940 S C0122 &MMES RTE-M MMESS SUBR             H0101 cASMB,R,L,C * NAME : $MMES * SOURCE: 92064-18016 * RELOC: 92064-16081 * PROGMR: E.J.W. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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-16081 REV.1940 790717 ENT MESSS EXT $LIBR,$LIBX,$MESS,.ENTP,$WORK,$PVCN * A EQU 0 B EQU 1 * 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 * 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 NOR ON-EXIT2 * 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 * D28 DEC 28 C77 OCT 177700 END   92064-18017 1940 S C0122 &.CBT RTE-M .CBT SUBR             H0101 &ASMB,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 * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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 .CBT,7 92064-16081 REV.1940 790717 ENT .CBT,.LBT,.MBT,.SBT,.SFB * * * SOURCE - 92064-18017 * RELOCATABLE - 92064-16081 * .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 .CBTO,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 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 >  92064-18018 1940 S C0122 &MMP RTE-M1 SCHEDULING OPTION             H0101 ;ASMB,R,L,C ** RTE-M I MULTI-PROGRAM SCHEDULING MODULE ** HED ** RTE-M I MULTI-PROGRAM SCHEDULING MODULE ** * * NAME : $MMP * SOURCE: 92064-18018 * RELOC: 92064-16006 * PROGMR: E.J.W.,J.U.F. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.1940 780716 * ENT $SABR,$MPT1,$MPT4,$MPT5,$MPT7 EXT $TREM,$WORK,$LIST,$XEQ,$WATR,$PRAM EXT $TIMR,$TNAM,$ERAB,$IOCL,$ABRT * 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 PROG - SAVE 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?a 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 CLOSE! * LDB D2 JMP ESCXX GO ABORT HIM * M0240 JSB $SABR DO SOFT ABORT JMP $XEQ AND GO TO DISPATCHER * M0250 LDA WSTAT,I DO HARD ABORT 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 JMP $XEQ AND GO TO DISPATCHER * MPT1C 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 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 B200 OCT 200 B377 OCT 377 B7777 OCT 7777 TMEP 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 PRAME$TER 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 SEZ 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 3 JMP IDCK3+1 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 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 REg640GISTER' 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 }6   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   92064-18021 1901 S C0122 &MTS RTE-M TI SCH OPT             H0101 ^ASMB,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.1901 781102 * 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 5* $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 IN/B 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* * TI*ME 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 I 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 STB $WORK STA XEQT ADB D15 SAVE RESOURCES LDA B,I BIT IN THE IOR B200 PROGRAMS STA B,I STATUS WORD 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 $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 TTABF2 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 * 6 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 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 M0t604 SETTING UP THE ID-SEG 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 v,$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 * * :NLH ** SYSTEM BASE PAGE COMMUNICATION 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  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 2001 S C0222 &MAP00 RTE-M APLDR SOURCE             H0102 ASMB,R HED *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.,J.U.F. * * IFZ OPTION * NAME : APLDR * SOURCE: 92064-18027 * RELOC: 92064-16016 * PROGMR: E.J.W.,J.U.F. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.2001 791011 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 92064-16016 REV.2001 791011 ******* 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 - 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 LO: 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 ADDR. 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{j EOF? JMP LOAD5 YES. SSA 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 AD]A TEMP5,I FROM LAST HFREE SSA 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 PT"FWA 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 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 ORk 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 COMMON SZB,RSS JMP LOD8A SKIP CHECK IF NO COMMON LDA FWAC GET FWA COMMON CMA SUBTRACT FROM ADA RTORG FWA REAL-TIME COMMON SSA,RSS FWACRTCOM? JMP LOADE YES, ERROR. * * 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 FORnNLH 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 NAME 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 N 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 * 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 SUBTR 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 * o;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 SEGs 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 w 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 gMVW 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 * * STUFP 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 MSG 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 y 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 OVERFLOW ASC 2,MEM * ERR13 DEF *+1 IDENTIFICATION RECORDS MISSING OR WRONG ASC 2,ID? * ERR99 DEF *+1 APLDR IS ABORTED ASC 4,ABORTED * * MSG1 DEF *+1 ASC 3,DONE- LDASH EQU *-1 "- " * * MT.ID DEF *+1 ASC 11, 00 BLANK ID SEGMENTS DBLNK EQU MT.ID+1 DOUBLE BLANK WORD DFBLK DEF DBLNK * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * SPC 1 IFZ ***** BEGIN DMS CODE *************** ERR14 DEF *+1 NO FREE PARTITION ASC 2,PTN * ERR15 DEF *+1 PARTITION NOT LARGE ENOUGH ASC 2,PTSZ * PUNDF DEF *+1 ASC 6, NOT DEFINED * PTNON DEF *+1 ASC 3, 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 BUZ<:6F+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 v<  92064-18027 2013 S C0222 &MAP00 RTE-M APLDR             H0102 \ASMB,R HED *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 1980. ALL RIGHTS * * * RESERVED. 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.2013 800209 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM APLDR,1,40 92064-16016 REV.2013 800209 ******* 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 - CHAR01 8:15 / CHAR2 0:7 * P4 - 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 LO: 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 A STA WORD1 DUMMY ID ADDR. 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. SSA 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? U 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 FR0OM LAST HFREE SSA 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 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. * LOADHFB8 LDB SZCOM GET SIZE OF COMMON 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. * * 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. * (cH SKP * * * 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 NAME 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 gvPROG 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 * 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 SUBTR 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 MUShuT 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 :HPRINT 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 0 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 * * STUFP 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 MSG 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 * * 8***************************** * * 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 * * MCVDEC 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 * * 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 OVERFLOW ASC 2,MEM * ERR13 DEF *+1 IDENTIFICATION RECORDS MISSING OR WRONG ASC 2,ID? * ERR99 DEF *+1 APLDR IS ABORTED ASC 4,ABORTED * * MSG1 DEF *+1 ASC 3,DONE- LDASH EQU *-1 "- " * * MT.ID DEF *+1 ASC 11, 00 BLANK ID SEGMENTS DBLNK EQU MT.ID+1 DOUBLE BLANK WORD DFBLK DEF DBLNK * HEAD1 DEF *+1 ASC 19, PROGRAM LIST: NAME,PRIORITY,MAIN,BASE * XUB@< SPC 1 IFZ ***** BEGIN DMS CODE *************** ERR14 DEF *+1 NO FREE PARTITION ASC 2,PTN * ERR15 DEF *+1 PARTITION NOT LARGE ENOUGH ASC 2,PTSZ * PUNDF DEF *+1 ASC 6, NOT DEFINED * PTNON DEF *+1 ASC 3, 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 3B  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 1901 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.1901 781106 END   92064-18104 1901 S C0122 &MSY0R RTE-MII, III OP SYSTEM             H0101 2ASMB,R *USE 'ASMB,R,N' (RTE-M II) OR 'ASMB,R,Z' (RTE-M III) * * IFN OPTION * NAME: MSY2R * SOURCE: 92064-18104 * RELOC: PART OF 92064-16002 * PROGMR: E.J.W. * * IFZ OPTION * NAME : MSY3R * SOURCE: 92064-18104 * RELOC: PART OF 92064-16003 * 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. * * **************************************************************** * * IFN * BEGIN NON-DMS CODE *************** NAM MSY2R 92064-16002 REV.1901 781106 *** END NON-DMS CODE *************** XIF IFZ ***** BEGIN DMS CODE *************** NAM MSY3R 92064-16003 REV.1901 781106 ******* END DMS CODE *************** XIF * END <  92064-18105 1805 S 0122 &MFMPF FLEX. DISC FMP LIBR.             H0101 ASMB,R,L * NAME: MFMPF * SOURCE: 92064-18105 * RELOC: 92064-16058 * 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 MFMPF,7 92064-16058 REV.1805 771019 END 7  92064-18106 1805 S C0122 &MFMPC CRTG FMP LIBRARY             H0101 ASMB,R,L * NAME: MFMPC * SOURCE: 92064-18106 * RELOC: 92064-16061 * 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 MFMPC,7 92064-16061 REV.1805 771019 END ,  92064-18120 2026 S C0522 &RTMGO RTE-M GENERATOR SOURCE             H0105 ;=ASMB,R,L,C RTMGN HED RTMGN RTM SYSTEM GENERATOR NAM RTMGN,3,90 92064-16022 REV.2026 800326 ************************************************** * * 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 P1 .PRESET MEMORY PROTECT FLAG LDB B1770 . FOR FIRST INTERRUPT JSB STCR1 * 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 r PUT IN LST LDA UDFE STA LST4,I SET TO UNDEFINED ISZ UNDEF DON'T OUTPUT AS UNDEF 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 N2C JSB GETNA GET NEXT 2 CHARACTERS CPA D D? RSS YES, DONE JMP ENTRI 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 B1770 OCT 1770 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 K $STRT START ADDRESS * SKP * * THE DOCON SUBROUTINE ANALYZES THE INPUT FOR THE * CHANNEL NO., 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 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 RELOCATE 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 DURINHFBG THE INITIALIZATION SECTION. * * CALLING SEQUENCE: * A = IGNORED * B = IGNORED * JSB INERR * * RETURN: CONTENTS 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 H HED RTMGN GENERATE I/O TABLES * * 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 B"HE MADE * N3 = ABSOLUTE VALUE (6 OCTAL 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 INITIALIZE 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? JMP 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 C1HAR FROM LBUF CPA ZERO END 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 A 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 5ASC 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 INTERRUPT 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 ABS 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 3OUTCR 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 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 * s 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 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 * * 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 NLHCHAR 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 * eN 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 DEC 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 VA{uLUE. * * 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 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 IPXSV,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 POINTERS 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 * * 5 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 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 SSRA 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 JMP 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 FKROM 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 * B = 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 * * INTERRUPT TABLE PROCESSOR * SINTT JSB SPACE NEW LINE SINT JSB INTER INTERACTIVE INPUT LDA PPREL GET CURRENT RELOCATION ADDR STA AINT SAVE INTERRUPT TABLE ADDRESS LDA P9 LDB MES29 MES29 = ADDR. * INT TABLE JSB PRIN1 PRINT: INT TBL LDA A$CIA $CIC ADDRESS IOR IJSB ADD JSB 0,d0I CODE STA JSCIC SET JSB CIC,I CODE JSB BUFCL JSCIC OCT 0 STUFF DATA CLA STA PROCT LDB LWABP LDA 1 CMA,INA ADA P58 SSA LDB P58 LDA P5 JSB SETCR OUTPUT JSB $CIC,I * LDA HLTB4 SET HLT 4 INTO LOC 4 LDB P4 ADDRESS JSB STCR1 OUTPUT HLT 4 LDB P6 GET ADDR OF FIRST INT LOCATION STB TBREL SET CURRENT BP ADDRESS JSB SPACE NEW LINE * SETIN JSB INTER INTERACTIVE INPUT LDA P3 LDB QUEST ? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA EN CHARS = EN? JMP ENDIO YES - I/O TABLES COMPLETE CPA RI REPEAT INTERRUPT? JMP SINT YES CPA RE GO BACK TO EQT? JMP GENIO YES CPA RD REPEAT DRT? JMP DRT01 YES 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 JSB INERR ERROR JMP SETIN REPEAT INPUT * SETCH LDA OCTNO GET INT CHANNEL NO. STA INTCH SAVE CHANNEL NO. ADA N4 CHAN L.T. 4? SSA JMP CHERR YES, CHANNEL ERROR * 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 RECORD IMNEM LDA NA SET CODE = INVALID INT MNEMONIC JSB ERRER ERROR JMP SETIN REPEAT INPUT * INTEQ LDA N2 JSB GETNA MOVE NEXT 2 CHARS TO TBUF CPA T 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 LDA OCTNO GET EQT TABLE ENTRY NO. CMA,INA,SZA,RSS SKIP - VALID LOWER LIMIT JMP EQUER INVALID EQT REFERENCE STA 1 SAVE EQT NO. ADA CEQT ADD UPPER EQT REF. NO. SSA,RSS SKIP - INVALID UPPER LIMIT JMP TSTIQ TEST FOR FIRST EQT REFERENCE EQUER LDA EQ SET CODE = INVALID EQT NO. JSB ERRER ERROR JMP SETIN REPEAT INPUT * TSTIQ LDA OCTNO GET EQT ENTRY NO. ADA N1 ALF MULTIPLY BY ADA 1 15 INA ADA AEQT ADD ADDRESS OF EQT TABLE LDB JSCIC GET JSB CIC CODE JMP COMIN SET INTERRUPT TABLE, LOCATION * INTPR LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA G CHARS = G,BLANK? RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA TBREL FETCH CHANNEL CMA,INA ADA INTCH ASSENDING ORDER? SSA,SZA JMP IMNEM NO, ERROR LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDA TBUF+2 NAME: 5 AND M400 MASK OUT LOWER HALF IOR INTCH PUT IN CHN(SELECT CODE) STA TBUF+2 SAVE IN TABLE LDA ATBUF ADDRESS OF NAME JSB LDIPX PUT IN TABLE CLA LDB JSCIC JMP COMIN * INTEN LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA T CHARS = T, BLANK RSS YES - CONTINUE JMP IMNEM INVALID INT MNEMONIC LDA N5 JSB GETNA MOVE 5 CHARS TO TBUF LDB ATBUF ADDR OF NAME JSB SSTBL SEARCH SYMBOL TABLE RSS NOT FOUND, ERROR JMP SETE1 SET ENTRY POINT ADDRESS ENERR LDA AD SET CODE = INVALID ENTRY POINT J JSB ERRER ERROR JMP SETIN REPEAT INPUT * SETE1 LDA LST5,I HAS LINK BEEN MADE? SZA,RSS JMP SETEN NO, GO MAKE ONE IOR IJSB YES, FORM THE JSB FOR BP STA B CLA JMP COMIN SETEN LDA LST4,I GET BP LINK ADDRESS LDB .MEM2 MAKE A BP LINK JSB STCR1 LDA .MEM2 STA LST5,I IOR IJSB ADD JSB 0,I CODE STA 1 CCA ADJUST LWABP ADA .MEM2 STA .MEM2 CLA SET INT ENTRY = ZERO JMP COMIN SET INTERRUPT TABLE, LOCATION * INTAB LDA N2 JSB GETNA MOVE 2 CHARS TO TBUF CPA S CHARS = S,BLANK RSS YES - CONTINUE JMP IMNEM NO - INVALID INT MNEMONIC LDA P6 JSB GETOC GET 6 OCTAL DIGITS, CONVERT JMP IMNEM 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? RSS YES, CONTINUE JMP ENERR NO, BUT SHOULD BE LDA INTCH GET INT CHANNEL NO. CPA P4 SPECIAL PROCESSING JMP PFINT IF TRAP CELL FOUR CMA,INA ADA TBREL ADD CURRENT 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 EQERR LDA CH SET CODE = INVALID INT CHNL ORDR JSB ERRER ERROR JMP SETIN REPEAT INPUT * PFINT LDA TBUF IF TRAP CELL FOUR, SZA ENTRY MUST BE AN JMP CHERR 'ABS' OR AN 'ENT' LDB P4 LDA TBUF+1 STORE INTO JSB STCR1 CLA STA FTIME JMP SETIN GET NEXT INTERRUPT RECORD * * FILLI STA TCNT SET NO. OF FILL-INS REQUIRED CLA SET INTERRUPT TABLE ENNLHTRY = ZERO LDB PPREL ADDRESS JSB STCR1 ISZ PPREL INCR CURRENT INT TABLE ADDRESS ISZ TBREL INCR CURRENT INT LOCATION ADDR ISZ TCNT SKIP - ALL FILL-INS COMPLETE JMP FILLI+1 CONTINUE INT FILL-IN * STINT ISZ TBREL INCR CURRENT BP LOCATION ADDR LDB TBREL GET INT LOCATION ADDR CMB,INB ADB P64 ADD ADDR OF FIRST SYS LINK SSB SKIP - INT LOCATION OVERFLOW JMP EQERR * LDA TBUF+1 GET INT LOCATION CODE LDB TBREL INT. ADDRESS PLUS ONE ADB N1 ADJUST JSB STCR1 SET CORE LDA TBUF GET INT TABLE CODE LDB PPREL ADDRESS JSB STCR1 OUTPUT IT ISZ PPREL INCR CURRENT RELOCATION ADDR CLA STA FTIME 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 * * OUTPUT EQTA THRU INTLG * LDA AEQT EQT START ADDRESS STA LBUF LDA CEQT NUMBER OF EQTS STA LBUF+1 LDA ASQT DRT START ADDRESS N STA LBUF+2 LDA CSQT NUMBER OF DRT'S STA LBUF+3 LDA AINT INTERRUPT TABLE ADDRESS STA LBUF+4 LDA CINT NUMBER OF INTERRUPT ENTRIES STA LBUF+5 LDA EQTA START ADDRESS-ABS LDB INTLG END ADDRESS JSB SETCR GO BUILD ABS JMP JMPFT * N4 DEC -4 P58 DEC 58 P64 DEC 64 * EQ ASC 1,EQ INVALID EQT NO. IN INT RECORD G ASC 1,G QUEST DEF *+1 ASC 2,* ? RI ASC 1,RI S ASC 1,S T ASC 1,T * HLTB4 OCT 103004 TRAP CELL DEFAULT VALUE IJSB JSB 0,I I-JSB CODE FOR INTERRUPT LOCS * AINT NOP ADDRESS OF INTERRUPT TABLE CINT NOP NO. ENTRIES IN INTERRUPT TABLE INTCH NOP INT RECORD CHANNEL NO. TBREL NOP * MES29 DEF *+1 ASC 5,* INT TBL SKP * * ALLOCATE SPACE FOR MEMORY PROTECT FENCE TABLE * JMPFT LDB $MPFT NAME OF TABLE LDA PPREL CURRENT ADDRESS JSB STUFF PUT IN $MPFT LDA PPREL STA MPFT ADA P5 STA PPREL UPDATE CURRENT ADDRESS * * ALLOCATE SPACE FOR MEMORY RESIDENT MAP * LDA SYSTM GET SYSTEM TYPE CPA P3 TYPE = 3? RSS JMP ID NO, GET NO. OF ID SEGMENTS LDB $MRMP NAME OF TABLE LDA PPREL CURRENT ADDRESS JSB STUFF PUT IN $MRMP LDA PPREL SAVE ADDRESS OF TABLE STA MRMP ADA P32 STA PPREL UPDATE CURRENT CORE ADDRESS HED PARTITION DEFINITION SKP * * SET MAXIMUM NUMBER OF PARTITIONS AND CREATE MAT TABLES * LDB $MATA NAME OF TABLE LDA PPREL CURRENT ADDRESS STA MATA ADDRESS OF MEMORY ALLOCATION TABLE -1 INA JSB STUFF PUT IN $MATA JSB SPACE NEW LINE PARTN JSB INTER INTERACTIVE INPUT LDA P27 LDB MES18 MAX NUMBER OF PARTITIONS? JSB READ PRINT MESSAGE, GET REPLY LDA N2 JSB DOCON JMP PARTN REPEAT INPUT STA LBUF SAVE MAXIMUM NUMBER OF PARTITIONS STA MAXPT SZA,RSS JMP PTERR NO. OF PARTITIONS MUST BE > 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 ALLOCATION 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 TAEO 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 LDB $SSGA JSB ENTPT LDA .MEM3 STA LST4,I 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 LDA .MEM3 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 ]VADD 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 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 AGAIIN 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 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 KEYCSN 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 OF 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 BSWS 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 PPREL 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 MALYBE 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 LWAM 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 RB@< 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 8B 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 STA MXPTL .MAXIMUM PARTITION LENGTH 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 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 mGET 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 ADc@A 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 SEG$"MENTS LEFT ME49I DEF ME49A ME50I DEF ME50A MES49 DEF *+1 ASC 13,* SYSTEM STARTS AT TRACK ME49A BSS 3 ASC 4, SECTOR ME50A BSS 3 END RTMGN * Ν$  ?I 92064-18121 1740 S C0122 &RTMLD RELOCATING LOADER             H0101 ASMB,R,L,C HED RTM RELOCATING LOADER * * ********************************************************* * * RTM LOADER MAIN CONTROL * MIKE SCHOENDORF * OCTOBER 8, 1976 * * SOURCE: 92064-18121 * RELOCATEABLE: 92064-16023 ********************************************************* * NAM RTMLD,3,90 92064-16023 REV.1740 770618 * * ENTRY POINT NAMES * ENT PNAME,PNAMA,PRAMS * * EXTERNAL REFERENCE NAMES * EXT ABRC1,ABRT1,BPLOC,CLFL2,COML,CONSO EXT DBTAD,DIAG,DIAG2,EXEC6,FWABP,FWAC EXT FWAM,INIT2,LDGEN,LGUNT,LNKDR,LOCC EXT MAPS,.MEM4,PRCMD,PRINT,SCP,TIMES EXT TYOFF,?XFER EXT KCVT * * SUP ********************************************************** * THE FUNCTION OF THIS LOADER IS TO RELOCATE AND LINK * RELOCATABLE BINARY MODULES TOGETHER, AND PREPARE * THEM FOR EXECUTION ON AN RTM SYSTEM. AFTER * STARTING THIS LOADER WITH A ON LOADR COMMAND * A SNAPSHOT CAN BE READ IN. * THIS SNAPSHOT CONTAINS THE DEFAULT * MEMORY BOUNDS, SYSTEM COMMON, AND DEFINES THE * CORE-RESIDENT LIBRARY ROUTINES FOR THE TARGET RTM * SYSTEM. * SYMBOL TABLE ENTRY FORMAT: * * WORD 5 - OCT 0 (LINK OR FIXUP TABLE ADDRESS) * 4 - DEF SYMBOL (HOLDS SYMBOL VALUE) * 3 - OCT XX000 CHAR 5 AND FLAGS * 2 - ASC 1, CHARS 3,4 OF NAME * 1 - ASC 1, CHARS 1,2 OF NAME * SHOULD ONLY BE REFERENCED VIA POINTERS LST1 THRU LST5, * USING SUBROUTINES LSTI AND LSTP. * ************************************************************************ * RTMLD CLA,INA STA LNKDR LINK DIRECTION FLAG STA LDGEN LOADER MAIN CONTROL CALLING JSB LGUNT GET LOGICAL UNIT NUMBERS LDB ONMSG PRINT MESSAGE JSB DIAG2 "LOADER STARTED" CLA SET TO ANY MODULE TYPE ALLOWED JSB PRCMD PROCESS LOADER COMMANDS JMP ABRT1 PROGRAM TERMINATION RTML2 LDA LOCC EzSZA,RSS IF NO MODULES RELOCATED, JMP RTML1 PROGRAM TERMINATION LDA B2 STA ABRC1 STORE ADDRESS OF TIE-OFF RECORDS DLD PNAME GET PROGRAM NAME JSB TYOFF OUTPUT CHARS 1,2,3,4 OF NAME LDA PNAME+2 AND UPCM IOR PRAMS CHAR 5,TYPE LDB PRAMS+1 GET PRIORITY JSB TYOFF LDA PRAMS+2 RAR,RAR RES. CODE RAR IOR PRAMS+3 CLB SPARE JSB TYOFF JSB TIMES PROCESS TIME PARAMETERS JSB TYOFF OUTPUT TIME PARAMETERS CLA SPARE LDB .MEM4 LWAM JSB TYOFF OUTPUT SPARES LDA FWAM GET LOW MAIN LDB LOCC GET HIGH MAIN JSB TYOFF OUTPUT LDA FWABP GET LOW BASE PAGE LDB BPLOC GET HIGH BASE PAGE JSB TYOFF OUTPUT LOW & HIGH BASE PAGE LDA FWAC LDB COML JSB TYOFF LDB DBTAD GET DEBUG TRANSFER ADDRESS LDA SCP LOAD WITH DEBUG? AND B10 SZA,RSS LDB ?XFER NO, USE PROGRAM XFER ADDRESS LDA JMP3 JSB TYOFF JSB CLFL2 CLOSE ABSOLUTE OUTPUT FILE LDB EDREL PRINT MESSAGE JSB DIAG "RELOCATION FINISHED" LDA FWAM GET # OF PAGES USED FOR RELOCATION CMA ADA LOCC AND B76K ALF RAL,RAL ADA B2 STA NUMB JSB KCVT DEF *+2 DEF NUMB STA PAGES,I LDA CONSO SZA,RSS JMP RTMLB DON'T PRINT # PAGES LDA P19 LDB PAGE JSB PRINT RTMLB LDA P19 LDB PAGE JSB MAPS LDB SNAP PRINT MESSAGE JSB DIAG "INPUT SNAP REQUEST" JSB PRCMD PROCESS SNAP REQUEST JMP ABRT1 PROGRAM TERMINATION LDA B2 STA SCP SET FOR SEGMENT LOAD LDB SEGRL REL SEGMENT JSB DIAG JSB INIT2 INITIALIZE FOR SEGMENT LOAD JSB PRCMD GO RELOCATE IT JMP ABRTcB 1 PROGRAM TERMINATION LDA LOCC ANY RELOCATION SZA JMP RTML2 YES, GO OUTPUT TY-OFF RECORDS RTML1 LDB OFMSG PRINT MESSAGE JSB DIAG2 "LOADER FINISHED" JMP EXEC6 PROGRAM TERMINATION SPC 1 JMP3 JMP 3,I PNAMA DEF PNAME PNAME REP 3 PROGRAM NAME NOP BSS 3 MODULE LENGTHS FOR MAIN PRAMS DEC 3 DEFAULT TYPE DEC 9999 DEFAULT PRIORITY REP 6 DEFAULT OTHER PARAMS NOP SPC 2 SEGRL DEF *+1 DEC 13 ASC 7,* REL SEGMENT NUMB NOP ONMSG DEF *+1 DEC 16 ASC 8,* LOADER STARTED EDREL DEF *+1 DEC 21 ASC 11,* RELOCATION FINISHED OFMSG DEF *+1 DEC 17 ASC 9,* LOADER FINISHED PAGE DEF *+2 PAGES DEF *+2 ASC 1,* BSS 1 ASC 8, PAGES REQUIRED SNAP DEF *+1 DEC 11 ASC 6,* SNAPSHOT? B2 OCT 2 B10 OCT 10 B76K OCT 76000 P19 DEC 19 UPCM OCT 77400 * SPC 2 END RTMLD    92064-18122 1805 S C0622 &RTMLO LOADER SUBCONTROL             H0106 ASMB,R,L,C ** RTE-M LOADER SUBORDINATE CONTROL * * ************************************************************************ * * RTE-M LOADER SUBORDINATE CONTROL * MIKE SCHOENDORF * OCTOBER 25,1976 * * SOURCE: 92064-18122 * RELOCATEABLE: 92064-16024 * ******************************************************************** * HED RTM RELOCATION SUBORDINATE CONTROL NAM RTRLC,7 92064-16024 REV. 1805 771212 * * ENTRY POINT NAMES * ENT ABRC1,ABRT1,ADDRS,BPAGA,BPLOC ENT CLBPL,CLFL2,COML,CONSO,CRTIN,DBTAD ENT DCB2,DIAG,DIAG2,EKHOS,ENTI,ENTPT,ERROR ENT EXEC6,FIXUP,FUT1,FUT4,FUTI ENT FUTS,FWABP,FWAC,FWAM,INACT,INIT2,KONSO ENT LDGEN,LENGT,LGUNT,LNKDR,LOCC,LST ENT LSTUL,LST1,LST4,LST5,MAPS,.MEM1 ENT .MEM2,.MEM3,.MEM4,.MEM5,.MEM6 ENT OPT.3,PLK,PLK4,PLKS,PRCMD ENT PRINT,RDFL1,SCP,SSTBL,TIMES,TYOFF ENT TYPRO,UEXFL,UNDEF,?XFER,ZPRIV,ZRENT * * EXTERNAL REFERENCE NAMES * EXT PNAME,PNAMA,PRAMS EXT $CON,PARSE EXT CLOSE,CREAT,IFTTY,EXEC,FCONT,IMESS EXT LIMEM,LOCF,OPEN,POSNT,READF,WRITF EXT IDCB1,IDCB2,IDCB3,IDCB4,IDCB5,IDCB6,IDCB7 EXT CNUMD,DCMC * A EQU 0 B EQU 1 SUP ************************************************************************ * * THESE ROUTINES ARE USED BOTH IN THE RTM LOADER ITSELF AND IN * THE RTM GENERATOR RTMGN. THESE ROUTINES,CALLED A SUBORDINATE * CONTROL MODULE, COMPRISE A COMMAND PROCESSOR FOR LOADER COMMANDS. * THIS MODULE IS CALLED AS IF IT WERE A SUBROUTINE WITH NO * PARAMETERS AND TWO RETURNS. THE (P+1) RETURN IS USED FOR ABNORMAL * TERMINATION CONDITIONS, WHILE THE (P+2) RETURN IS USED FOR NORMAL * RETURNS VIA THE END COMMAND.THE CALLING SEQUENCE IS AS FOLLOWS: * * JSB PRCMD * RETURN1 RELOCATION ABORTED RETURN * RETURN2 NORMAL RETURN * ******************************************************************** l HED RTM LOADER UTILITY SUBROUTINES ***** * ** BLINE ** BLANK OUT THE PRINT LINE BUFFER (LBUF) * CALLING SEQUENCE: * * JSB BLINE * RETURN * ***** BLINE NOP LDA LBUFA STA BELIN LDA MD60 LDB BLANK STB BELIN,I ISZ BELIN INA,SZA JMP *-3 JMP BLINE,I * BELIN NOP MD60 DEC -60 SPC 5 SKP * ***** * ** DELIM ** ADVANCE POINTERS TO ASCII INPUT BUFFER PAST NEXT * DELIMITER. ACCEPTABLE DELIMITERS ARE A COMMA, ONE OR * MORE BLANKS, OR A COMMA EMBEDDED IN BLANKS. * CALLING SEQUENCE: * * JSB DELIM * RETURN1 NOTHING BUT BLANKS TO END OF LINE * RETURN2 DELIMITER 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 M2 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 COMMA? 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 * STMP1 NOP COMMA COUNTER 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 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$ To 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 2001 S C0422 &MAS00 RTE-M ASMB MAIN SOURCE             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.2001 791005 * * ********************************************* * * 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. * * {XB@<* 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. * tB 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 RETUaRN - 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 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. * * * * '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 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 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 L 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 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 ELkB 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 ..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 t 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 = ADDRESlS 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 h 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 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 * ****************************** :NLH* * 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? N 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 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 * * ********************************** * * 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 UAN 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 * * ****************************************** 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) 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 J 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 * IY********************************************************************** * 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 LIST PASS? ADA ...1+3 YES, (4) SET UP FOR HEADER ARS CONVERT TO WORDS SZB LIST PASS? ADA HED YES, ADD WORDS IN HEADER STA DSIG SET WORD 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 AS CI 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 *F * * 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 ORG CMA,INA ADA 1 "A" REGISTER _ LAST 'PLCN' VALUE *NLH 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. * ON 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 * ************************** * * 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 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 * * * ********************************************************************** * 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 *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 R BLS 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 SEpQUENCE: 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? FSSA,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 LSTL?U FLAG = 1 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 #+14HFB2B 50 WORDS + 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 PH 8X 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 $ 2 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* ' 3 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 $ ( 3 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 3z 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 7,d 92064-18137 2001 S C0322 &MAS60 RTE-M XREF SEG SOURCE             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.2001 791004 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) * L[ABEL 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=HFBABEL 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. * H 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. 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 :HLINE. 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 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 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 NO8P 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,FI * 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 SNEW 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 L'ITERAL JMP ID0 NO, CONTINUE ID5 LDB ALTRL ASCII LITERAL? SSB JMP ID7 YES, INSERT CHARACTER CPA BLANK NO, BLANK CHARACTER? JMP ID6 YES, EXIT 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 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 Y 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 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 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 ?B@ * 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 INsCLUDE 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 A00 ASC 1,00 CNMBR DEF *+1 ASCI ASC 3, SPC 1 * READS SOURCE FڇROM 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 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 ************************************************************************V* * * * * 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. * * * * 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 DOSO P 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 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 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,5210500.*3,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 {0 :%` 92064-18138 2001 S C0122 &MPF00 RTE-M POWER FAIL SOURCE             H0101 ZASMB,R *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.,J.U.F. * 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.,J.U.F. * BASED ON RTE-III VERSIONS G.A.A.,E.J.W.,D.L.S. * * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS * * * RESERVED. 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.2001 791009 EXT $OPSY XIF IFZ NAM DVP43,0 92064-16029 REV.2001 791009 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 T,O 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) 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 STC 0 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 OTRA 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 = 35 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 .+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 $POWR END w<:6$POWR < ;J 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  < F 92064-18141 2026 S C0122 &MAUTO RTE-M AUTOR SOURCE              H0101 0ASMB,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 1980. ALL RIGHTS * * * RESERVED. 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.2026 800327 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* > 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 YEAR 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 LDA YEAR JSB CNVRT CONVERT YEAR STA YEAR SAVE YEAR * * * * 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 2 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 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 YEAR1 DEC 70 .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  =F 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 ` >F 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 ?E 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  @ J 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 AS 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$  B L 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 C M 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  DK 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 EK 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 FL 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$ & GP 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$ ! - H R 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  IP 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 JP 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$ KQ 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 LU 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]   MT 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  NU 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$ .$"$ O Z 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$  PV 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$  QX 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$  RY 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@ S[ 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 Ut 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\ V\ 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  W] 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 X f 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 / Y_ 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  Z d 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 [d

    LINES JMP CN27C YES * **************ILLEGAL CONTROL REQUEST************* * * JMP REJ2 * B1 OCT 1 B13 OCT 13 B14 OCT 14 B26 OCT 26 B27 OCT 27 B65 OCT 65 B55 OCT 55 B160 OCT 160 B66 OCT 66 B103 OCT 103 ENCE OCT 10004 B300 OCT 300 * ******BACKSPACE 1 OR 2 RECORDS****** * BSR1 NOP BACKSPACE 1 LDB B61 GET ASCII <1> LDA BSR1 JMP OVER1 BSR2 NOP BACKSPACE 2 LDA BSR2 LDB B62 GET ASCII <2> OVER1 STA EQT8,I STORE RETURN ADD. STB EQT9,I SAVE 1 OR 2 LDA B55 SEND ASCII (-) JSB OUT4 LDA EQT9,I RETREIVE BS NUMBER JSB OUT1 LDA B160 SEND JSB OUT1 LDA B70 SEND JMP OUT5 * *********WRITE EOF************* * CN1C LDA B65 WRITE END OF FILE JSB OUT4 OUTPUT JMP OUT3 * ***********FORWARD SPACE RECORD************** * FSR1 NOP LDA FSR1 SAVE RETURN ADD. RSS CN3C CLA STA EQT8,I LDA B3 SET CONTROL REQUEST STA TEMP4 BECAUSE MAY GET HERE FROM READ 0 ADA B300 SET FOR FORWARD RECORD IOR EQT6,I ALSO SET IN CONWD BECAUSE WILL EXIT STA EQT6,I LDA B160 JSB OUT4 CN3C1 LDA B61 OUTPUT JMP OUT5 **********REWIND*************** CN4C JSB CTPRP JMP OUT3 REWIND * **********DYNAMIC STATUS***************** CN6C JSB CTUST GET CTU STATUS STA B LDA TEM11 GET DEVICE TYPE (OCTAL) RAL AND EQT16,I TEST EOF FLAG FOR DEVICE SZA ADB B200 EOF FLAG IS SET. SET IN EQT5 STB TEM8 CLA SET FOR GOOD RETURN STA EQT19,I JMP EOOP3 * * *********LEADER AND TOP OF FORM********** * FOR THIS REQUEST DRIVER WRITES A EOF * * IF IT DID NOT JUST DO SO,OR TAPE IS * * NOT AT LOAD POINT * ***************************************** * CN10C JSB CTUST GET STATUS AND B300 SZA,RSS DID WE JUST WRITE A EOF OR AT LP? JMP CN1C NO! GO WRITE IT JMP EOOP4 YES,DO NOT WRITE TWO IN A ROW * **********FORWARD SPACE 1 FILE ************ * CN13C LDA B62 OUTPUT JSB OUT4 JMP OUT3 * ************BACKSPACE 1 FILE ************* * BSF1 NOP LDA BSF1 STA EQT8,I LDA B55 OUTPUT JSB OUT4 LDA B61 OUTPUT JSB OUT1 LDA B160 OUTPUT JSB OUT1 LDA B62 OUTPUT JMP OUT5 * ********WRITE END OF VALID DATA (EOV) * CN26C LDA B66 OUTPUT JSB OUT4 JMP OUT3 * *******LOCATE ABSOLUTE FILE (CTU)********* *****************OR*********************** *******SPACE LINES (PRINTER)************** * CN28C LDA EQT10,I GET CONTROL REQUEST CPA B11 IS IT T.0.F. OR SPACE LINES? RSS JMP REJ2 ONLY LEGAL CONTROL TO PRINTER IS 11B CN27C JSB CTPRP PREP. TERM. FOR CTU REQUEST LDA EQT7,I GET FILE NO. SZA,RSS IF ZERO CHANGE TO 1 INA JSB BINAS CONVERT TO ASCII AND SEND LDA B160 OUTPUT JSB OUT1 LDB TEM10 GET DEVICE TYPE CPB B64 IS IT LP? RSS YES A LP JMP CN27D LDB EQT7,I GET OPTIONAL PARAM. IF (-) THEN T.O.F. SSB,RSS IF (+) THEN SPACE (EQT7) LINES. JMP CN3C1 GO OUTPUT CN27D LDA B62 OUTPUT * OUT5 JSB OUT1 OUT3 LDA B103 OUTPUT JSB OUT1 JSB NXQU JMP I25W5 GO WAIT FOR REQUEST COMPLETION OUT4 NOP LDB OUT4 SAVE RETURN ADDRESS STB EQT19,I JSB CTPRP JSB OUT1 LDA EQT19,I JMP A,I * *********BACKSPACE FILE AND RECORD******** * * BACKSPACE FILE AND RECORD REQUIRES SPECIAL PROCESSING * * TO POSITION AND SET STATUS AS A MAG. TAPE UNIT. THIS * * SPECIAL PROCESSING ENABLES THE USE OF EXISTING MTU * * SUBROUTINES. IF THE TAPE IS POSITIONED AFTER AN EOF THEN* * IT WILL MOVE BEFORE THE EOF AND A FLAG SET IN EQT16 * * (BIT3/BIT2 =RIGHT CTU/LEFT CTU) WHICH IS EXAMINED BY * * A DYNAMIC STATUS REQUEST. THESE SPECIAL EOF FLAGS ARE * * NECESSARY BECAUSE THE 264X DOES NOT RETURN EOF STATUS * * BEFORE THE EOF MARK. * * *********************************************************** * * * CN50C LDA EQT16,I SET CN50C ENTRY FLAG IOR B10 BIT3 STA EQT16,I LDB RSS SET CN50C FLAG STB EOOP7 JSB BSR1 ISSUE BACKSPACE 1 RECORD JSB CTUST GET STATUS STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB WE ARE THERE LDA TEM8 Ҙ NOT AT L.P. AND B200 IF WE ARE AFTER EOF THE BIT 7 SET SZA,RSS JMP CN54C TAPE NOT AFTER EOF CN55C JSB BSR2 ISSUE BACKSPACE 2 RECORDS JSB CTUST IF AT EOF AGAIN WE ARE AFTER ANOTHER EOF STA TEM8 AND B103 CHECK FOR L.P. SZA JMP EOOPB LDA TEM8 AND B200 AND HENCE NO FORWARD SPACE SZA DO NOT SET EQT16 EOF FLAG IF JMP EOOPB BETWEEN EOF'S JSB FSR1 FORWARD ONE TO GET US BEFORE EOF * * LDA TEM11 GET DEVICE TYPE RAL FOR SETTING EOF FLAG IN EQT16 IOR EQT16,I BIT1/BIT2=EOF LCTU/EOF RCTU AND BN55 REMOVE CN50C FLAG STA EQT16,I RESTORE IT JSB CTUST GET STATUS IOR B200 ADD EOF BIT STA TEM8 JMP EOOPA * * CN54C LDA EQT10,I TAPE NOT AFTER EOF CPA B2 IS THIS A BS RECORD? JMP EOOPB YES JSB FSR1 GET TAPE TO ORIGINAL POSITION JSB CDINT RESET JSB BSF1 BS FILE TO GET US AFTER EOF JSB CDINT RESET JMP CN55C NOW POSITION BEFORE EOF XIF * *** GRAPH NOP LDA ESC FOR 26XX GRAPHICS SEND ESC,*,(SMALL) L JSB OUT1 LDA B52 JSB OUT2 SEND * JSB OUT1 LDA B154 SEND SMALL "L" JSB OUT1 JMP GRAPH,I *** ** DVA RECIV NOP LDB B5 SET CARD UP FOR RECEIVE,CHAR. JSB CDSET CLA JSB ECHO TURN OFF ECHO STC05 STC CARD ENABLE INTERRUPT JMP RECIV,I **************************************************** * SUBROUTINE READS 1 CHARACTER FROM IO CARD* * AND PLACES IT IN A REG. * * BOARD STATUS IS ALSO READ * * TEMP8=DATA * * TEMP9=BOARD STATUS * * **************************************************** * CHRIN NOP STC02 STC CARD PUT CARD IN DATA MODE LIA03 LIA CARD GET DATA WORD STA TEM14 STORE COMPLETE DATA WORD AT TEM14 AND B377 ISOLATE DATA CHAR.(0-7) STA TEMP8 STORE IT CLC02 CLC CARD PUT CARD IN STATUS MODE LIA02 LIA CARD GET STATUS WORD STA TEMP9 STORE IT LDA TEMP8 RESTORE DATA WORD STC03 STC CARD THIS IS NECESSARY JMP CHRIN,I INTERRUPT * * * *********************************************** * SUBROUTINE TRIGGERS BLOCK TRANSFERS * * FROM THE CPU. THIS IS DONE BY SENDING A * * DC1 TO TRIGGER THE TRANSFER AND * * THEN SETTING UP CARD TO RECEIVE DATA. * * SEE WARNING AT ENAK *********************************************** * DC1OT NOP LDA B21 JSB OUT1 LDA D.60 WAIT FOR DC1 TO RIPPLE THRU FIFO JSB TIMER 150 USECS ON XE(SPEC 64 MAX) LDB B4 JSB CDSET SET RECEIVE MODE JMP DC1OT,I RETURN * B5 OCT 5 B154 OCT 154 BN55 OCT 177767 BN20 OCT 50077 B10 OCT 10 BN17 OCT 40040 B400 OCT 400 BN19 OCT 30003 BN21 OCT 50000 D.60 DEC -60 * * * ****************************************************** * SUBROUTINE SETS UP THE IO CARD PER B REG. * * 1/0 IS CHARACTER/BLOCK * * 1/0 IS TRANSMIT/RECEIVE * * 1/0 IS CLEAR/NOT CLEAR INTERUPT FLAGS * * 1/0 SPECIAL CHARACTER IS/IS NOT TO BE * * ADDED OR DELETED.SPECIAL CHARACTER IS IN POSITION * * . 1/0 IS ADD/DELETE * * SPECIAL CHARACTER. * ****************************************************** * CDSET NOP LDA BN4 SET WORD1 IN A REG. SLB,BRS IOR B40 "OR" CHARACTER MODE BIT JSB OUT2 LDA BN17 SET WORD4 IN A REG(SET SBA) SLB,BRS IOR B400 "OR" TRANSMIT BIT JSB OUT2 LDA BN21 SET WORD5 IN A REG. SLB,BRS IOR 3B177 "OR" CLEAR INTERRUPTS JSB OUT2 LDA BN5 SET WORD6 IN A REG. SLB,RSS JMP OUT BRS,BRS BRS IOR B "OR" SPECIAL CHARACTER JSB OUT2 OUT JMP CDSET,I * * * ECHO NOP SET ECHO ON CARD PER A REG. IOR BN19 A =20/0 IS ECHO ON\OFF JSB OUT2 JMP ECHO,I * *************************************************** * SUBROUTINE INITIALIZES 12966 * * IO CARD. * * BELOW ARE THE INITIAL CONDITIONS FOR CONTROL: * * WORD 0 DO NOT SEND * * WORD 1 DO NOT SEND * * WORD 2 CE=1 STATUS REF. IS 0 * * WORD 3 CHARACTER FRAME CONTROL * * CHAR. SIZE=8 BITS * * NO PARITY * * ECHO ON (CRT REQUEST ONLY) * * ONE STOP BIT * * * WORD 4 INTERFACE CONTROL * * EXT. CLOCK * * DMA CONTROL OFF * * SBA/SCA ON * * CD (DATA TERM. READY) OFF * *N CA (REQUEST TO SEND) OFF * * TRANSMIT MODE ON * * MASTER RESET * MASTER RESET * * WORD 5 CLEAR CARD INTERRUPTS * * * WORD 6 SPECIAL CHARACTER * * * * ALL USED SPECIAL CHARACTERS (EXCEPT * * RUBOUT) ARE CLEARD * * * *************************************************** * * CDINT NOP * LDA BN19 SET A REG. = 30003 LDB TEM10 GET DEVICE TYPE ADB TEMP4 ADD REQEST TYPE CPB B61 IS IT A CRT READ IOR B20 t YES! TURN ON ECHO JSB OUT2 IT IS OFF FOR CTU AND LP * LDA BN17 IOR BN72 OR MASTER RESET AND XMIT JSB OUT2 SEND WORD 140XXX * LDA BN20 SEND WORD 50077 JSB OUT2 * LDA BN22 JSB OUT2 SEND 20004 * LDA BN25 SET A REG. = 60004 JSB OUT2 CPA BN26 CLEAR ALL USED SPECIAL INTERRUPTS JMP CDINT,I (4 THRU 36) INA JMP *-4 * * BN22 OCT 20004 B61 OCT 61 BN72 OCT 100400 BN25 OCT 60004 BN26 OCT 60036 BN27 OCT 177577 ESC OCT 33 B136 OCT 136 B.4 OCT 177774 * * FOR ALL WRITE REQUESTS AND CTU CONTROL * THE BUFFER FLUSH BIT IS EXAMINED.IF SET ************************************************** * IS CALLED BY ALL WRITE AND CONTROL * * REQUESTS IF THE BUFFER FLUSH BIT IS SET. * ************************************************** * * NXQU NOP IF LAST REQUEST IN QUE THEN STOP FLUSH LDA $OPSY GET SYSTEM TYPE CPA BN55 CHECK FOR -9 RSS CPA D.13 CHECK FOR -13 JMP GTDMS THIS IS A DMS SYSTEM * OLDSY LDA EQT1,I CHECK FOR LAST REQUEST LDA A,I CHECK SZA IF NOT LAST REQUEST DO NOT CLR BIT7. JMP NXQU,I THIS IS NOT THE LAST REQUEST. LDA EQT28,I LAST REQUEST AND BN27 REMOVE B177 STA EQT28,I RESTORE EQT5 JMP NXQU,I AND RETURN * GTDMS RSA CHECK MAP. IF SYSTEM NO CROSS LOAD ALF,SLA BIT12= 0\1 =SYSTEM\USER RSS JMP OLDSY SYSTEM MAP XLA EQT1,I USER MAP CROSS LOAD XLA A,I JMP CHECK * * ********************************************* * SUBROUTINE READS TERMINAL STATUS * * AND SETS EQT16 FOR : * * LINE STRAP\PAGE STRAP 0\1 (BIT15) * * TERM. STATUS READ 0\1 NO\YES (BIT 0) * * !FIX HERE MADE 1926! * ********************************************* * TERST 1NOP LDA TERST STORE RETURN ADD. (REV 1926) STA EQT27,I LDA EQT16,I GET TERMINAL STATUS TO SEE IF IT SLA HAS ALREADY BEEN READ JMP TERST,I IT HAS. RETURN. CLA JSB ECHO TURN ECHO OFF JSB SPCH1 SET SPECIAL INTERRUPTS LDA ESC OUTPUT ESCAPE JSB OUT1 LDA B136 OUTPUT CARROT. THESE TWO CHARACTERS JSB OUT1 PREP. TERM. FOR STATUS JSB EXIT1 EXIT AND WAIT FOR BUFFER EMPTY INTERRUPT * JSB DC1OT GO TRIGGER STATUS TRANSMISSION WITH DC1 JSB EXIT1 AND WAIT FOR CR OR RS INTERRUPT * LDA B20 JSB ECHO TURN ECHO ON LDA B.4 SET TO GET BYTE 1 STA TEMP1 JSB CHRIN GO GET CHAR..IT IS NECESARY TO READ AND B10 ISZ TEMP1 ESC AND \ BEFORE JMP *-3 READING DESIRED STATUS BYTE. RAR,RAR RAR,RAR MOVE TO SIGN POS. (LINE\PAGE =0\1) INA SET LSB FOR COMPLETED IOR EQT16,I STA EQT16,I JSB CLRCD GO CLEAR CARD LDA EQT27,I GET RETURN ADD. JMP A,I * * ************************************************* * SUBROUTINE OUTPUTS AN ENK TO TERMINAL * * AND WAITS FOR AN ACK. * * BE CAREFUL IN CALLING ENAK BECAUSE YOU MUST * * DO A MASTER RESET TO GET CHAR. COUNT =0 * * OTHERWISE YOU WILL NEVER SEE A BUFFER * * EMPTY INTERRUPT AGAIN!!! * * THIS CODE CHANGED 1913 * ************************************************* * ENAK NOP CLA INHIBIT ECHO JSB ECHO LDA ENAK STA EQT23,I SAVE RETURN ADDRESS LDA CLRSB INHIBIT TERM. TRANSMISSON JSB OUT2 LDA B5 OUTPUT ENK TO TERMINAL OTA20 OTA CARD LDA D.60 JSB TIMER LDB B5 CLEAR INTERRUPTS AND SET CARD TO RECEIVE JSB CDSET *1913,TER. CAN'T SEND TILL CARD INj REC. JSB EXIT1 EXIT TO WAIT FOR INTERRUPTS JSB CHRIN GET CHARACTER TO EMPTY CARD * LDA EQT23,I GET RETURN ADDRESS JMP A,I RETURN * CLRSB OCT 40400 !! * TIMER NOP 2.5 USEC TIMER(XE) PER LOOP SSA,INA,RSS ! JMP TIMER,I JMP *-2 * IFZ * ************************************************ * SUBROUTINE READS THE CTU STATUS * * * *SET BIT0--UNIT BUSY OR CARTRIDGE NOT INSERTED* * BIT1--END OF VALID DATA * * BIT2--CARTRIDGE NOT WRITE ENABLED * *-------------- * BIT3--LAST COMMAND ABORTED * * BIT4--READ\WRITE ERROR * * BIT5--END OF TAPE * * ----------- * BIT6--LOAD POINT * * BIT7--END OF FILE * * * * THE CTU STATUS COMES IN THREE BYTES * * * BYTE * 1 EOF - LP - EOT - WR. ERR(2645) * 2 CMD.AB.- W.P. - RD.ERR. -BUSY(2645) * 3 RD.ERR. - RD.ERR.(HARD) - EOD -C.I. ************************************************ * CTUST NOP JSB CDINT !!!!!!!!!!!!!!! LDA CTUST STA EQT24,I * JSB CTPRP GO PREP. TERMINAL FOR CTU TRANSFER LDA B136 OUTPUT <^> JSB OUT1 JSB EXIT1 !!!!!!!!!!!!!!!!! JSB SPCH1 SET CR AND RS AS SPECIAL CHAR. JSB DC1OT TRIGGER TRANSFER WITH DC1 JSB EXIT1 EXIT WAITING FOR CR OR RS INTERRUPT * JSB CHRIN GET DATA CTUS3 LDB B.5 INITIALIZE STATUS COUNT STB TEMP1 RSS * * CTUS1 JSB CHRIN GET CHARACTER ISZ TEMP1 ARE THESE STATUS BYTES? JMP CTUS1 NO! GO GET NEXT CHAR. AND B17 ALF STA TEMP1 JSB CHRIN GET STATUS BYTE NO. 2 AND CR ISOLATE BITS 0,2,3  IOR TEMP1 "OR" BYTE 1 WITH BYTE 2 STA TEMP1 STORE IT TEMPORARILY JSB CHRIN GET BYTE 3 AND B4 CHECK FOR READ ERROR RAL,RAL MOVE TO BIT 4 IOR TEMP1 STA B LDA TEMP8 GET BYTE 3 AND B3 ISOLATE FIRST TWO BITS (WEN AND EOV) XOR B1 COMPL. C.I. IOR B OR WITH BYTES 1 AND2 XOR B10 COMPLEMENT BIT 3 AND B377 ISOLATE STATUS BITS STA TEMP1 JSB CDINT LDA TEMP1 * JSB CLRCD GO CLEAR CARD LDB EQT24,I SAVE RETURN ADDRESS JMP B,I * CTPRP NOP THIS SUBROUTINE PREPARES TERMINAL TO ACCEPT LDB CTPRP SAVE RETURN ADDRESS STB EQT25,I STA EQT22,I CTU CONTROL AND R\W REQUESTS LDA EQT16,I CHECK FOR KEYBOARD DISABLE BIT AND B20 (BIT4) SZA IF SET ALREADY DISABLED JMP OVER6 LDA ESC JSB OUT1 LDA B143 (SMALL "C") JSB OUT1 CLA JSB OUT1 CLA JSB OUT1 LDA B20 IOR EQT16,I SET KEYBOARD DISABLE BIT STA EQT16,I JSB EXIT1 JSB CDINT OVER6 LDA ESC JSB OUT1 OUTPUT LDA B46 JSB OUT1 OUTPUT <&> LDA B160 JSB OUT1 OUTPUT LDA TEM10 GET DEVICE JSB OUT1 LDA B165 LDB TEMP4 GET REQUEST TYPE CPB B3 IS IT CONTROL? JSB OUT1 YES, SEND LDA EQT22,I RESTORE A REG LDB EQT25,I GET RETURN ADDRESS JMP B,I * * * * * ************************************************ *SUBROUTIONE TAKES A NO. IN A REG. * * (<1000D) AND CONVERTS TO ASCII WITH MSB * * AT BUFF1 AND LSB AT BUFF3. * *THE CHARACTERS ARE SENT MSB FIRST * ************************************************ * BINAS NOP LDB BINAS SAVE RETURN ADDRESS STB EQT22,I SSB@999 LDB ADDRT GET BUFFER ENDING ADDRESS ADB B2 ADD 2 STB TEMP1 STORE IT AT TEMP1 BINA1 CLB DIV LF DIVIDE NO. IN A REG. BY 10 ADB B60 CONVERT TO ASCII STB TEMP1,I STORE IT. LDB TEMP1 GET NEXT ADDRESS ADB B.1 DECREMENT IT STB TEMP1 RESTORE IT SZA IS THE A REG.(QUOTIENT) =0 ? JMP BINA1 NO! GO DIVIDE A REG. AGAIN LDA ADDRT YES! IT IS ZERO ADA B.1 CPA TEMP1 ARE WE FINISHED? JMP BINA2 YES!NOW GO OUPUT CHAR. CLA NO,GO FILL REMAINING PLACES WITH JMP BINA1 ASCII <0> BINA2 LDB ADDRT GET MSD IN B REG. STB EQT19,I STORE IT FOR LATER USE LDA B.3 SETUP COUNTER STA EQT20,I I25W8 LDA B,I GET ASCII CHAR. IN A REG. JSB OUT1 GO SEND IT! ISZ EQT19,I INCREMENT ADDRESS POINTER LDB EQT19,I RESTORE IN B REG. FOR ISZ EQT20,I ISZ COUNT COUNTER JMP I25W8 THERE ARE MORE,GO GET 'EM LDA EQT22,I GET RETURN ADDRESS JMP A,I * XIF * bhB*^^^^^^ FIRST LINE OF TAPE 4 ^^^^** ADDRT DEF BUFF1 BUFF1 BSS 3 B.5 OCT 177773 B46 OCT 46 B165 OCT 165 B143 OCT 143 * * BN11 OCT 43612 BN12 OCT 41512 * TEMP4 NOP REQUEST TYPE (1-3) TEMP5 NOP INIT\COMP. = 0\1 TEM8 NOP TEMP STATUS TEM10 NOP ASCII TYPE (6X) TEM11 NOP DEVICE TYPE IN BINARY * XMIT NOP SET CARD UP FOR XMIT LDA BN17 IOR B400 SET XMIT JSB OUT2 JMP XMIT,I * OUT1 NOP STA B JSB XMIT SET FOR TRANSMIT LDA B OTA02 OTA CARD SEND CHAR. JMP OUT1,I * OUT2 NOP GENERAL PURPOSE CARD PROGRAMMING OTA10 OTA CARD ROUTINE JMP OUT2,I * SPCH1 NOP THIS SUBROUTINE SETS SPECIAL CHAR. INTERRUPTS LDB BN12 JSB CDSET SET INTERRUPT LDB BN11 JSB CDSET SET INTERRUPTS JMP SPCH1,I RETURN * * USINT NOP SUBROUTINE TO TEST FOR USER KEYBOARD INTERRUPT LDA USINT SAVE RETURN ADDRESS STA EQT27,I JSB ENAK GO SHAKE HANDS WITH TERMINAL LDA TEMP8 GET CHAR. CPA B6 IS IT A "ACK" ? RSS JSB SCHED USER INTERRUPT JSB CLRCD GET ALL CHAR. OFF CARD LDA EQT27,I JMP A,I * *********************************************** * SUBROUTINE GETS DATA OF CARD UNTIL * * BUFFER EMPTY. * * *********************************************** * CLRCD NOP STA TEMP1 SAVE A REG. LDB B4 SET CARD TO RECEIVE AND CLR. INT. JSB CDSET CLRC1 JSB CHRIN GET CHARACTER LDA TEMP9 GET STATUS WORD ALF,ALF ISOLATE BUFFER EMPTY SSA IS IT EMPTY? JMP CLRC2 YES WE'RE FINISHED LDA TEM14 IS THIS A VALID CHARACTER? SSA JMP CLRC1 YES IT IS CLRC2 LDA TEMP1 RESTORE A REG. JMP CLRCD,I RETURN * B.1 OCT 177777 BNX50 DEC -1000 * *********************************************** * ENABLES IO CARD INTERRUPT IF TERM. * * HAS BEEN ENABLED OR IF TERMINAL IS A * * SYSTEM CONSOLE. * *********************************************** * SETEM NOP SUBROUTINE TO SETUP IO CARD FOR RECEIVE CLC03 CLC CARD INHIBIT INTERRUPT LDA EQT28,I MODE PRIOR TO EXIT. GET TERM.STATUS RAR,SLA IS TERMINAL ENABLED? (BIT 1=1) JSB RECIV YES! IT IS LDA SYSTY GET CONSOLE EQT. CPA EQT1 IS THIS THE SYSTEM CONSOLE? JSB RECIV YES! IT IS JMP SETEM,I * *********************************************** * * * EXIT IS A=2 (ILLEGAL CONTROL REQUEST). * *********************************************** * * REJ2 JSB NXQU CHECK QUE JSB SETEM SETUP CARD FOR EXIT LDA B2 RSS REJ1 CLA,INA RSS REJ4 LDA B4 IMMEDIATE COMPLETION CLB JMP I.05,I * **************************************************** * IS USED FOR INITIATOR OPERATION WITH * * INITIATED EXITS (A=0), AND COMPLETION * * CONTINUATION EXITS (P+2). "TEMP5" INDICATES * * WHICH EXIT TO TAKE. * **************************************************** * EXIT1 NOP LDB EXIT1 GET CALLING PROGRAMS ADDRESS+1 STB EQT11,I STORE AT EQT11,I FOR INTERRUPT EXIT5 LDA BN20 CLEAR CARD INTERRUPTS JSB OUT2 STC04 STC CARD RE-INITIALIZE CARD FOR INTERRUPT LDB TEM10 CHECK FOR CRT CPB B60 JMP ON3 IT IS A CRT LDA BN68 NOT A CRT SET 60 SEC T.O. JMP ON2 ON3 LDA TIM1 IF READ USE PRESET T.O. LDB TEMP4 CHECK REQUEST TYPE CPB B2 IF A WRITE SET 4 SEC. T.0. ON2 STA EQT15,I EXIT4 CLA EXIT6 LDB TEMP5 GET INITIATION COMPLETION FLAG SZB,RSS JMP I.05,I INITIATION RETURN ISZ C.05 RETURN JMP C.05,I COMPLETION RETURN * EOOP9 LDB B3 SET B=3 FOR XMISSION ERROR STB EQT19,I A REG. EXIT JMP EOOP4 * ********************************************************* * DOES ASCII CTU AND DISPLAY WRITE EOR PROCESSING* ********************************************************* * * EORP NOP LDA CR OUTPUT A JSB OUT1 LDA LF OUTPUT A JSB OUT1 JMP EORP,I * IFZ * ******************************************** * ENABLES KEYBOARD IF IT HAS BEEN * * LOCKED BY A CTU REQUEST * ******************************************** * KEYBD NOP LDA EQT16,I AND B20 IS IT LOCKED (BIT 4) SET SZA,RSS JMP KEYBD,I NO! LDA ESC UNLOCK KEYBOARD JSB OUT1 LDA B142 JSB OUT1 SEND SMALL B JSB EXIT1 WAIT FOR INTERRUPT JSB CDINT LDA EQT16,I AND BN3 REMOVE KEYBD LOCK BIT STA EQT16,I JMP KEYBD,I * EOOP7 NOP IF CN50C FLAG IS SET(BIT3,EQT16) JMP EOOPC THEN EOOP7 IS LDA EQT8,I IT IS SET JMP A,I * XIF EOOP8 LDB TEMP1 THIS EXIT IS USED IF UNDERSCORE CPB BN2 IS ONLY CHAR. RSS * ********************************************************* * AND ARE ENTRIES FOR COMPLETION (P+1) * * EXITS. THE TERMINAL OR CTU STATUS IS TEMPORARLY PUT * * IN TEMP5. * ********************************************************* * EOOP1 JSB EXIT1 EOOP2 CLA STA EQT19,I SET A REG. EXIT LDA EQT28,I GET TERMINAL STATUS STA TEM8 JMP EOOP3 * EOOPC LDB TEMP4 IF CONTROL ALWAYS GET STATUS IFZ CPB B3 RSS SZA IF GOOD WRITE DO NOT GET STATUS EOOP5 JSB CTUST YES!,GO UPDATE CTU STATUS ** EOOP6 STA TEM83 ** * EOOPB LDA BN55 REMOVE EOF FLAG IN EQT16 LDB TEM11 BECAUSE TAPE HAS MOVED RBL XOR B LDB EQT16,I AND B STA EQT16,I LDA TEM8 * ****************************************************** * A READ TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 0 GOOD READ * * 40 END OF TAPE. GOOD RECORD READ * * 240 EOT+EOF. NO RECORD READ, * * SET FOR NR(A=1) EXIT * * 42 EOT+EOV * * 52 EOT+EOV+ABORT * * 52 EOT+EOV+ABORT * * * ****************************************************** * * ****************************************************** * A WRITE TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 42 EOT+EOV GOOD RECORD WRITTEN * * 52 EOT+EOV+ABORT (NO RECORD WRITTEN)* * SET ET(A=1) EXIT * * * ****************************************************** * ****************************************************** * READ TO EOV IN MIDDLE OF TAPE * * STATUS * * 200 EOF * * 2 EOV * * 12 EOV+ABORT * * SET NR(A=1) EXIT * * * * ****************************************************** * EOOPA AND B373 REMOVE WRITE PROTECT CPA B240 IF EOF+EOT THEN SET NR JMP OVER4 CPA B52 IF FAILURE ON WRITE JMP OVER4 DUE TO EOT DO THIS_(SAVE REQ.) AND B10 CHECK FOR CMD ABORT CPA B10 JMP OVER4 SET N.R. CLB STB EQT19,I SET A=0 FOR GOOD EXIT JMP EOOP3 OVER4 CLB,INB SET NR STB EQT19,I SET A REG. EXIT *********************************************************** XIF * IS ENTRY FOR B=0 (TRANS. LOG =0) EXIT. * *********************************************************** * EOOP4 CLA STA EQT8,I SET UP FOR B REG. =0 EXIT * ********************************************************** * SETS 2640\2644 AND IO CARD FOR NEXT INTERRUPT * * OR REQUEST, AND SETS EITHER CTU OR CRT STATUS IN EQT5 * * * IT ALSO SETS THE TRANSMISSION LOG IN B REG. (+CHAR. OR * * + WORDS). IF EQT8 =0 (VIA EOOP4) THEN B=0. * ********************************************************** * EOOP3 JSB STPUT SET STATUS IN EQT5,I JSB CDINT !!!!!!!!!! IFZ JSB KEYBD ENABLE KEYBD IF LOCKED XIF JSB USINT WITH KEYBOARD ENABLED JSB USINT JSB CLRNT CLR RUBOUT INTERRUPT JSB CLRCD GET ALL DATA OFF CARD JSB SETEM ** DVA LDB EQT9,I GET 2X LAST CHAR. ADDRESS CMB,INB MAKE NEG. ADB EQT7,I SUBTRACT TWO TIMES STARTING ADD. ADB EQT7,I CMB,INB LDA EQT8,I IF WORDS THEN DIV. BY 2 SSA JMP *+4 THESE ARE CHARACTERS SLB IS LSB SET? INB YES! INCREMENT SO EVEN FOR DIVIDE BRS DIVIDE TO CONVERT TO WORDS * SZA,RSS IF EQT8 IS 0 THEN CLEAR B REG. CLB LDA EQT19,I SET A REG. EXIT JMP C.05,I ** * * **************************************************** * INSERTS CORRECT DEVICE STATUS INTO EQT5 * **************************************************** STPUT NOP LDA EQT5,I GET CURRENT STATUS AND BN31 RE MOVE OLD STATUS IOR TEM8 OR NEW STATU^S STA EQT5,I RESTORE IT JMP STPUT,I * * * TIM1 OCT 177200 BN3 OCT 177757 BN37 OCT 102100 B373 OCT 373 B142 OCT 142 B240 OCT 240 B64 OCT 64 B3 OCT 3 BN31 OCT 177400 B1100 OCT 1100 B4000 OCT 4000 B2000 OCT 2000 B52 OCT 52 D.13 DEC -13 B600 OCT 600 B500 OCT 500 ********************************************************** * CONFIGURES IO INSTRUCTIONS TO SELECT CODE SET * * IN A REG. * ********************************************************** * SETIO NOP IOR BN37 CONSTRUCT STF STA STF01 STF IS 1021XX * IOR B400 CONSTRUCT LIA AND SAVE STA LIA01 STA LIA02 STA LIA03 * XOR B600 CONSTRUCT SFS STA SFS01 SFS IS 1023XX * * * XOR B500 CONSTRUCT OTA AND SAVE STA OTA10 STA OTA02 STA OTA18 STA OTA20 IOR B1100 STA STC02 STA STC03 STA STC04 STA STC05 * IOR B4000 CONSTRUCT CLC,C AND SAVE STA CLC01 CLC,C IS 1077XX STA CLC02 STA CLC03 * * * * * * * * LDA EQT4,I GET SUBCHANNEL AND STORE IN TEM11 LSR 6 SC=0 IS CRT (TEM10=60) AND B37 SC=1 IS L CTU )(TEM10=61) STA TEM11 SC =2 IS R CTU (TEM10 =62) *** SC =3 IS GRAPHICS (TEM10=60) CPA B3 IF GRAPHICS CRT CLR TEM11 CLA SO TEM10 =B60 ADA B60 STA TEM10 LDA EQT6,I GET CONTROL WORD IFZ LDB TEM10 GET DEVICE CPB B64 IS IT LP? CLA YES! SET FOR ASCII XIF RAR BIT6 1\0 IS BIN\ASCII AND B40 ISOLATE BIT 5 XOR B40 REMOVE BIT 5 IF BINARY STA FILL SET FILL CHARACTER LDA EQT6,I GET WORD AGAIN TO SET HONEST WORD AND B2000 HONEST IS BIT 10 =1 STA TEMP2 * ** o}DVA * IFZ ** LDA TEM10 CLB CPA B60 SET SWITCH CRT/CTU = RSS/NOP LDB RSS STB SWH1A STB SWH1B STB SWH1C STB SWH1D * XIF * **************************************************** * SETUP EXTENSIONS ON EQT * * * * EQT NO. USE * * 1-8 STANDARD * * 9 RUNNING CHAR. ADDRESS * * 10 LAST CHAR. ADDRESS * * 11 ADDRESS TO GO ON INTERRUPT * * 12 NO. OF EQT EXTENSIONS * * AND CURRENT CONWD * 13 EQT EXTENSION STARTING ADD. * * 14-15 STD * * 16 TERMINAL STRAPPING AND CTU INFO* * BIT 14 IS 0\1 =CHAR.\BLOCK * * BIT 15 IS 0\1 =LINE\PAGE * ** DVA * BIT 5-8 IS BAUD RATE * BIT 9 IS PARITY EVEN\ODD 1\0 * * BIT 10 IS PARITY ON\OFF 1\0 * * BIT 11 IS "CD" (DTR) SET * BIT 12 IS "CA" (RTS) SET * BIT 13 IS LINE 0\1 HARD\MODEM * BIT 4 IS KEYBOARD LOCKED * * BIT 3 IS CNC50 FLAG * BIT 2 IS RCTU EOF FLAG * BIT 1 IS LCTU EOF FLAG * BIT 0 IS TERMINAL STRAPPING * * ALREADY READ. * * 17 ID ADDRESS OF TERM. PROG. * * 18 NOT USED G * * 19 RETURN ADDRESS * * AND A REG. EXIT * 20 BINARY RECORD LENTGH * * AND PARITY ERR XLOG * * AND $UPIO ENTRY * 21 NOT USED * * 22 H RETURN ADDRES* * 23 RETURN ADDRESS * * 24 RETURN ADDRESS * * LINE CONTROL REF.(MODEM) * * 25 RETURN ADDRESS * * AND LINE CONTROL FLAG * * 26 NOT USED * * 27 RETURN ADDRESS * * 28 TERMINAL STATUS * * BIT 1 TERMINAL ENABLED * BIT 3 PARITY ERROR * BIT 5 CNTRL D ENTERED * BIT 7 BUFFER FLUSH IN PROGRESS * **************************************************** * * SETIP LDA EQT13,I GET STARTING ADDRESS OF EXT. LDB D.13 STB TEMP1 STORE NO. OF EXT. AT TEMP1 LDB ADR16 GET ADD. OF EQT16 STA B,I STORE S.A. OF EXT. IN IT INA INB ISZ TEMP1 JMP *-4 * * * ** DVA * IFZ SEP1 CLB * * * LDA EQT16,I STORE A AT EOOP7 IF CN50C AND B10 FLAG IS SET SZA LDB RSS STB EOOP7 * XIF LDA EQT6,I GET CONTROL WORD AND B3 STA TEMP4 STORE REQUEST TYPE AT TEMP4 CPA B3 IS THIS CONTROL? JMP OVER7 YES RAR SSA IS THIS A WRITE? JMP OVER2 NO! *** *** LDB EQT28,I IF WRITE AND BUFFER FLUSH SET BLF,BLF THEN EXIT VIA REJ2 SSB JMP OVER8 JMP OVER2 OVER7 LDA EQT6,I LSR 6 IF CONTROL TYPE 0 AND B37 THEN SPECIAL PROCESSING REQUIRED SZA,RSS AT JMP OVER3 * * OVER2 LDA EQT6,I NORMAL NON CNTL 0 REQ. STA EQT12,I STORE CURRENT CONWD FOR SYS. INTERRUPT JMP SETIO,I * * BUFFER FLUSH EXITS * OVER8 LDA TEMP5 GET I.05/C.05 FLAG SZA JMP OVER2 C.05 EXIT JMP REJ2 * *  SPECIAL "CONTROL 0" PROCESSING * OVER3 LDA EQT6,I IS THIS A SYSTEM REQ.? SSA,RSS JMP SETIO,I * LDA EQT12,I GET OLD CONWD STA EQT6,I PUT IN CURRENT CONWD AND B2 IF WRITE MUST COMPLETE XFER CPA B2 OR TERMINAL WILL HANG JMP OVER9 LDA EQT9,I NO MORE DATA IN USERS BUFFER! STA EQT10,I IT IS GONE!!! OVER9 LDA TEM11 IF NON CRT REQ. WE MUST COMPLETE SZA JMP EXIT4 CONTINUE NOT CRT REQ. * JSB CLRCD GET ALL OFF CARD IFZ JSB KEYBD ENABLE KEYBOARD IF LOCKED XIF LDA EQT6,I RAR SLA,RSS IF WRITE OR CONT. THEN SEND NULL JMP REJ2 THIS IS A CRT READ CLA SEND NULL TO ALLOW CHAR. OUT OF UART JSB OUT2 JMP EOOP1 ADR16 DEF EQT16 EQT16 NOP 1 EQT17 NOP 1 EQT18 NOP 1 EQT19 NOP 1 EQT20 NOP 1 EQT21 NOP 1 EQT22 NOP 1 EQT23 NOP 1 EQT24 NOP 1 EQT25 NOP 1 EQT26 NOP 1 EQT27 NOP 1 EQT28 NOP 1 * * * * EQU'S FOR VARIOUS ENTRIES A EQU 0 DEFINE A REG. B EQU 1 DEFINE B REG. CARD EQU 15 DEFINE CARD FOR IO INSTRUCTIONS * * SYSTEM BSAE PAGE COMMUNICATION AREA * . EQU 1650B ESTABLISH ORIGIN OF EQTA EQU 1650B * BASE PAGE EQT1 EQU .+8 EQT2 EQU .+9 ADDRESSES EQT3 EQU .+10 EQT4 EQU .+11 OF CURRENT EQT5 EQU .+12 EQT6 EQU .+13 EQT ENTRY EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * INTBA EQU .+4 SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM CONSOLE * OPATN EQU .+52 OPERATOR KEYBOARD ATTN. FLAG ORG * DRIVER LENGTH END *^^^^^^ FIRST LINE OF TAPE 4 ^^^^** ADDRT DEF BUFF1 BUFF1 BSS 3 B.5 OCT 177773 B46 OCT 46 B165 OCT 165 B143 OCT 143 * * BN11 OCT 43612 BN12 OCT 41512 * TEMP4 NOP REQUEST TYRPE (1-3) TEMP5 NOP INIT\COMP. = 0\1 TEM8 NOP TEMP STATUS TEM10 NOP ASCII TYPE (6X) TEM11 NOP DEVICE TYPE IN BINARY * XMIT NOP SET CARD UP FOR XMIT LDA BN17 IOR B400 SET XMIT JSB OUT2 JMP XMIT,I * OUT1 NOP STA B JSB XMIT SET FOR TRANSMIT LDA B OTA02 OTA CARD SEND CHAR. JMP OUT1,I * OUT2 NOP GENERAL PURPOSE CARD PROGRAMMING OTA10 OTA CARD ROUTINE JMP OUT2,I * SPCH1 NOP THIS SUBROUTINE SETS SPECIAL CHAR. INTERRUPTS LDB BN12 JSB CDSET SET INTERRUPT LDB BN11 JSB CDSET SET INTERRUPTS JMP SPCH1,I RETURN * * USINT NOP SUBROUTINE TO TEST FOR USER KEYBOARD INTERRUPT LDA USINT SAVE RETURN ADDRESS STA EQT27,I JSB ENAK GO SHAKE HANDS WITH TERMINAL LDA TEMP8 GET CHAR. CPA B6 IS IT A "ACK" ? RSS JSB SCHED USER INTERRUPT JSB CLRCD GET ALL CHAR. OFF CARD LDA EQT27,I JMP A,I * *********************************************** * SUBROUTINE GETS DATA OF CARD UNTIL * * BUFFER EMPTY. * * *********************************************** * CLRCD NOP STA TEMP1 SAVE A REG. LDB B4 SET CARD TO RECEIVE AND CLR. INT. JSB CDSET CLRC1 JSB CHRIN GET CHARACTER LDA TEMP9 GET STATUS WORD ALF,ALF ISOLATE BUFFER EMPTY SSA IS IT EMPTY? JMP CLRC2 YES WE'RE FINISHED LDA TEM14 IS THIS A VALID CHARACTER? SSA JMP CLRC1 YES IT IS CLRC2 LDA TEMP1 RESTORE A REG. JMP CLRCD,I RETURN * B.1 OCT 177777 BN50 DEC -1000 * *********************************************** * ENABLES IO CARD INTERRUPT IF TERM. * * HAS BEEN ENABLED OR IF TERMINAL IS A * * SYSTEM CONSOLE.  * *********************************************** * SETEM NOP SUBROUTINE TO SETUP IO CARD FOR RECEIVE CLC03 CLC CARD INHIBIT INTERRUPT LDA EQT28,I MODE PRIOR TO EXIT. GET TERM.STATUS RAR,SLA IS TERMINAL ENABLED? (BIT 1=1) JSB RECIV YES! IT IS LDA SYSTY GET CONSOLE EQT. CPA EQT1 IS THIS THE SYSTEM CONSOLE? JSB RECIV YES! IT IS JMP SETEM,I * *********************************************** * * * EXIT IS A=2 (ILLEGAL CONTROL REQUEST). * *********************************************** * * REJ2 JSB NXQU CHECK QUE JSB SETEM SETUP CARD FOR EXIT LDA B2 RSS REJ1 CLA,INA RSS REJ4 LDA B4 IMMEDIATE COMPLETION CLB JMP I.05,I * **************************************************** * IS USED FOR INITIATOR OPERATION WITH * * INITIATED EXITS (A=0), AND COMPLETION * * CONTINUATION EXITS (P+2). "TEMP5" INDICATES * * WHICH EXIT TO TAKE. * **************************************************** * EXIT1 NOP LDB EXIT1 GET CALLING PROGRAMS ADDRESS+1 STB EQT11,I STORE AT EQT11,I FOR INTERRUPT EXIT5 LDA BN20 CLEAR CARD INTERRUPTS JSB OUT2 STC04 STC CARD RE-INITIALIZE CARD FOR INTERRUPT LDB TEM10 CHECK FOR CRT CPB B60 JMP ON3 IT IS A CRT LDA BN68 NOT A CRT SET 60 SEC T.O. JMP ON2 ON3 LDA TIM1 IF READ USE PRESET T.O. LDB TEMP4 CHECK REQUEST TYPE CPB B2 IF A WRITE SET 4 SEC. T.0. ON2 STA EQT15,I EXIT4 CLA EXIT6 LDB TEMP5 GET INITIATION COMPLETION FLAG SZB,RSS JMP I.05,I INITIATION RETURN ISZ C.05 RETURN JMP C.05,I COMPLETION RETURN * EOOP9 LDB B3 SET B=3 FOR XMISSION ERROR STB EQT19,I A REG. EXIT JMP EOOP4 * ********************************************************* * DOES ASCII CTU AND DISPLAY WRITE EOR PROCESSING* ********************************************************* * * EORP NOP LDA CR OUTPUT A JSB OUT1 LDA LF OUTPUT A JSB OUT1 JMP EORP,I * IFZ * ******************************************** * ENABLES KEYBOARD IF IT HAS BEEN * * LOCKED BY A CTU REQUEST * ******************************************** * KEYBD NOP LDA EQT16,I AND B20 IS IT LOCKED (BIT 4) SET SZA,RSS JMP KEYBD,I NO! LDA ESC UNLOCK KEYBOARD JSB OUT1 LDA B142 JSB OUT1 SEND SMALL B JSB EXIT1 WAIT FOR INTERRUPT JSB CDINT LDA EQT16,I AND BN3 REMOVE KEYBD LOCK BIT STA EQT16,I JMP KEYBD,I * EOOP7 NOP IF CN50C FLAG IS SET(BIT3,EQT16) JMP EOOPC THEN EOOP7 IS LDA EQT8,I IT IS SET JMP A,I * XIF EOOP8 LDB TEMP1 THIS EXIT IS USED IF UNDERSCORE CPB BN2 IS ONLY CHAR. RSS * ********************************************************* * AND ARE ENTRIES FOR COMPLETION (P+1) * * EXITS. THE TERMINAL OR CTU STATUS IS TEMPORARLY PUT * * IN TEMP5. * ********************************************************* * EOOP1 JSB EXIT1 EOOP2 CLA STA EQT19,I SET A REG. EXIT LDA EQT28,I GET TERMINAL STATUS STA TEM8 JMP EOOP3 * EOOPC LDB TEMP4 IF CONTROL ALWAYS GET STATUS IFZ CPB B3 RSS SZA IF GOOD WRITE DO NOT GET STATUS EOOP5 JSB CTUST YES!,GO UPDATE CTU STATUS ** EOOP6 STA TEM8 ** * EOOPB LDA BN55 REMOVE EOF FLAG IN EQT16 LDB TEM11 BECAUSE TAPE HAS MOVED RBL XOR B LDB EQT16,I AND B STA EQT16,I LDA TEM8 * ************}****************************************** * A READ TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 0 GOOD READ * * 40 END OF TAPE. GOOD RECORD READ * * 240 EOT+EOF. NO RECORD READ, * * SET FOR NR(A=1) EXIT * * 42 EOT+EOV * * 52 EOT+EOV+ABORT * * 52 EOT+EOV+ABORT * * * ****************************************************** * * ****************************************************** * A WRITE TO END OF TAPE WILL GIVE BELOW STATUS * * STATUS * * 42 EOT+EOV GOOD RECORD WRITTEN * * 52 EOT+EOV+ABORT (NO RECORD WRITTEN)* * SET ET(A=1) EXIT * * * ****************************************************** * ****************************************************** * READ TO EOV IN MIDDLE OF TAPE * * STATUS * * 200 EOF * * 2 EOV * * 12 EOV+ABORT * * SET NR(A=1) EXIT * * * * ****************************************************** * EOOPA AND B373 REMOVE WRITE PROTECT CPA B240 IF EOF+EOT THEN SET NR JMP OVER4 CPA B52 IF FAILURE ON WRITE JMP OVER4 DUE TO EOT DO THIS(SAVE REQ.) AND B10 CHECK FOR CMD ABORT CPA B10 JMP OVER4 SET N.R. CLB STB EQT19,I SET A=0 FOR GOOD EXIT JMP EOOP3 OVER4 CLB,INB SET NR l2STB EQT19,I SET A REG. EXIT *********************************************************** XIF * IS ENTRY FOR B=0 (TRANS. LOG =0) EXIT. * *********************************************************** * EOOP4 CLA STA EQT8,I SET UP FOR B REG. =0 EXIT * ********************************************************** * SETS 2640\2644 AND IO CARD FOR NEXT INTERRUPT * * OR REQUEST, AND SETS EITHER CTU OR CRT STATUS IN EQT5 * * * IT ALSO SETS THE TRANSMISSION LOG IN B REG. (+CHAR. OR * * + WORDS). IF EQT8 =0 (VIA EOOP4) THEN B=0. * ********************************************************** * EOOP3 JSB STPUT SET STATUS IN EQT5,I JSB CDINT !!!!!!!!!! IFZ JSB KEYBD ENABLE KEYBD IF LOCKED XIF JSB USINT WITH KEYBOARD ENABLED JSB USINT JSB CLRNT CLR RUBOUT INTERRUPT JSB CLRCD GET ALL DATA OFF CARD JSB SETEM ** DVA LDB EQT9,I GET 2X LAST CHAR. ADDRESS CMB,INB MAKE NEG. ADB EQT7,I SUBTRACT TWO TIMES STARTING ADD. ADB EQT7,I CMB,INB LDA EQT8,I IF WORDS THEN DIV. BY 2 SSA JMP *+4 THESE ARE CHARACTERS SLB IS LSB SET? INB YES! INCREMENT SO EVEN FOR DIVIDE BRS DIVIDE TO CONVERT TO WORDS * SZA,RSS IF EQT8 IS 0 THEN CLEAR B REG. CLB LDA EQT19,I SET A REG. EXIT JMP C.05,I ** * * **************************************************** * INSERTS CORRECT DEVICE STATUS INTO EQT5 * **************************************************** STPUT NOP LDA EQT5,I GET CURRENT STATUS AND BN31 RE MOVE OLD STATUS IOR TEM8 OR NEW STATUS STA EQT5,I RESTORE IT JMP STPUT,I * * * TIM1 OCT 177200 BN3 OCT 177757 BN37 OCT 102100 B373 OCT 373 B142 OCT 142 B240 OCT 240 B64 OCT 64 B3 OCT 3 BN31 OCT 1774r+00 B1100 OCT 1100 B4000 OCT 4000 B2000 OCT 2000 B52 OCT 52 D.13 DEC -13 B600 OCT 600 B500 OCT 500 ********************************************************** * CONFIGURES IO INSTRUCTIONS TO SELECT CODE SET * * IN A REG. * ********************************************************** * SETIO NOP IOR BN37 CONSTRUCT STF STA STF01 STF IS 1021XX * IOR B400 CONSTRUCT LIA AND SAVE STA LIA01 STA LIA02 STA LIA03 * XOR B600 CONSTRUCT SFS STA SFS01 SFS IS 1023XX * * * XOR B500 CONSTRUCT OTA AND SAVE STA OTA10 STA OTA02 STA OTA18 STA OTA20 IOR B1100 STA STC02 STA STC03 STA STC04 STA STC05 * IOR B4000 CONSTRUCT CLC,C AND SAVE STA CLC01 CLC,C IS 1077XX STA CLC02 STA CLC03 * * * * * * * * LDA EQT4,I GET SUBCHANNEL AND STORE IN TEM11 LSR 6 SC=0 IS CRT (TEM10=60) AND B37 SC=1 IS L CTU )(TEM10=61) STA TEM11 SC =2 IS R CTU (TEM10 =62) *** SC =3 IS GRAPHICS (TEM10=60) CPA B3 IF GRAPHICS CRT CLR TEM11 CLA SO TEM10 =B60 ADA B60 STA TEM10 LDA EQT6,I GET CONTROL WORD IFZ LDB TEM10 GET DEVICE CPB B64 IS IT LP? CLA YES! SET FOR ASCII XIF RAR BIT6 1\0 IS BIN\ASCII AND B40 ISOLATE BIT 5 XOR B40 REMOVE BIT 5 IF BINARY STA FILL SET FILL CHARACTER LDA EQT6,I GET WORD AGAIN TO SET HONEST WORD AND B2000 HONEST IS BIT 10 =1 STA TEMP2 * ** DVA * IFZ ** LDA TEM10 CLB CPA B60 SET SWITCH CRT/CTU = RSS/NOP LDB RSS STB SWH1A STB SWH1B STB SWH1C STB SWH1D * XIF * z **************************************************** * SETUP EXTENSIONS ON EQT * * * * EQT NO. USE * * 1-8 STANDARD * * 9 RUNNING CHAR. ADDRESS * * 10 LAST CHAR. ADDRESS * * 11 ADDRESS TO GO ON INTERRUPT * * 12 NO. OF EQT EXTENSIONS * * AND CURRENT CONWD * 13 EQT EXTENSION STARTING ADD. * * 14-15 STD * * 16 TERMINAL STRAPPING AND CTU INFO* * BIT 14 IS 0\1 =CHAR.\BLOCK * * BIT 15 IS 0\1 =LINE\PAGE * ** DVA * BIT 5-8 IS BAUD RATE * BIT 9 IS PARITY EVEN\ODD 1\0 * * BIT 10 IS PARITY ON\OFF 1\0 * * BIT 11 IS "CD" (DTR) SET * BIT 12 IS "CA" (RTS) SET * BIT 13 IS LINE 0\1 HARD\MODEM * BIT 4 IS KEYBOARD LOCKED * * BIT 3 IS CNC50 FLAG * BIT 2 IS RCTU EOF FLAG * BIT 1 IS LCTU EOF FLAG * BIT 0 IS TERMINAL STRAPPING * * ALREADY READ. * * 17 ID ADDRESS OF TERM. PROG. * * 18 NOT USED G * * 19 RETURN ADDRESS * * AND A REG. EXIT * 20 BINARY RECORD LENTGH * * AND PARITY ERR XLOG * * AND $UPIO ENTRY * 21 NOT USED * * 22 RETURN ADDRES* * 23 RETURN ADDRESS * * 24 RETURN ADDRESS * * LINE CONTROL REF.(MODEM) * * 25 " RETURN ADDRESS * * AND LINE CONTROL FLAG * * 26 NOT USED * * 27 RETURN ADDRESS * * 28 TERMINAL STATUS * * BIT 1 TERMINAL ENABLED * BIT 3 PARITY ERROR * BIT 5 CNTRL D ENTERED * BIT 7 BUFFER FLUSH IN PROGRESS * **************************************************** * * SETIP LDA EQT13,I GET STARTING ADDRESS OF EXT. LDB D.13 STB TEMP1 STORE NO. OF EXT. AT TEMP1 LDB ADR16 GET ADD. OF EQT16 STA B,I STORE S.A. OF EXT. IN IT INA INB ISZ TEMP1 JMP *-4 * * * ** DVA * IFZ SEP1 CLB * * * LDA EQT16,I STORE A AT EOOP7 IF CN50C AND B10 FLAG IS SET SZA LDB RSS STB EOOP7 * XIF LDA EQT6,I GET CONTROL WORD AND B3 STA TEMP4 STORE REQUEST TYPE AT TEMP4 CPA B3 IS THIS CONTROL? JMP OVER7 YES RAR SSA IS THIS A WRITE? JMP OVER2 NO! *** *** LDB EQT28,I IF WRITE AND BUFFER FLUSH SET BLF,BLF THEN EXIT VIA REJ2 SSB JMP OVER8 JMP OVER2 OVER7 LDA EQT6,I LSR 6 IF CONTROL TYPE 0 AND B37 THEN SPECIAL PROCESSING REQUIRED SZA,RSS AT JMP OVER3 * * OVER2 LDA EQT6,I NORMAL NON CNTL 0 REQ. STA EQT12,I STORE CURRENT CONWD FOR SYS. INTERRUPT JMP SETIO,I * * BUFFER FLUSH EXITS * OVER8 LDA TEMP5 GET I.05/C.05 FLAG SZA JMP OVER2 C.05 EXIT JMP REJ2 * * SPECIAL "CONTROL 0" PROCESSING * OVER3 LDA EQT6,I IS THIS A SYSTEM REQ.? SSA,RSS JMP SETIO,I * LDA EQT12,I GET OLD CONWD STA EQT6,I PUT IN CURRENT CONWD\ljf AND B2 IF WRITE MUST COMPLETE XFER CPA B2 OR TERMINAL WILL HANG JMP OVER9 LDA EQT9,I NO MORE DATA IN USERS BUFFER! STA EQT10,I IT IS GONE!!! OVER9 LDA TEM11 IF NON CRT REQ. WE MUST COMPLETE SZA JMP EXIT4 CONTINUE NOT CRT REQ. * JSB CLRCD GET ALL OFF CARD IFZ JSB KEYBD ENABLE KEYBOARD IF LOCKED XIF LDA EQT6,I RAR SLA,RSS IF WRITE OR CONT. THEN SEND NULL JMP REJ2 THIS IS A CRT READ CLA SEND NULL TO ALLOW CHAR. OUT OF UART JSB OUT2 JMP EOOP1 ADR16 DEF EQT16 EQT16 NOP 1 EQT17 NOP 1 EQT18 NOP 1 EQT19 NOP 1 EQT20 NOP 1 EQT21 NOP 1 EQT22 NOP 1 EQT23 NOP 1 EQT24 NOP 1 EQT25 NOP 1 EQT26 NOP 1 EQT27 NOP 1 EQT28 NOP 1 * * * * EQU'S FOR VARIOUS ENTRIES A EQU 0 DEFINE A REG. B EQU 1 DEFINE B REG. CARD EQU 15 DEFINE CARD FOR IO INSTRUCTIONS * * SYSTEM BSAE PAGE COMMUNICATION AREA * . EQU 1650B ESTABLISH ORIGIN OF EQTA EQU 1650B * BASE PAGE EQT1 EQU .+8 EQT2 EQU .+9 ADDRESSES EQT3 EQU .+10 EQT4 EQU .+11 OF CURRENT EQT5 EQU .+12 EQT6 EQU .+13 EQT ENTRY EQT7 EQU .+14 EQT8 EQU .+15 EQT9 EQU .+16 EQT10 EQU .+17 EQT11 EQU .+18 EQT12 EQU .+81 EQT13 EQU .+82 EQT14 EQU .+83 EQT15 EQU .+84 * INTBA EQU .+4 SYSTY EQU .+21 EQT ENTRY ADDRESS OF SYSTEM CONSOLE * OPATN EQU .+52 OPERATOR KEYBOARD ATTN. FLAG ORG * DRIVER LENGTH END :=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 _ 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, SO nGO 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. 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 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 DEVIC640E 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 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 H 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 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 OLD EQT,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 Ӑ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. 5G 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 LD,A 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 * 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. * *********************************************************************** * 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 P2R 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  92001-18031 1926 S 2322 &RT2GN RTE-II ON LINE GEN.             H0123 ASMB,N,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.1926 790430 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3GN,3,90 92060-16037 REV.1926 790430 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 INTERACTIVE 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,N,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,N,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 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 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,N,R,L,C HED RTGN3 - LOADING CONTROL SEGMENT IFN ASSEMBLY OPTION "N" FOR RTE-II NAM RT2G3,5,90 92001-16031 REV.1926 790430 XIF IFZ ASSEMBLY OPTION "Z" FOR RTE-III NAM RT3G3,5,90 92060-16037 REV.1926 790430 XIF 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 2 SPC 1 ****************************************************** * * NAME: RT2G3/RT3G3 * SOURCE PART #: 92001-18031 / 92060-18037 * REL PART #: 92001-16031 / 92060-16037 * WRITTEN BY: KFH, JH, GAA * ****************************************************** 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 EXT CP3LSB,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 CU_RRENT 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 BSpS 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 0 5 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 ADDREShS 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 IS RaEPORTED 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 * ************************************************J** * 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 * j(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 * ****************************** LIN>2KS, 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 SEYpT 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 RESIDENT DIKSK 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 JNLHHN 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. * CLA,INA SET MPTFL=1 OFF (MEM PROT FLAG) STA MPTFL *** PCO 1926 * 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 SUR.E 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 SrNLHAVE IN LABDO MAP. LDA M2002 SET BASE CORE ADDR STA DBASE IN MAP. 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 N 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,N,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,N,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. _k 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 &C 92001-18032 1631 S C0122 &HEWPK RTE DUMMY MINI CARTRIDGE FILE             H0101 ***** THIS IS A HEWLETT-PACKARD MINI-CARTRIDGE *****  # 92001-18035 2013 S C0422 &DVA05 264X DRIVER W/MODE             H0104 ASMB,Q,C,Z,R ***RTE 264X MODEM TERMINAL DRIVER*** * NAME: DVA05 * SOURCE: HP 2640 \2645 RTE DVA05 92001-18035 * RELOC.: HP 26Xx RTE DVA05 92001-16035 * * PRMR: B.B. * * SOURCE FILE &DVA05 * RELOC. FILE %DVA05 * ***************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED OR TRANSALATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ***************************************************************** * ****DVA05 WILL WORK WITH 2640A,B\2644\2645\2648 * * *2.1 INPUT/OUTPUT INTERFACE * * DVA 05 WILL COMMUNICATE WITH THE 26XX VIA THE 12966 BUFFERED * ASYNCHRONOUS DATA COMMUNICATION INTERFACE CARD. DVA 05 WILL ALSO * FUNCTION WITH A 2640A FOR THOSE APPLICATIONS WHERE THE CTU IS * NOT REQUIRED. COMMUNICATION FROM THE 2644A/2640A KEYBOARD MAY BE * IN EITHER CHARACTER OR BLOCK MODE. THE TERMINAL CAN BE USED WITH * "LINE STRAPPING", OR "PAGE STRAPPING" AND HENCE A SINGLE LINE OR * THE ENTIRE DISPLAY MEMORY CAN BE TRANSMITTED AFTER BEING ENABLED. * * *2.2 MAJOR FUNCTIONS * * DVA 05 PROVIDES THE FOLLOWING MAJOR FUNCTIONS: * 1. I/O CONTROL OF CARTRIDGE TAPE UNIT (CTU),CRT,AND TERMINAL PRINTER. * 2. READ OR WRITE REQUEST TO CTU WITH BINARY OR ASCII DATA. * 3. READ OR WRITE REQUEST TO KEYBOARD AND DISPLAY. * 4. STATUS REQUEST TO CTU AND KEYBOARD. * 5. CONSOLE OR TERMINAL USE. * 6. WRITE REQUEST TO TERMINAL PRINTER (2644 2645 ONLY) * 7. MODEM INITIALIZATION * * *2.2.1 CTU CONTROL REQUEST * *ICNWD (CONTROL LEFT OR RIGHT CTU AS SELECTED BY LOGICAL UNIT NUMBER) * 01-WRITE END OF FILE * 02-BACKSPACE 1 RECORD * 03-FORWARD SPACE 1 RECORD * 06-DYNAMIC STATUS * 14-BACKSPACE 1 FILE * 13-FORWARD SPACE 1 FILE *  4,5-REWIND * 27-LOCATE FILE. THIS IS AN ABSOLUTE FILE NUMBER. * 26-WRITE END OF VALID DATA (EOV) * 10-WRITE EOF IF NOT JUST WRITTEN OR NOT AT BOT * * *NOTES ON CTU CONTROL REQUEST * * A. A REWIND, BACKSPACE RECORD, OR BACKSPACE FILE WILL PERFORM * NO ACTION IF THE TAPE UNIT IS AT LOAD POINT. THIS CONDITION * WILL BE SET IN THE STATUS WORD (BIT 6 SET). * B. IF THE END-OF-TAPE MARK IS SENSED DURING A WRITE OPERATION, * AN END OF VALID DATA MARK WILL BE RECORDED AUTOMATICALLY. IF * A WRITE REQUEST WAS BEING PROCESSED, THE CURRENT RECORD WILL * BE RECORDED. IF A READ REQUEST WAS IN PROCESS THE CURRENT * RECORD WILL BE READ. THIS CONDITION WILL BE SET IN THE STATUS * WORD. * C. FOR FILE MOTION COMMANDS THE TAPE IS POSITIONED AFTER THE * FILE MARK. * D. READ REQUESTS WILL BE REJECTED IF THE TAPE IS AT EOV. THE * EOV MAY BE OVERWRITTEN WITH DATA OR A FILE MARK UNLESS THE * TAPE IS AT END-OF-TAPE. * E. AN INVALID FUNCTION CODE WILL CAUSE THE DRIVER TO EXIT WITH * A REG.=2 THRU IA05. IF THE FUNCTION CODE IS VALID, EXIT IS * THRU CA05 WITH A REG.=0. * * F. DYNAMIC STATUS PUTS THE STATUS OF THE LAST LEFT OR RIGHT * CTU OPERATION IN EQT 5. * * *2.2.2 CRT CONTROL REQUEST * *ICNWD * 11-SPACE "IPRM" LINES -IPRM PG. EJECT 9871 ONLY * 20-ENABLE TERMINAL. ALLOWS TERMINAL TO SCHEDULE PROGRAM WHEN KEY IS * STRUCK. * 21-DISABLE TERMINAL. INHIBIT SCHEDULING OF TERMINAL'S PROGRAM. * 22-SET NEW TIME OUT (IN OPTIONAL PARAMETER) * 23-CLEAR THE OUTPUT QUEUE (BUFFER FLUSH). * 24-RESTORE OUTPUT PROCESSING. REQUIRED ONLY IF SOME OF BUFFER IS * TO BE SAVED. * 25-UPDATE TERMINAL STATUS * 30-TERMINAL MODEM CONTROL * 31-LINE CONTROL FOR MODEMS * 32-AUTOANSWER FOR MODEMS *2.2.3 CTU READ/WRITE REQUEST * * -READ/WRITE FROM LEFT OR RIGHT CTU AS SELECTED BY LOGICAL UNIT * NUMBER. * -IF T7HE OPERATION FAILED, RETURN WILL BE THROUGH CA05 WITH A=1 * AND B=O. *ICNWD * * 6 -0/1 IS ASCII/BINARY * 10-0/1 IS NOT HONEST/HONEST * * -BINARY INPUT IS A STRING OF CHARACTERS SPECIFIED BY THE BUFFER * LENGTH PARAMETER IN THE REQUEST. IF THE REQUIRED LENGTH IS FILLED * BEFORE A END-OF-RECORD (EOR) IS ENCOUNTERED, THE REMAINING DATA * IS IGNORED AND THE CTU WILL STOP AT THE NEXT EOR. IF A EOR IS * ENCOUNTERED BEFORE THE REQUIRED LENGTH IS FILLED THE CTU WILL * HALT IN THE EOR. BINARY EOR IS DETECTED BY THE REQUEST TO SEND * LINE MOMENTARILY GOING NOT READY. IF BUFFER LENGTH=0, THEN SKIP * ONE RECORD. * -BINARY OUTPUT IS A STRING OF CHARACTERS SPECIFIED BY THE BUFFER * LENGTH PARAMETER IN THE REQUEST. MAXIMUM RECORD LENGTH IS 128 * WORDS. THIS LIMIT IS SET BY THE CTU DATA BUFFER. IF THIS LENGTH * IS EXCEEDED, OR IF BUFFER LENGTH=0, RETURN IS A REG.=1 THRU IA05. * -ASCII INPUT IS A STRING OF CHARACTERS TERMINATED BY A CARRIAGE * RETURN (CR). IF THE REQUIRED LENGTH IS FULFILLED BEFORE A CR * IS INPUT, THE REMAINING CHARACTERS ARE IGNORED. IN ANY CASE, A * CR CODE MUST BE INPUT. * -ASCII OUTPUT IS A STRING OF CHARACTERS SET BY THE BUFFER LENGTH. * MAXIMUM RECORD LENGTH IS 127 WORDS (CR IS SENT BY DVA 05). THE * DRIVER WILL TERMINATE THE REQUEST IF IT SEES A "CR", "LF" OR "RS". * THE DRIVER USES THE "CR" AS A RECORD TERMINATOR ON INPUT * AND THE 26XX USES THE "LF" AS RECORD TERMINATOR ON OUTPUT.A "RS" * IS PASSED TO THE DRIVER WHEN THE CTU ENCOUNTERS A FILE GAP. * * *2.2.4 ASCII OUT TO DISPLAY * * -ASCII OUTPUT IS A STRING OF CHARACTERS, THE NUMBER OF WHICH IS * DESIGNATED BY THE BUFFER LENGTH. THE STRING IS TERMINATED BY A * CARRIAGE RETURN AND LINE FEED (BOTH SUPPLIED BY DRIVER). * -IF AN UNDERSCORE (ASCII 137) IS THE LAST CHARACTER IN THE NEW * BUFFER, THE CARRIAGE RETURN, Lc<INE FEED AND UNDERSCORE CODES ARE * NOT OUTPUT TO THE CRT. * -BUFFER LENGTH SHOULD BE LIMITED TO 80 DISPLAYABLE CHARACTERS. * -THE CURSOR WILL REMAIN IN COLUMN 80 IF CURSOR END-OF-LINE WRAP * AROUND STRAP IS NOT IN. OTHERWISE AN AUTOMATIC CR LF ARE GENERATED. * -HONEST MODE WRITE THE CR AND LF ARE NOT OUTPUT. AN UNDERSCORE * WILL ALWAY BE OUTPUT TO DISPLAY IF IN BUFFER. * * -BINARY WILL STRIP "ESC" * *2.2.5 ASCII INPUT FROM KEYBOARD CHARACTER MODE * * THE DRIVER DETECTS WHETHER A CHARACTER MODE OR BLOCK MODE REQUEST * WILL FOLLOW BY EXAMINING THE FIRST CHARACTER. IF IT IS A DC2 * THEN THE DRIVER ASSUMES THE ENTER KEY HAS BEEN PRESSED AND A * BLOCK TRANSMISSION IS PENDING. THE DRIVER RESPONDS WITH A DC1 TO * TRIGGER THE BLOCK TRANSFERS. IF THE FIRST CHARACTER IS NOT A DC1 * THEN THE DRIVER ASSUMES A CHARACTER TRANSFER IS PENDING. * IN CHARACTER MODE THE TERMINAL TRANSMITS A CHARACTER AT A TIME AS * THE KEY IS DEPRESSED. THE RECORD TERMINATION IS A CR OR RS. THE * DRIVER ECHOS A LF. * A RECORD TERMINATOR MUST BE ENTERED TO COMPLETE REQUEST, EVEN IF THE * USERS BUFFER IS FULL. TRANSMISSION LOG IS RETURNED IN B REG. * THERE ARE TWO TYPES OF CHARACTER MODE PROCESSING: HONEST AND NON-HONEST * A. HONEST * ALL CHARACTERS EXCEPT CR AND RS SENT TO USERS BUFFER. * B. NON-HONEST * THE DRIVER WILL PROCESS THE BELOW SPECIAL CHARACTERS: * *DEL (RUBOUT) ASCII 177 * ENTERING DEL WILL DELETE THE CURRENT RECORD AND CAUSE (\, * CRLF)TO BE OUTPUT. THIS IS USED TO DELETE THE CURRENT LINE * AND START A NEW LINE. * *BACKSPACE ASCII 10 * ENTERING BACKSPACE WILL DELETE THE LAST CHARACTER. THE * TERMINAL WILL LOCALLY MOVE THE CURSOR BACK ONE POSITION. * *LINEFEED ASCII 12 * THIS WILL NOT BE SENT TO USER'S BUFFER. * * CNTROL D ASCII 40 * ENTERING CONTROL D WILL CAUSE BIT 5 TO BE xPSET IN TERMINAL * STATUS WORD AND TRANSMISSION TERMINATED WITH B REG. = 0. THIS * BIT WILL BE CLEARED UPON NEXT ENTRY. * * *2.2.6 ASCII INPUT FROM KEYBOARD BLOCK MODE * * IN BLOCK MODE THE TERMINAL TRANSMITS EITHER A LINE AT A TIME (LINE * STRAPPING) ON A PAGE (PAGE STRAPPING). THE DRIVER DETERMINES TYPE * OF STRAPPING BY A TERMINAL STATUS REQUEST. * A. LINE STRAPPING * THE TERMINATOR IS A CR WHICH IS NOT PASSED TO USER'S * BUFFER. IMBEDDED RS'S ARE NOT PASSED. * B. PAGE STRAPPING * THE TERMINATOR IS A RS WHICH IS NOT PASSED TO USER'S BUFFER. THE * LINE SEPARATORS CR, LF ARE PASSED TO USER'S BUFFER. * C. A "US"OR "RS" IS NEVER PASSED TO BUFFER UNLESS TRANS. READ * D. BLOCK READS ARE OF 2 TYPES: * 1. TERMINAL ENABLED (ENTER PRESSED) * 2. USER ENABLED ("ESC" SMALL "D" SENT BY USER) * * *2.2.7 CTU STATUS REQUEST (RETURNED IN EQT5) * * BIT * 7 -END OF FILE SENSED. A FILE MARK HAS BEEN DETECTED DURING A PRIOR * READ OPERATION OR A FILE MARK HAS JUST BEEN RECORDED. * 6 -LOAD POINT SENSED. CARTRIDGE TAPE IS AT OR BEFORE LOAD * POINT MARKER. MEANINFUL ONLY IF CARTRIDGE IS INSERTED. * 5 -END OF TAPE SENSED. THE CARTRIDGE TAPE HAS PASED OVER EARLY * WARNING MARKER IN THE TAPE AND AN END-OF-VALID DATA MARK HAS BEEN * RECORDED AUTOMATICALLY. COMMANDS DIRECTING FORWARD MOTION OF TAPE * WILL BE REJECTED. THIS STATUS ONLY HAS MEANING IF A CARTRIDGE IS * INSERTED. * 4 -READ\WRITE ERROR.WRITE 2645 ONLY * A READ ERROR EXISTS IF THREE SUCCESSIVE ATTEMPTS FAILED TO READ * THE DATA IN THE RECORD. THE TAPE IS POSITIONED AFTER THE BAD * RECORD. * 3 -LAST COMMAND ABORTED. THE LAST COMMAND INITIATED FROM THE CPU OR * KEYBOARD WAS UNSUCCESSFULLY PERFORMED. OTHER STATUS CONDITIONS * MAY BE CHECKED FOR CAUSE. * 2 -WRITE PROTECTED. THE FILE PROTECT TAB ON THE CARTRIDGE IS IN THE * POSITION TO PROHIBIT RECORDING OF DATA. THIS STATUS ONLY HAS * MEANING IF A CARTRIDGE IS INSERTED AND A RECORDING OPERATION HAS * BEEN ATTEMPTED. * 1 -END OF VALID DATA. THE CARTRIDGE TAPE DETECTED AN END-OF-VALID * DATA MARK DURING A PRIOR READ OR SEARCH OPERATION OR HAS JUST * COMPLETED RECORDING AN END-OF VALID DATA MARK. IN EITHER CASE, * THE TAPE IS POSITIONED BEFORE THE END-OF VALID DATA MARK. RECORDING * OPERATIONS MAY BE EXECUTED TO OVERWRITE THIS MARK WITH DATA * OR A FILE MARK, UNLESS THE TAPE IS AT END OF TAPE. * 0 -CARTRIDGE NOT INSERTED OR UNIT BUSY. * * *2.2.8 CRT STATUS REQUEST (RETURNED IN EQT5) * * BIT * 1 -TERMINAL ENABLED. IF THE STATUS WORD IS FOR A TERMINAL (NOT A * SYSTEM CONSOLE) TYPING ANY KEY WILL SCHEDULE THE TERMINAL'S * PROGRAM (IF IT HAS ONE). * 5 -CONTROL D ENTERED. THE USER HAS HIT THIS KEY. * 7 -BUFFER FLUSH IN PROGRESS * 3 -PARITY ERROR * 4 -DATA SET N.R. * * * *2.2.9 CONSOLE OR TERMINAL USAGE. * * IF AT GENERATAION THE 26XX IS IDENTIFIED AS A TERMINAL (VIA THE * INTERRUPT TABLE) THEN STRIKING A KEY WILL SCHEDULE THE PROGRAM * ASSOCIATED WITH THAT TERMINAL IF THE TERMINAL HAS BEEN ENABLED * VIA A CONTROL REQUEST. * IF THE 26XX IS A CONSOLE THEN STRIKING A KEY WILL GET THE SYSTEM'S * ATTENTION AND A "*" PROMPT WILL BE WRITTEN. * * REV.1805 FIXED SPURIOUS INT. ON POWER UP * REV.1806 FIXED T BIT KEYBOARD ENTRY * REV. 1913 FIXED INTERMITTENT HANGUP (CLRSB IN HARDWIRE) * THIS (1913) USES EXTENDED COMM. CARD * AND CHANGED WRITE T.O. TO 4 SEC * REV. 2013 FIXED UPDATE OF EQT5 STATUS TO SHOW LINE DOWN (SSB 4488) ****************************************** * SUBROUTINE IS ALWAYS ENTERED TO * * INITIALIZE A SYSTEM OR USER REQUEST TO * * ANY 264X SUBSYSTEM. * ****************************************** * * NAM DVA05,0 92001-16035 REV 2013 800124 ENT IA05,CA05  EXT $LIST,$UPIO,$OPSY IA05 NOP STA TEM12 SAVE SELECT CODE CLB STB TEMP5 SET IA05 CA05 POINTER JSB SETIO CONFIGURE IO CLB DO NOT MOVE STB EQT20,I * ** DVA STB EQT25,I RESET CN31 FLAG LDA EQT28,I CLR PARITY AND DATA SET ERROR BITS AND BN51 IN TERMINAL STATUS STA EQT28,I ** SFS01 SFS CARD IF FLAG SET THEN POWER FAIL JMP IA055 FLAG NOT SET IA054 JSB XMIT SET UP TO CLR INTERRUPT LDA BN5 CLR ALL CARD INTERRUPTS IA053 JSB OUT2 (0-377) CPA BN7 IS THIS ALL? JMP IA055 YES! FINISHED INA JMP IA053 DO IT AGAIN IA055 LDA EQT16,I FOR BINARY CTU READ AND BN1 CLR SELECTED BITS STA EQT16,I BIT 0 (0\1=TERM.STAT. READ NO\YES) * * * LDA EQT17,I GET THE SCHEDULE FLAG. SZA IS IT DEFINED? JMP IA051 YES, CONTINUE LDA TEM12 SET UP SCHEDULE FLAG . ADA B.6 INDEX INTO INTERRUPT TABLE ADA INTBA GET SCHEDULE WORD.IF WORD NEG. LDB A,I THEN ID SEG. OF PROG. TO SCHED. CMB,SSB,INB CHANGE SIGN OF WORD. CCB NO PROG. TO BE SCHED. (INT. POINTS TO EQT) STB EQT17,I SAVE FOR FURTURE REFERENCE. LDB EQT1 SET EQT ADDRESS IN INTERRUPT STB A,I TABLE LDA EQT4,I SET THE "I WILL HANDLE IOR BN4 TIME OUT" BIT IN STA EQT4,I EQT4.RESTORE WORD. JMP IA054 GO CLEAR ALL SPECIAL INTERRUPTS * * ***************************************************** * "B.X" IS NEG. BINARY NO., "D.X" IS NEG. DECIMAL NO* * "BN" IS SOME BINARY NO. * * SEE BELOW. * ***************************************************** * BN1 OCT 137767 BN4 OCT 10000 BN7 OCT 60377 BN5 OCT 60000 * BN51 OCT 177747 DVA05 BN70 OCT 173777 B32 ` OCT 32 DVA05 B100 OCT 100 B.6 OCT 177772 * * TEM13 NOP CARD STATUS ON INTERRUPT TEM12 NOP SELECT CODE * * IA051 JSB CDINT ************************************************ ************************************************ * * SWH1A NOP SWITCH CRT \CTU ,LP= RSS\NOP * JMP I.251 YES! A CTU OR LP REQUEST LDA TEMP4 GET REQUEST TYPE RAR THIS IS A CRT REQUEST SSA,SLA JMP IA05C THIS IS A CONTROL REQUEST. ** DVA JSB LINCK CHECK MODEM STATUS LINES ** LDA TEMP4 GET REQUEST TYPE SLA,RSS JMP IA05W THIS IS A WRITE REQUEST JMP IA05R THIS IS A READ REQUEST * ****************************************************************** * SUBROUTINE INITIALIZES THE COMPLETION SECTION * * FOR ALL COMPLETION INTERRUPTS. * * ****************************************************************** * * CA05 NOP STA TEM12 SAVE SELECT CODE DVA05 ISZ TEMP5 SET CONT. FLAG JSB SETIO CONFIGURE IO ** LDA EQT20,I CHECK FOR $UPIO ENTRY CPA BN71 FROM LINCK JMP $UPIO ** CLC01 CLC CARD GET CARD STATUS LIA01 LIA CARD STA TEM13 STORE CARD STATUS AND B40 CHECK FOR BUFFER OVERFLOW ** SZA,RSS HAS IT OVER FLOWED? JMP *+3 IT HAS NOT SWH2E NOP HARD \ MODEM = 0\RSS ** JMP EOOP9 HARD OVERFLOW (B=3,XMISSON ERROR) *** LDA TEM13 CHECK FOR SPURIOUS BRK. INT. AND B100 SZA JMP EXIT5 SPURRIOUS INTERRUPT *** LDA EQT1,I GET QUE WORD SZA IS A REQUEST IN PROCESS? JMP *+3 YES! JSB SCHED NO REQUEST IN PROCESS.FIND OUT JMP EXIT5 WHAT HAPPENED AND EXIT LDA EQT4,I ALF CHECK FOR TIME OUT ENTRY SSA IS THIS TIME OUT (BIT ?11) ? JMP TIMOT YES! LDB EQT11,I GET INTERRUPT ADDRESS JMP B,I GOTO IT * ********************************************* * IS CALLED FOR ALL TIMEOUT * * PROCESSING * ********************************************* * ** DVA ** TIMOT LDA EQT25,I CHECK FOR CN31 ENTRY CPA B32 JMP CN31B YES IT IS JSB CDINT REINITIALIZE IO CARD JSB SETEM GO ENABLE CONSOLE *** LDA B4 LDB TEM10 GET DEVICE TYPE. IF CRT/GRAPHICS ADB B.60 CHECK FOR CRT SZB,RSS CLA THIS IS A CRT DO NOT DOWN JMP CA05,I *** * ***************************************************** * IS CALLED WHENEVER AN INTERRUPT OCCURS AND* * NO PROGRAM IS SCHEDULED (I.E. USER HITS A KEY TO * * GET THE SYSTEM'S ATTENTION * ***************************************************** * * SCHED NOP JSB CLRCD GET CHAR. OFF CARD CLA STA EQT15,I SET T.O. TO 0 LDB EQT1 IS THIS THE SYSTEM CONSOLE? CPB SYSTY JMP OPFLG YES! GO SET OPERATOR FLAG LDB EQT17,I GET TERMINAL ID ADD. LDA EQT28,I IS TERMINAL ENABLED? RAR,SLA SSB YES! IT IS ENABLED JMP SCHED,I IT IS NOT STB TEMP1 *** LDB EQT4 GET ADDRESS OF THIS TERMINAL'S EQT4 STB TEM7 JSB $LIST GO SCHEDULE IF POSSIBLE OCT 601 SCHEDULE PARAMAETER TEMP1 NOP TEM7 NOP JMP SCHED,I RETURN *** * OPFLG ISZ OPATN SET OPER. ATTN. FLAG JMP SCHED,I EXIT * ************************************************* * DOES CONTROL REQUEST PROCESSING FOR * * THE KEYBOARD\DISPLAY. * ************************************************* * *******TERMINAL STATUS****************************** * BIT STATUS * * Ce 1 TERMIAL ENABLED * * 3 PARITY ERROR * BLOCK READ ONLY * 5 "CONTROL D" ENTERED * * 7 BUFFER FLUSH ENABLED * * * **************************************************** * * *******CRT CONTROL********************************** * EXEC CODE CRT CONTROL REQUEST * * 11 SPACE LINES * 20 ENABEL TERMINAL * * 21 DISABLE TERMINAL * * 22 SET TIME OUT * * 23 SET BUFFER FLUSH * * 24 REMOVE BUFFER FLUSH * * 25 UPDATE TERM. STATUS * 30 TERMINAL MODEM CONTROL * 31 MODEM LINE * * 32 AUTO ANSWER FOR MODEM * * **************************************************** * IA05C LDA EQT6,I GET CONTROL WORD LSR 6 SHIFT LDB EQT7,I SSB,RSS CMB,INB COMPLEMENT OPTIONAL PARAMETER AND B37 ISOLATE CON TROL PARAMETER * CPA B11 JMP CN11 GO SPACE LINES CPA B20 JMP CN20 GO ENABLE TERMINAL CPA B21 JMP CN21 GO DISABLE TERMINAL CPA B22 JMP CN22 GO SET TIME OUT CPA B23 JMP CN23 GO SET BUFFER FLUSH CPA B24 JMP CN24 GO REMOVE BUFFER FLUSH ** DVA *** CPA B25 GET TERMINAL STATUS JMP CN25 *** CPA B30 JMP CN30 GO SET TERMINAL MODEM CONTROL CPA B31 JMP CN31 GO SET MODEM LINE OPEN/CLOSE CPA B32 JMP CN32 * ********************REJECT REQUEST****************** CLA JMP IOR19 ** * * B11 OCT 11 LF OCT 12 B37 OCT 37 B20 OCT 20 B21 OCT 21 B22 OCT 22~ B23 OCT 23 B24 OCT 24 B25 OCT 25 B2 OCT 2 B.3 OCT 177775 B200 OCT 200 B17 OCT 17 B70 OCT 70 B30 OCT 30 DVA05 B31 OCT 31 DVA05 B.60 OCT -60 DVA05 BN61 OCT 14000 DVA05 BN67 OCT 174037 DVA05 BN68 OCT 163777 DVA05 BN73 OCT 77776 * **SPACE LINES***** **MAX NO. IS 55** * CN11 SZB,RSS CHECK FOR 0 VALUE CCB CHANGE TO -1 STB EQT7,I ADB B70 MAX NO. OF (CR,LF'S) IS 55 SSB BECAUSE CARD BUFFER IS 128 JMP REJ2 JSB CDINT MASTER RESET JSB EORP OUTPUT (CR,LF) JSB EXIT1 !!!!!!!!!!!!!!!!! JSB ENAK GIVE TERM. TIME TO PROCESS ISZ EQT7,I JMP *-5 * CN11B CLA STA EQT19,I SET A REG. EXIT JMP EOOP4 JMP EOOP4 DVA * * DVA * CN11C CLA MODEM LINE EXIT JMP CA05,I * * * **GO ENABLE TERMINAL(BIT 1 OF EQT 19)** * CN20 LDA EQT17,I IF -1 THEN NO PROG. TO SCHED. INA,SZA OR "0" INTO EQT28 IF NO PROG. LDA B2 SET BIT 1 (TERM. ENABLED) IOR19 IOR EQT28,I CONSTRUCT NEW STATUS WORD ST19 STA TEM8 STA EQT28,I RESTORE JSB STPUT PUT IT IN EQT5 JMP REJ2 GO EXIT A=2 * **GO DISABLE TERMINAL** * CN21 LDA B.3 AND19 AND EQT28,I REMOVE BIT 1 JMP ST19 * **GO SET NEW TIME OUT** * CN22 STB EQT14,I B REG. HAS NEW TIME OUT.STORE IT. JMP REJ2 * **GO SET BUFFER FLUSH (BIT 7 OF EQT28)** * CN23 LDA B200 SET BIT7 IN EQT28 JMP IOR19 * **GO REMOVE BUFFER FLUSH** * CN24 LDA BN27 REMOVE BIT 7 JMP AND19 *** UPDATE TERMINAL STATUS CN25 LDA EQT16,I AND BN73 CLEAR BIT0 AND 15 STA EQT16,I JSB TERST GET STATUS JMP CN11B *** ** DVA ** TERMINAL MODEM CONTROL** * * BITS MEANING * 0-3 BAUD RATE * 4 PARITY EVEN\ODD =1\0 * 5 w[ PARITY ON\OFF =1\0 * 8 LINE TYPE MODEM\HARD = 1\0 * CN30 CMB,INB BLF,BLS MAKE POS. AGAIN AND SHIFT LEFT 5 TO BITS 5-10,13 LDA EQT16,I AND BN67 CLR OLD INFO. IOR B STA EQT16,I JMP REJ2 * ** LINE OPEN\CLOSE ** * CN31 SZB LINE OPEN (OPT. PARM. NON ZERO) CN31C LDB BN61 LINE OPEN. BN61 IS OCT 14000 (11,12) LDA EQT16,I LINE OPEN SET CA AND CD AND BN68 CLR OLD INFO. IOR B STA EQT16,I LDA B32 SET LINE CONTROL FLAG IN EQT25 STA EQT25,I B32 IS CB,CC,CF SZB,RSS SET LINE CONTROL REF. IN CLA IN EQT 24 STA EQT24,I JSB SETIO CONFIGURE CARD CONTROL WORD 4 JSB CDSET SET CONTROL WORD 4 CN31A LDA BN31 SET TIMEOUT 2 SEC AND EXIT STA EQT15,I JSB EXIT1 JSB EXIT1 DVA * * CN31B JSB CHRIN GET MODEM LINE STATUS.IF OPEN WAIT FOR LDB EQT7,I CHECK FOR LINE CLOSE LDA TEMP9 GET CARD STATUS SZB,RSS IF LINE CLOSE MASK CC FOR 202T MODEM AND BN55 AND B32 IF OPEN LOOK FOR CB,CC,CF CPA EQT24,I JMP CN11C GOTO LINE EXIT JMP CN31A IN NOT O.K. TRY AGAIN * * CN32 LDA BN69 SET CE REF. =0 JSB OUT2 LDA ENCE ENABLE RING INT. JSB OUT2 ENABLE RING INTERRUPT STA EQT7,I SET LINE OPEN CLA CLR TIMEOUT STA EQT15,I JSB EXIT1 WAIT FOR RING CLB,INB SET FOR LINE OPEN JMP CN31C GO CHECK STATUS LINES ** * **********EQT6 FOR READ\WRITE***************** * * EQT6 FOR READ\WRITE OPERATIONS IS: * * BIT MEANING * * 6 0\1 IS ASCII\BINARY * * 8 0\1 IS OFF\ON ECHO * * 10 0\1 OFF\ON HONEST MODE * * 9 AND 10 SET USER ENABLED BLOCK READ * * ********************************************** * NLH* IA05W CLB,RSS SETUP EQT9(RUNNING CHAR. ADD.) AND I05W1 NOP EQT 10 (LAST CHAR. ADD.) LDA EQT7,I GET BUFFER STARTING ADDRESS RAL,CLE MULTIPLY S.A. BY TWO STA EQT9,I STORE AT EQT9 LDA EQT8,I GET BUFFER LENGTH CMA,SSA,INA,RSS COMPLEMENT,ARE THEY CHAR.? JMP I.W1 YES! CMA,INA MAKE POS AGAIN RAL MULTIPLY WORDS X 2 AND * I.W1 ADA EQT9,I STA EQT10,I STORE LAST CHAR. ADD. AT EQT10,I CMA,INA MAKE LAST CHAR. ADD. NEG. ADA EQT9,I - NO. OF CHAR. ARE NOW IN A REG. SZB JMP I05W1,I SZA,RSS IS IT 0 ? JMP I.W32 YES! IT IS ZERO * *** LDA TEM11 IS THIS GRAPHICS? CPA B3 SUBCHANNEL 3 JSB GRAPH *** JSB TRAN1 GOTO OUTPUT SUBROUTINE * lN LDA TEMP2 IS THIS HONEST MODE? SZA,RSS * I.W32 JSB EORP THIS IS NOT HONEST JSB EXIT1 !!!!!!!!!!!!!!!!! JSB ENAK JMP EOOP2 ABOVE NEEDED FOR INTERRUPT * * ********************************************** * WRITES TO THE DISPLAY,CTU AND PRINTER. * STARTING ADDRESS OF DATA IS EQT9,I * * "TEMP1" COUNTS THE NUMBER OF CHAR. IN ONE * * TRANSMISSION AND IS USED TO LIMIT THE TIME * * IN THE DRIVER FOR A SINGLE INTERRUPT. * * IF BUFFER IS NOT EMPTIED IN 1 CALL TO WE* * WILL WAIT FOR A BUFFER EMPTY INTERRUPT AND * * COMPLETE THE TRANSMISSION. * ************************************************** * * TRAN1 NOP LDA TRAN1 SAVE RETURN ADDRESS STA EQT19,I TRAN4 JSB XMIT SET CARD FOR XMIT LDB BN2 SET FOR 33 CHAR.MAX STB TEMP1 IN ONE TRANSMISSION * TRAN2 LDB EQT9,I GET BUFFER ADDRESS X 2 CLE,ERB DIVIDE BY TWO TO GET TRUE ADD. * LDA B,I GET WORD SEZ,RSS DO WE WANT UPPER OR LOWER CHAR.? ALF,ALF UPPER! SHIFT TO LOWER AND B377 LOWER! MASK WORD * SWH1B NOP CRT\CTU=RSS\NOP JMP TRAN3 YES! IGNORE BELOW CHECKS * * LDB FILL DO NOT SEND "ESC" TO CRT ON SZB BINARY WRITE. JMP ON1 CPA ESC IS THIS AN ESCAPE? JMP OUT6B * ON1 CLB,INB SET B REG TO 1 ADB EQT9,I ADD 1 TO EQT9 CPB EQT10,I IS THIS THE LAST WORD? RSS JMP OTA18 NO! CONTINUE LDB TEMP2 IS THIS HONEST? SZB JMP OTA18 THIS IS HONEST,IGNORE UNDERSCORE CPA B137 IS THIS A "_" UNDERSCORE? JMP EOOP8 YES! GO TO END OF OUTPUT PROCESSING JMP OTA18 TRAN3 LDB FILL IS THIS BINARY? SZB,RSS JMP OTA18 THIS IS BINARY,OUTPUT CHARACTER CPA CR IS IT A ? RSS CPLA LF IS IT A LINEFEED? RSS IT IS A CPA RS IS IT A JMP TRAN5 YES,TERMINATE ON OROR * OTA18 OTA CARD OUT6B ISZ EQT9,I INCREMENT CHAR. COUNT LDB EQT9,I GET CURRENT CHAR. ADD.R CPB EQT10,I HAVE WE SENT LAST WORD? JMP TRAN5 THIS IS THE LAST CHARACTER ISZ TEMP1 INCREMENT CHAR. COUNT. JMP TRAN2 WE HAVE NOT SENT 33 CHAR. JSB EXIT1 WE HAVE SENT 40 CHAR. *** LDA FILL CHECK FOR BINARY SZA JSB ENAK IT IS NOT JSB CDINT !!!!!! *** JMP TRAN4 NOW THAT CARD BUFFER IS EMPTY,RESTART TRAN5 LDA EQT19,I GET RETURN ADDRESS JMP A,I RETURN * * *************************************************** * DOES KEYBOARD READ. IF FIRST CHARACTER * * A "DC2" THE DRIVER EXPECTS A BLOCK TRANSFER AND * * WILL SEND A DC1 TO TRIGGER IT. IF THE FIRST * * CHAR. IS NOT A "DC2" THE DRIVER ASSUMES A CHAR. * * TRANSFER. *************************************************** * * IA05R CLB,INB JSB I05W1 GO SETUP EQT9 AND EQT10 JSB TERST GO CHECK TERMINAL STATUS LDA EQT6,I CHECK IF ECHO SET AND B400 ISOLATE BIT 8 (SET ECHO) RAR,RAR MOVE TO BIT 4 RAR,RAR JSB ECHO SET/CLR = 20/0 ECHO JSB SPCH1 SET CR AND RS INT. LDB BN9 SET RUBOUT INT. JSB CDSET LDB BN40 SET CONTROL "D" INT. JSB CDSET LDA EQT6,I CHECK FOR USER ENABLED BLOCK READ AND B3000 BITS 9,10 WILL BE SET CPA B3000 JMP C05R3 THIS IS ENABLED BLOCK READ JSB DC1OT ENABLE TRANSFER CLB,INB JSB CDSET SET CARD FOR RECEIVE,CHAR.MODE JSB EXIT1 WAIT FOR INTERRUPT * JSB CHRIN GET CHARACTER CPA B22 IS IT A DC2? JMP C05R3 FIRST CHAR. IS A DC2 * * *******THIS IS A CHARACTER TRANSFER********* * * LDA TEMP2 IS THIS HONEST? SZA JSB CLRNT CLB LDA FILL IF BINARY KEYBOARD SET FOR CHAR. REC. SZA,RSS INB IT IS BINARY KEYBOARD JSB CDSET SET BLOCK OR CHAR RECEIVE (B=0\1) LDB BN2 SET CHAR. PROCESS COUNT. FOR 33 CHAR. STB TEM9 FOR ONE INTERRUPT. JMP CHPR8 * * CLRNT NOP LDB BN56 CLR. RUBOUT INT. JSB CDSET LDB B412 CLR. CONTROL "D" INT. JSB CDSET JMP CLRNT,I * B6 OCT 6 RS OCT 36 B377 OCT 377 B137 OCT 137 CR OCT 15 BN9 OCT 57712 BN10 OCT 40000 BN13 OCT 140000 BN40 OCT 40412 B177 OCT 177 B4 OCT 4 B1400 OCT 1400 B3000 OCT 3000 B1512 OCT 1512 B3612 OCT 3612 BN56 OCT 17712 B412 OCT 412 * * ***********THIS IS A BLOCK TRANSFER********* * * C05R3 LDA EQT16,I THIS IS A BLOCK TRANSFER IOR BN10 SET BIT 14 =0/1 CHAR/BLK STA EQT16,I RESTORE SSA IS TERMINAL LINE STRAPPED? JMP C05R4 NO! IT IS PAGE STRAPPED * LDA EQT6,I CHECK FOR USER ENABLED BLOCK READ AND B3000 CPA B3000 JMP C05R5 *** LDA TEM14 GET CHAR. COUNT +1 AND B1400 IF 3 CR HAS ARRIVED CPA B1400 RSS JSB EXIT1 WAIT FOR CR JSB CHRIN GET CR *** JMP C05R5 * C05R4 LDB B1512 REMOVE CR INT. FOR PAGE (RS ONLY) JSB CDSET STRAP AND BLOCK MODE JMP C05R6 * * * WAS ADDED FOR THE 2645 * C05R8 LDB CHPC2 STB EQT11,I SAVE RETURN ADDRESS LDB FILL IF BINARY CLR ALL INTERRUPTS LDA BN20 IF ASCII DO NOT CLR SPEC. CHAR. INTERRUPT SZB LDA BN30 DO NOT CLR. SPEC. CHAR. INT. JSB OUT2 JMP STC04 * * C05R5 LDB B3612 REMOVE "RS" INT. ("CR" ONLY FOR LINE) JSB CDSET FOR ASCII CTU, LINE STRAP AND BLOCK * C05R6 JSB CLRNT CLA JSB ECHO TURN OFF ECHO JSB DC1OT TRIGGER TRANSFER C05R7 JSB EXIT1 AND WAIT FOR INTERRUPT * * ********************************************** * PROCESSES DATA ON KEYBOARD AND CTU * * READ REQUESTS. "TEM9" COUNTS THE NUMBER * * OF CHARACTERS WE HAVE PROCESSED AND IS USED* * TO LIMIT THE TIME WE ARE IN THE DRIVER. * * FOR ASCII READS THE EOR IS DETECTED BY * * LOOKING FOR THE SPECIAL CHAR. BIT SET ON * * THE 12966 CARD. * FOR BINARY EOR IS DETECTED BY THE CHAR. * * COUNT READ FROM THE TAPE. * ********************************************** * * CHPRC LDA BN2 SET CHARACTER PROCESS. COUNT TO -33 STA TEM9 CHPCC JSB CHRIN GET CHARACTER ** LDB TEM14 GET COMPLETE DATA WORD CPB B400 IF BUFFER EMPTY WAIT FOR MORE DATA JMP C05R8 SSB,RSS IF NON VALID WAIT FOR MORE JMP C05R8 ** CHPR8 LDB FILL SZB,RSS IS THIS BINARY? JMP CHPR9 YES,THIS IS BINARY * ********THIS IS ASCII******* * * * LDA TEM14 GET DATA WORD AND BN10 ISOLATE SPEC. CHAR. BIT SZA,RSS IS IT SPECIAL? JMP CHPR2 NO * SWH1C NOP SWITCH NOP\RSS =CTU\CRT JMP EOOP5 THIS IS CTU ASCII TRANSFER LDA EQT16,I GET TERMINAL STATUS AND BN13 ISOLATE PAGE(15) AND BLK(14) CPA BN13 ARE THEY BOTH SET? JMP EOOP2 YES,TERMINATE REQUEST LDA TEMP8 GET CHARACTER CPA B177 IS IT A RUBOUT? JMP RUB01 YES! GO PROCESS RUBOUT CPA B4 IS IT A CONTROL "D" (SET EOT) JMP CNTLD YES! GO SET EOT CHP9 JSB CDINT !!!!!!!!!!! JSB EORP FOR CHAR. OR LINE STRAP BLK REQUES !!!!!!! JMP EOOP1 FIRST SEND * * CHPR2 LDA EQT16,I * ** DVA LDB TEMP9 CHECK STATUS WORD FOR PARITY BLF,BLF RBL,RBL MOVE TO SIGN POSITION ** AND BN10 ISOLATE CHAR\BLK BIT SZA IS IT BLOCK MODE? JMP CHPRA YES! SKIP BELOW CHECKS ** DVA SWH1D NOP CRT\CTU=RSS\NOP JMP CHPRA GOTO CHPRA FOR CTU SSB CHECK FOR PARITY ERROR JMP RUB01 ERROR ** * LDA TEMP2 IS THIS HONEST MODE? SZA JMP CHPR9 THIS IS HONEST MODE LDA TEMP8 GET CHARACTER JMP LINFD CHAR. TRANSFER AND NOT HONEST ******************************************** * IS CALLED IF RUBOUT INTERRUPT IS * * DETECTED. IT DELETES THE CURRENT RECORD * * AND OUTPUTS (/,CR,LF). * ******************************************** * * RUB01 JSB CDINT !!!!!!!!!!!!!!! LDA B134 JSB OUT1 SEND A "\" JSB EORP GO OUTPUT JSB EXIT1 EXIT WAITING FOR BUFFER EMPTY INTERRUPT JMP IA051 RE START INPUT * LINFD CPA LF IS THIS A LINEFEED? JMP CHPRC YES,GO GET NEXT CHARACTER CPA CR IS THIS A CR ? JMP CHP9 YES! IT IS A CR,EXIT CPA B4 IS FIRST CHAR. A CONTROL "D" ? JMP CNTLD YES! * CPA B10 IS THIS A BACKSPACE RSS RSS JMP CHPR9 NO! CONTINUE LDA EQT7,I GET STARTING ADDRESS OF BUFFER RAL MULTIPLY BY 2 CPA EQT9,I ARE WE AT STARTING ADDRESS? JMP RUB01 YES! PROCESS AS RUBOUT CCB ADB EQT9,I DECREMENT CURRENT ADDRESS STB EQT9,I CLE,ERB DIVIDE BY TWO TO GET TRUE ADDRESS LDA B,I GET ADDRESS IS A REG. AND BN31 MASK HIGH END ADA FILL ADD ASCII FILL CHARACTER STA B,I RESTORE JMP CHPR6 GO GET NEXT CHARACTER * * TEMP2 NOP HONEST MODE =2000 TEMP8 NOP ASCII DATA WORD TEMP9 NOP CARD STATUS FILL NOP BINARY\ASCII = 0\40 TEM9 NOP CHAR COUNT TEM14 NOP COMPLETE DATA WORD B134 OCT 134 BN30 OCT 50037 B40 OCT 40 B60 OCT 60 OENCE OCT 10000 BN2  OCT 177737 * CNTLD LDA B40 SET BIT 5 (EOT) IOR EQT28,I IN TERMINAL STATUS STA TEM8 CLA STA EQT19,I SET AREG. EXIT JMP EOOP4 GO SET B REG. TO 0 AND EXIT * * CHPRA SSB JSB P.ERR *** *** LDA TEMP8 ** CPA B37 REMOVE "US" RSS CPA RS REMOVE "RS" JMP CHPR6 CHPR9 LDB EQT9,I GET CURRENT CHAR. ADD. CPB EQT10,I IS BUFFER FULL? JMP CHPR6 YES BUFFER FULL LDA TEMP8 GET CHARACTER LDB EQT9,I GET CHARACTER ADDRESS ISZ EQT9,I INCREMENT CLE,ERB CONVERT TO WORD ADDRESS. SEZ,RSS IF E=0 THEN EVEN AND ALF,SLA,ALF HENCE SHIFT CHAR. TO UPPER 8.SKIP XOR B,I IF ODD ADDRESS XOR WITH CHAR. XOR FILL XOR FILL TO ADD FILL IF EVEN STA B,I REPLACE FULL WORD LDB EQT9,I IS THIS THE LAST WORD? CPB EQT10,I RSS YES IT IS JMP *+5 LDA FILL IF BINARY KEYBOARD REQUEST AND BUFFER ADA TEM10 FULL THEN EXIT CPA B60 JMP EOOP2 YES! EXIT ** ** CHPR6 ISZ EQT20,I INCREMENT RECORD LENGTH COUNT.FOR RSS CTU BINARY READ ONLY. *** JMP CHPR5 THIS IS ALL FOR BINARY READ *** ISZ TEM9 INCREMENT BUFFER COUNT JMP CHPCC IF NOT ZERO GET ANOTHER CHAR. LDB CHPC2 SETUP INTERRUPT RETURN STB EQT11,I STF01 STF CARD SET FLAG FOR IMMEDIATE INTERRUPT JMP EXIT4 THIS IS ALL WE CAN PROCESS,EXIT * CHPC2 DEF CHPRC * CHPR5 LDA OENCE KILL CE INTERRUPT JSB OUT2 JMP EOOP5 *************************************************** * DOES CTU AND PRINTER REQUEST PROCESSING * *************************************************** * * * * DVA I.251 JSB LINCK * LDA TEMP4 RAR SSA,SLA JMP I.25C THIS IS CTU OR LP A CONTROL REQUEST SSA JMP I.25R THIS IK8S CTU A READ REQUEST * *********CTU OR PRINTER WRITE REQUEST********** * CLB,INB JSB I05W1 GO SET EQT9 AND EQT10 LDB FILL SZA IS CHARACTER COUNT ZERO? JMP I25W6 NO! IT IS NOT ZERO SZB,RSS IS IT BINARY JMP REJ1 EXIT WITH A=1 I25W6 SZB IF BINARY MAX LENGTH IS D 256 JMP *+3 FOR ASCII MAX LENTH IS D 254 (NEDED CR,LF) ADA B400 RSS ADA D254 THIS IS ASCII SSA LESS THAN 254 CHARACTERS JMP REJ1 IT IS NOT,THEREFORE EXIT * * JSB CTPRP GO PREP. TERMINAL FOR TRANSFER LDA B144 JSB OUT1 OUTPUT LDA FILL GET FILL CHARACTER SZA IS IT BINARY? JMP I25W2 NO! THIS IS ASCII * ***********CTU BINARY WRITE******** * LDA EQT8,I GET BUFFER LENGTH SSA,RSS IF WORDS MULTIPLY X2 RAL SSA IF CHARACTERS (-) MAKE POS. CMA,INA JSB BINAS GO CONVERT TO ASCII AND SEND * * I25W2 LDA B127 OUTPUT TO INITIALIZE CTU TRANSFER JSB OUT1 * JSB EXIT1 GO EXIT AND WAIT FOR INTERRUPT * LDA FILL IS THIS BINARY SZA,RSS JSB ENAK THIS IS BINARY,GO HANDSHAKE JSB CDINT LDB EQT8,I GET WORD COUNT SZB IS IT ZERO?(ASCII ONLY,BINARY CHECKED * JSB TRAN1 ALREADY).IT IS NOT ZERO LDA FILL GET FILL CHAR. SZA IS IT BINARY JSB EORP NO! THIS IS ASCII,WRITE A "CR,LF" I25W5 JSB EXIT1 &&&&FOR INTERRUPT JSB CDINT JSB SPCH1 JSB DC1OT GO TRIGGER STATUS REPORT JSB EXIT1 WAIT FOR INTERRUT * * JSB CHRIN GET STATUS CHARACTER * STA TEM7 JSB CLRCD GET THE "CR" LDA TEM7 CPA B106 FAILURE? JMP I25W7 YES CLA RSS I25W7 LDA B10 SET BIT 3 IN EQT5 FOR PRINT FAIL  LDB TEM10 IS THIS A PRINTER? CPB B64 JMP EOOP6 THIS IS A PRINTER JMP EOOP7 THIS IS A CTU * * D254 DEC 254 B144 OCT 144 B127 OCT 127 B163 OCT 163 B122 OCT 122 B62 OCT 62 B106 OCT 106 * * ***********THIS IS A CTU READ REQUEST******** * * CONTROL CODE FUNCTION I.25R LDB TEM10 IF READ FROM PRINTER REJECT CPB B64 JMP REJ1 LDB EQT8,I GET BUFFER LENGTH SZB,RSS IS IT ZERO? JMP CN3C YES --GO SKIP ONE RECORD CLB,INB NO!, IT IS NOT ZERO JSB I05W1 GO SET UP EQT9,EQT10 JSB CTPRP GO PREP. TERM. FOR CTU TRANSFER LDA B163 STA TEMP2 SET HONEST FLAG I25R1 JSB OUT1 OUTPUT LDA FILL IS THIS BINARY? SZA,RSS IS THIS BINARY? JMP I25R2 YES! THIS IS BINARY I25R3 LDA B122 OUTPUT JSB OUT1 JSB EXIT1 * * THIS IS ASCII JSB SPCH1 SET AND INTERRUPTS JMP C05R6 GO TRIGGER TRANSFER FOR ASCII * * ****THIS IS BINARY READ***** * I25R2 LDA B62 OUTPUT <2> I25R6 JSB OUT1 LDA B122 OUTPUT JSB OUT1 JSB EXIT1 #### JSB CDINT #### JSB SPCH1 SET FOR INTERRUPT JSB DC1OT TRIGGER BYTE COUNT JSB EXIT1 EXIT AND WAIT FOR INTERRUPT * LDA B.4 INITIALIZE TO READ 4 BYTES STA TEM9 CLA I25R5 ALF SHIFT UP STA TEMP1 AND STORE JSB CHRIN GET CHARACTER CPA RS IS IT A" RS"? JMP EOOP5 YES,THIS IS ALL AND B17 ISOLATE DATA IOR TEMP1 "OR" WITH LAST BYTE ISZ TEM9 IS THIS ALL?? JMP I25R5 NO! GET NEXT BYTE CMA,INA THIS IS ALL,COMPLEMENT STA EQT20,I STORE BINARY RECORD LENGTH. JSB CLRCD JSB CDINT !!!!!!!!!!!!!! JSB DC1OT TRIGGER TRANSFER ** DVA SWH27B NOP NOP\RSS = HARD\MODEM JMP I25R7 LDB B5 SET CHAR. RECEIVE JSB CDSET JMP C05R7 DVA * I25R7 LDA ENCE ENABLE RING INTERRUPT JSB OUT2 FOR BINARY EOR DETECTION JMP C05R7 * * * ***************************************************** * * * * * PRINTER * * 11 SPACE