ASMB,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 NOP 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 SIZE TO 128 CPB .2 IF TYPE TWO SIZE MUST BE GIVEN SSA,RSS SIZE GIVEN? RSS YES; OR NOT TYPE TWO SKIP JMP ER4 ELSE ERROR CREA3 STA 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 DEF 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 741205 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. * * *************************************************************** * 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 MODULE OF THE * RTE FILE MANAGEMENT PACKADGE. * * CALLING SEQUENCE: * * CALL NAMF(IDCB,IERR,NAME,NNAME,IS,ILU) * * WHERE: * IDCB IS A 144 WORD DATA CONTROL BLOCK * THIS AREA IS FREE AFTER THE CALL. * * IERR IS THE ERROR RETURN LOCATION * ERRORS ARE RETURNED HERE AND IN * THE A REGISTER. * DEFINED ERRORS ARE: * * * 0 NO ERROR * -1 DISC DOWN * -2 DUPLICATE NAME * -6 CARTRIDGE OR FILE NOT FOUND * -7 INVALID SECURITY CODE * -8 FILE CURRENTLY OPEN * -10 NOT ENOUGH PARAMETERS * -13 THE REQUIRED DISC IS LOCKED * -15 ILLEGAL NEW NAME * * NNAME THE NEW 6 CHARACTER FILE NAME * * IS OPTIONAL - THE FILE SECURITY CODE * * ILU OPTIONAL - THE FILES DISC ID. * * PRECEEDING CONSTANTS * N7 DEC -7 .7 DEC 7 N10 DEC -10 SPC 3 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,I 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 ASC 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