ASMB,L,R,C HED SCGN0 91700-16138 REV.A 760314 * (C) HEWLETT-PACKARD CO. 1976 * NAM SCEGN,3,90 91700-16138 REV.A 760314 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 ************************************************* * *SCGN0 MAIN FOR THE SCE GENERATOR-LOADER * *SOURCE PART # 91700-18138 REV A * *REL PART # 91700-16138 REV A * *WRITTEN BY: LARRY POMATTO * *DATE WRITTEN: 11-29-74 * *MODIFIED BY: K.HAHN [ C.C.H. ] * *DATE MODIFIED: 09-23-75 [ 03-14-76 ] * *MODIFICATION: ADD CURRENT PAGE LINKING, MAP ALL, AND * COMMENTS. * [ ADD ECHO ON/OFF OPTION TO SUPPRESS COMMAND ECHO, * ADD EXTENDED-NAM PRINTOUT, ADD DVR05 PROCESSING. ] ************************************************** SPC 1 * * * THIS PROGRAM CONTROLS THE SEGMENTS * OF THE RTS GENERATOR * SPC 3 * * DEFINE ENTRY POINTS * ENT .MEM.,.MEM1,.MEM2,.MEM3,.MEM4,.MEM5,.MEM6 ENT ?XFER,ABDCB,ABL1,ABL2,ABRC1,ABREC ENT BPLOC,CKS,COMOR,FWAM,GTOUT,LISTO,LOCC ENT LOUT,LST,LST1,LST2,LST3,LST4,LST5 ENT LSTI,LSTP,LWAM,NAMR.,PACK$,PLK,PLKS ENT PNAMA,PNAME,PRAMS,PRCMD,PRINT,PUNCH,RBTA ENT RBTO,RBIN,SSTBL,UEXFL ENT IBUFR,PLK1,CMDLU,LSDCB ENT RLDCB,SWAPR,FERR,FILCK,PRMT ENT FOPEN,FCRET ENT FTRKA,NSEC,NTRK,SECTK ENT SECA,TRKA,ENDM,DSKLU,SMTLN ENT PARSB,PARSA,FCLOS,ENDLU,COML ENT PARS1,PARS2,PARS3,PARS4,PARS5 ENT PRS21,PRS31,PRS41,PRS51,INDCB ENT STKAD,P:TR,PUSH,NOPRT,LDRCD ENT SC3CD,S45CD,SWPLC,INDB3 ENT CLSFI,#ECHO ENT PRS22,PRS23,SIZE ENT EFLAG,CPLMG,CPLML SPC 2 * * DEFINE EXTERNALS * EXT LOAD,WRITF,EXEC,CLOSE EXT CREAT,OPEN,READF,CNUMD EXT .ENTR,.DFER EXT PARSE,IFBRK EXT LOCF,APOSN,NBUF9 EXT CPLEN IFN EXT DBUG XIF SPC 2 * * DEFINE A AND B REG * A EQU 0 B EQU 1 SUP SKP * * HERE IS WHERE WE START * SPC 1 START NOP CLA INITIALIZE FOR STA #ECHO ECHO OF COMMANDS. STB CMDLU IFN LDA B,I SEE IF THEY WANT THE DEBUGER CPA B6 RSS YES JMP STRT0 NO JSB DBUG DEF *+1 JSB EXEC TERMINATE...SAVE RESURCES DEF *+4 DEF B6 DEF ZERO DEF B1 JMP START XIF STRT0 JSB SWAP GO GET THE INITIAL SEGMENT DEC 3 JSB A,I GO TO SEGMENT LDA SWPLC GET INDEX TO SEGMENT TABLE STA *+2 JSB SWAP NOP SEGMENT # PLACED HERE JMP A,I UPON RETURN FROM SWAP A REG=START SPC 2 D13 DEC 13 B77 OCT 77 B400 OCT 400 NOPRT NOP ENDLU NOP UP377 OCT 177400 SKP ***** * ** PACK$ ** INSERT A WORD INTO THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * LDA WORD TO BE PLACED IN RECORD * JSB PACK$ * RETURN * * NOTE: .B. IS NOT ALTERED BY THIS SUBROUTINE ***** PACK$ NOP STA ABL1,I STORE WORD AT NEXT LOCATION ISZ ABL1 IN BUFFER, INCREASE ADDRESS. ADA CKS ADD WORD TO CHECKSUM STA CKS AND RESTORE WORD ISZ ABREC COUNT WORD JMP PACK$,I AND EXIT. SPC 1 * * ABSOLUTE RECORD BUFFER AND POINTERS * ABREC OCT 0 ABRC1 BSS 49 BUFFER FOR ABSOLUTE OUTPUT ABL1 DEF ABREC+2 HOLDS CURRENT BUFFERR ADDRESS ABL2 DEF ABREC+2 .ABR DEF ABREC CKS NOP HOLDS COMPUTED CHECKSUM SKP ***** * ** PUNCH ** OUTPUT THE RECORD IN THE ABSOLUTE RECORD BUFFER * CALLING SEQUENCE: * * JSB PUNCH * RETURN * * NOTE: THIS SUBROUTINE INSERTS CHECKSUM AND WORDCOUNT BEFORE OUTPUT ***** PUNCH NOP ENTRY/EXIT LDA CKS ADD LOAD ADDRESS TO CHECK-SUM ADA ABREC+1 AND SET RECORD SUM STA ABL1,I IN LAST WORD OF RECORD. LDA ABREC ADD 2 TO RECORD WORDCOUNT ALF,ALF POSITION AS FIRST CHAR. AND STA ABREC SET. ALF,ALF REPOSITION, ADD 3 FOR TOTAL ADA B3 LENGTH AND SET FOR STA PTEMP SAVE LENGTH JSB WRITF GO WRITE THE RECORD DEF *+5 DEF ABDCB DEF FERR DEF ABREC DEF PTEMP JSB IBUFR SET UP OUTPUT JMP PUNCH,I EXIT- SPC 1 B3 OCT 3 PTEMP NOP ***** SKP ***** * ** IBUFR ** INITIALIZE THE ABSOLUTE RECORD BUFFER (ABREC) SO IT MAY * BE FILLED UP FOR LATER OUTPUT * CALLING SEQUENCE: * JSB IBUFR * RETURN * ***** IBUFR NOP CLA ZERO OUT STA ABREC WORD COUNT STA CKS AND CHECKSUM LDA ABL2 INITIALIZE STA ABL1 NEXT WORD POINTER JMP IBUFR,I * SKP **** * * PLK ** * * PLK PUNCHES CORE FROM A TO B IN ABS FORMAT. * IF ALSO LISTS THE PUNCH BOUNDS. A, B SPECIFY THE * FINAL LOAD ADDRESS OF THE DATA. OFFSET IS * ADDED TO GET THE CURRENT CORE LOCATION. * ***** PLK NOP ENTRY: LDA,LDB,JSB. STA PLK1 INB STB PLK3 PL2 LDA MD45 INITIALIZE COUNTER STA PLK2 FOR MAX. BLOCK SIZE OF 45 WORDS. LDA PLK1 STORE LOAD ADDR. OF BLOCK STA ABRC1 IN WORD 2 OF PUNCH BUFFER PL3 LDA PLK1 ADA PLKS ADD OFFSET TO GET ACTUAL ADDRESS IN CORE LDA A,I GET WORD TO PUNCH JSB PACK$ PUT INTO BUFFER ISZ PLK1 ADD 1 TO CURRENT BLOCK ADDR. LDA PLK1 IF CURRENT BLOCK CPA PLK3 TERMINATED, GO TO JMP PL4 PUNCH LAST BLOCK. ISZ PLK2 INDEX COUNTER. JMP PL3 BUFFER NOT FILLED. JSB PUNCH BUFFER FILLED - PUNCH JMP PL2 FILL NEXT BUFFER. * PL4 JSB PUNCH PUNCH LAST BUFFER - JMP PLK,I EXIT. * PLK1 NOP HOLDS FWA PUNCH AREA PLK2 NOP HOLDS BUFFER INDEX PLK3 NOP HOLDS LWA+1 PUNCH AREA MD45 DEC -45 * SPC 2 SKP * * SEARCH SYSMBOL TABLE FORR MATCH ROUTINE * ***** * ** SSTBL ** SEARCH SYMBOL TABLE * CALLING SEQUENCE * * LDA ADDRESS OF 5 CHAR NAME TO MATCH * JSB SSTBL * RETURN1 SYMBOL NOT FOUND * RETURN2 FOUND, LST1-LST5 POINT TO MATCHED ENTRY * * NOTE: THE NAME INPUT FOR MATCH MUST START ON A WORD BOUNDARY ***** SPC 1 SSTBL NOP STB STEMP SAVE TEMPORARILY JSB LSTI INITIALIZE SYMBOL TABLE SSTB1 JSB LSTP SET LST ENTRY ADDRESSES JMP SSTBL,I END OF TABLE--ERROR RETURN LDB STEMP RETRIEVE ADDRESS OF TARGET MATCH LDA B,I CPA LST1,I CHARS. 1&2 MATCH? INB,RSS JMP SSTB1 NO--GET NEXT ENTRY LDA B,I CPA LST2,I INB,RSS JMP SSTB1 LDA B,I XOR LST3,I AND UP377 CHECK CHAR. 5 SZA JMP SSTB1 * MATCH FOUND -- MAKE SUCCESS RETURN ISZ SSTBL JMP SSTBL,I * * STEMP NOP SKP ***** * ** LSTI / LSTP ** SYMBOL TABLE ACCESSING SUBROUTINES * * PURPOSE: TO SET IN WORDS LST1 - LST5 THE * ADDRESSES OF THE FIVE WORDS IN AN * ENTRY IN THE LST (LOADER SYMBOL TABLE) * * INITIAL SETUP IS MADE BY THE ROUTINE * -LSTI- THIS SECTION INITIALIZES * THE NEGATIVE COUNT OF THE NUMBER * OF ENTRIES IN THE LST AND SETS LST5 POINTING TO * THE "-1"TH ENTRY. SPC 1 * THE SECTION -LSTP- SETS THE FIVE * ADDRESSES OF THE NEXT LST ENTRY * IN LST1-LST5. IT ALSO INDEXES THE * ENTRY COUNTER. WHEN THE COUNTER = ZERO * EXIT FROM LSTP IS TO P+1 OF THE CALL * AND LST1-LST5 CONTAIN THE ADDRESSES * FOR A NEW ENTRY. IF THE COUNT AFTER * INDEXING IS NOT ZERO, EXIT IS TO * P+2 OF THE CALL. SPC 1 * CALLING SEQUENCE: (P-1) JSB LSTI * (P) JSB LSTP * (P+1) (END OF LST RETURN) * (P+2) (NEXT ENTRY ADDRESSES * SET RETURN) SPC 2 * - INITIALIZER- SPC 1 LSTI NOP JSB BRKCK CHECK IF THEY WANT TO BREAK LDA LST GET NUMBER OF LST ENTRIES - SET CMA NEGATIVE THE VALUE + 1. STA LSTPX STORE CCA SET A =-1 ADA FWAM SET ADDRESS+1 OF WORD 1 OF FIRST STA LST5 LDA FTRKA RESET TRACK ADDRESS STA CTRKA CLA STA CSECA JSB RDSMB GO READ/WRITE SYMBOL TABLE TO DISK JMP LSTI,I EXIT SPC 2 * - PROCESSOR - SPC 1 LSTP NOP LDA LST5 GET ADDRESS FOR NEXT ENTRY ADA ENDM OVERFLOW? SSA JMP LSTP1 NO LDA CSECA YES...GET NEXT BLOCK ADA NSEC CLB SEE IF TRACK SPILL OVER DIV SECTK STB CSECA REMAINDER=SECTOR ADDRESS ADA NTRK GET TO NEXT TRACK ADA CTRKA STA CTRKA SET IN NEW TRACK ADDRESS * ADB NSEC GET LAST+1 SECTOR OF BLOCK CMB,INB ADB SECTK IF END NOT ON SSB,RSS SAME TRACK, JMP *+4 START BLOCK ON CLB NEXT TRACK STB CSECA ISZ CTRKA * JSB RDSMB GO GET SYMBOL TABLE BLOCK CCA RESET TO BEGINING OF BUFFER ADA FWAM STA LST5 LSTP1 LDA LST5 INA STA LST1 INA STA LST2 INA STA LST3 INA STA LST4 INA STA LST5 ISZ LSTPX INDEX ENTRY COUNTER. ISZ LSTP NOT END OF LST - SET P+2 EXIT JMP LSTP,I -EXIT- TO P+1 IF END OF LST. SPC 1 CSECA NOP CTRKA NOP FTRKA NOP NSEC NOP NTRK NOP SECTK NOP ENDM NOP DSKLU NOP SKP * * SUBROUTINE TO READ/WRITE SYMBOL TABLE FROM DISC * CALLING SEQUENCE * JSB RDSMB * RDSMB NOP LDA SECA GET LAST SECTOR ADDRESS LDB TRKA GET LAST TRACK ADDRESS CPA CSECA IS IT EQUAL TO CURRENT? RSS YES JMP WTSMT NO...WRITE AND READ CPB CTRKA HOW ABOUT THE TRACK ADDRESS? JMP RDSMB,I SAME THING...DON'T DO ANYTHING WTSMT JSB EXEC GO WRITE OUT CURRENT DEF *+7 DEF B2 DEF DSKLU DEF FWAM,I DEF SMTLN DEF TRKA DEF SECA JSB EXEC READ IN NEW BLOCK DEF *+7 DEF B1 DEF DSKLU DEF FWAM,I DEF SMTLN DEF CTRKA DEF CSECA LDA CTRKA STA TRKA LDA CSECA STA SECA RESET TRACK SECTOR ADDRESS JMP RDSMB,I AND RETURN SPC 1 TRKA NOP SECA NOP SMTLN NOP SKP * * ROUTINE TO HANDLE THE "PRCMD" JSB FROM THE GENERATOR * PRCMD NOP JSB SWAP DEC 1 LOAD IN LOADER JSB LOAD GO TO IT ("PRCMD" IN SEGMENT) RSS ERROR RETURN ISZ PRCMD NORMAL RETURN JSB SWAP ROLL BACK THE GENERATOR SWPLC NOP JMP PRCMD,I AND GIVE CONTROL BACK SPC 4 * * ROUTINE TO SWAP SEGMENTS * CALLING SEQUENCE * JSB SWAP * DEC SEG # 0=GENERATOR 1=LOADR * A AND B REG SAVED * SWAP NOP LDA SWAP,I GET SEG NAME MPY B3 ADA SGNMA STA SWAPA JSB EXEC ROLL IN SEGMENT DEF *+3 DEF D8 SWAPA NOP SWAPR ISZ SWAP GET RETURN ADDRESS JMP SWAP,I AND RETURN SPC 1 ABREG BSS 2 * * THE FOLLOWING ORDER MUST NOT BE CHANGED * SGNMA DEF *+1 ASC 3,SCGN1 RTC-B GENERATOR SEGMENT ASC 3,SCGN2 LOADER SEGMENT ASC 3,SCGN3 OPERATOR INTERFACE LOADER SEGMENT ASC 3,SCGN4 START UP SEGEMENT ASC 3,SCGN5 SCE3 GENERATOR SEGMENT D8 DEC 8 S45CD OCT 0 LDRCD OCT 2 SC3CD OCT 4 SKP * * SUBROUTINE TO CLOSE AND PURGE ALL FILES * CURRENTLY OPEN TO PROGRAM INCASE OF ERROR * JSB JSB GTOUT * * NOTE: * I AM CHEATING...GEORGE HAS INDICATED THAT IT * IS POSSIBLE TO PURGE A FILE IF ALL I HAVE IS * A DCB. THE WAY THIS IS DONE IS AS FOLLOWS * SET EXTENT POINTER TO 0...MAIN...GET RID OF SEMENTS * GET THE # OF SECTORS IN FILE AND DIVIDE BY 2 * TO GIVE YOU THE # OF BLOCKS. * DO A CLOSE AND TRUNCATE ALL BLOCKS, WHICH MAKES * THE FILE MANAGER ROUTINES DO EFFECTLY A PURGE. * THUS WE HAVE DONE A PURGE WITHOUT THE NAME * THIS IS DEPENDENT ON DCB MEANING...IF IT CHANGES * BYE.... * * GTOUT NOP LDA 1717B GET TO ID NAME ADA D12 ADD TO NAME STA .DFR1 SAVE FOR MOVE JSB .DFER MOVE NAME DEF ABMSG .DFR1 NOP LDA ABM1 GET TO LAST TO CHAR AND UP377 MASK OFF 6TH CHAR IOR B40 STA ABM1 SAVE ONLY 5 CHAR NAME LDA D14 GO PRINT ABORT LDB DFABM MESSAGE TO THE JSB LOUT OUTPUT LIST FILE LDA ABDCB+9 SEE IF FILE OPEN CPA 1717B THATS OUR ID SEGMENT ADDRESS RSS YES JMP GTOT1 NO CLA CLEAR OUT EXTENTS LDB ABDCB+2 SEE IF TYPE 0 SZB,RSS JMP CLSAB IT IS, DON'T PURGE FILE STA ABDCB+15 LDA ABDCB+5 GET # OF SECTORS CLE,ERA CONVERT TO BLOCKS CLSAB STA BLKS AND SAVE IT JSB FCLOS PURGE THE FILE!!! DEF *+3 DEF ABDCB DEF BLKS GTOT1 JSB FCLOS CLOSE LIST FILE DEF *+2 DEF LSDCB JSB FCLOS FCLOS RELOCATABLE INPUT FILE IF OPEN DEF *+2 DEF RLDCB JSB FCLOS CLOSE INPUT FILE DEF *+2 DEF INDCB * * AT THIS POINT ALL FILES ARE CLOSED OR PURGED * TELL WORLD WE ARE DONE * JSB EXEC PRINT OUT ABORT MESSAGE DEF *+5 DEF B2 DEF ENDLU DFABM DEF ABMSG "RTSGN ABORTED" DEF B7 JSB EXEC RELEASE TRACKS DEF *+3 DEF B5 DEF M1 JSB EXEC AND TURN OFF DEF *+2 DEF B6 SPC 1 ABMSG ASC 2, ABM1 ASC 1, ASC 4,ABORTED B1 OCT 1 B2 OCT 2 B5 OCT 5 B6 OCT 6 B7 OCT 7 M1 DEC -1 BLKS NOP D12 DEC 12 SKP * SUBROUTINE TO WRITE ON INTERACTIVE DEVICE * AND LIST FILE * CALLING SEQUENCE * JSB PRINT * A REG= SIO LENGTH WORD * B REG= ADDRESS OF MESSAGE * PRINT NOP DST ABREG SAVE A AND B REG FOR LOUT JSB BYTCN CONVERT SIO TO USUAL INB SKIP OVER LEADING SPACE ADA M1 CUT COUNT NOT INCLUDE SPACE STA PRNTA SAVE LENGTH STB PRNTB SAVE ADDRESS LDA NOPRT DO WE PRINT THIS MESSAGE? SZA JMP PRNT1 NO JSB WRITF OUTPUT MESSAGE DEF *+5 DEF INDCB TO THE INPUT DEVICE DEF FERR PRNTB NOP DEF PRNTA LENGTH PRNT1 LDA #ECHO IF BOTH THE ECHO-OFF FLAG, ADA PRMFL AND THE PROMPT FLAG CPA B2 ARE SET, JMP PRINT,I BYPASS WRITING TO LIST FILE. DLD ABREG GET LENGTH AGAIN JSB LOUT WRITE TO FILE JMP PRINT,I AND RETURN SPC 1 PRNTA NOP SPC 1 * SUBROUTINE TO CONVERT SIO LENGTH TO POSITIVE WORDS * CALLING SEQUENCE * JSB BYTCN * B REG UNCHANGED * BYTCN NOP STA BYTCA SAVE LENGTH FOR CHECKING LATTER SSA WORDS OR CHARACTERS? JMP *+3 WORDS CMA,INA CONVERT CHAR TO WORDS ARS DIVIDE BY 2+1 STA BYTCC SAVE IN DOWN COUNTER LDA LSBFA GET ADDRESS WHERE TO PUT OUTPUT STA BYTCD SAVE FOR MOVE BYTC1 LDA B,I MOVE MESSAGE STA BYTCD,I ISZ BYTCD INB ISZ BYTCC DONE? JMP BYTC1 NO LDB BYTCA WORDS OR CHARACTERS? SSB JMP BYTC2 WORDS CLE,ERB CONVERT CHARACTERS TO WORDS SEZ,RSS ODD # OF CHAR? JMP BYTC3 NO STB BYTCC YES...SAVE COUNT FOR LATTER ISZ BYTCC INCLUDE ODD CHAR ADB LSBFA GET TO END LDA B,I AND UP377 MASK OFF LOWER HALF IOR B40 OR IN A SPACE STA B,I SAVE IT LDB BYTCC GET LENGTH AGAIN BYTC3 RSS SKIP OVER COMPLEMENTING BYTC2 CMB,INB CHANGE NEG WORDS TO + WORDS LDA B GET LENGTH IN A REG LDB OTBFA GET ADDRESS OF BUFFER...INCLUDING SPACE INA INCLUDE SPACE IN COUNT JMP BYTCN,I AND RETURN SPC 1 BYTCA NOP BYTCC NOP BYTCD NOP OTBFA DEF OTBUF LSBFA DEF OTBUF+1 B40 OCT 40 SPC 1 * SUBROUTINE TO WRITE ONTO A LIST FILE * CALLING SEQUENCE * JSB LOUT * AREG = SIO LENGTH * B REG= BUFFER ADDRESS * LOUT NOP JSB BYTCN CONVERT LENGTH STA LOUTA STB LSBF SAVE BUFFER ADDRESS FOR OUTPUTING LDA LSBFA,I GET FIRST TWO USER-CHARACTERS. CPA PRMCR IF THEY ARE THE PROMPT CHARACTERS, RSS SKIP TO REPLACE THE BACK ARROW. JMP LWRT NOT THE PROMPT--NO NEED TO CHANGE. AND UP377 SAVE THE UPPER BYTE, IOR B40 AND REPLACE THE LOWER WITH A SPACE. STA LSBFA,I RESTORE THE MODIFIED PROMPT CHARACTERS. LWRT JSB WRITF WRITE THE RECORD DEF *+5 LDCBA DEF LSDCB DEF FERR LSBF NOP LIST BUFFER ADDRESS HERE DEF LOUTA JMP LOUT,I AND RETURN SPC 1 LOUTA NOP EFLAG NOP #ECHO NOP COMMAND-ECHO FLAG: 0=ON, 1=OFF. PRMCR ASC 1,-_ PROMPT CHARACTERS. SKP * * SUBROUTINE TO GET NAME * OPEN,READ AND CLOSE A RELOCATABLE * FILE. * CALLING SEQUENCE * JSB RBIN * ERROR RETURN * NORMAL RETURN * * A REG= BUFFER ADDRESS * UPON RETURN * A REG=-1 EOF OR A REG<> DATA IS THERE * LENGTH IN POSITIVE WORDS FIRST WORD * DATA RECORD * RBIN NOP STA RBINA SAVE BUFFER ADDRESS LDA RLDCB+9 SEE IF DCB OPEN CPA 1717B IS IT OPEN JMP RBOPN YES...DON'T RE OPEN JSB BRKCK SEE IF WE WANT OUT LDA PARS2 GET FILE NAME TYPE SZA IF NOT NULL JMP RBIN1 GO OPEN THE FILE LDA B5 DEFAULT IS LU 5 STA PARS2+1 SET LDA B1 SET FILE NAME TYPE STA PARS2 TO NUMERIC RBIN1 JSB FOPEN TRY TO OPEN FILE DEF *+3 DEF RLDCB DEF B300 JSB FILCK JMP RBIN,I RBOPN JSB READF READ THE FILE DEF *+6 DEF RLDCB DEF FERR DEF RBINA,I DEF D60 MAX OF 60 WORDS DEF RLEN LENGTH OF RECORD JSB FILCK SEE IF ANY ERROR JMP RBIN,I ERROR...DO ERROR RETURN ISZ RBIN GET NORMAL RETURN LDA RLEN GET LENGTH STA RBINA,I AND SAVE IN FIRST WORD CPA M1 EOF? RSS JMP RBIN,I NO JSB FCLOS YES...CLOSE FILE DEF *+3 DEF RLDCB DEF ZERO CCA TELL THEM END OF FILE JMP RBIN,I AND RETURN SPC 2 RBINA NOP RLEN NOP * * 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 LDB C4040 LDA PRS22 SZA,RSS STB PRS22 LDA PRS23 SZA,RSS STB PRS23 FOPN1 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 FERR DEF PARS2+1 NAME DEF ZERO OPEN OPTION DEF PARS3+1 SECURTIY CODE DEF PARS4+1 LOGICAL UNIT LDB ODCBA GET DCB ADDRESS CPB INDEF IS IT INPUT FILE ISZ NOPRT SET NON-ZERO(NO PRINT) 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 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 SET SET DIRECTORY JSB SET ADDRESS TO ZERO JSB SET ALSO SET TYPE TO 0 LDA PARS2+1 GET LOGICAL UNIT IOR B MERGE IN SUBFUNCTION JSB SET AND SET IN DCB JSB EXEC GET DRIVER TYPE DEF *+4 DEF D13 DEF PARS2+1 DEF EQT5 LDA EQT5 GET TYPE ALF,ALF ROTATE TO LOW A AND B77 AND MASK CPA B5 IF THE TYPE-CODE IS <05>, JSB TYPE5 THEN GO TO EXAMINE THE SUBCHANNEL. STA EQT5 SAVE THE EQUIPMENT TYPE-CODE. LDB B100 GET EOF CONTROL SUBFUNCTION ADA MD17 IF TYPE > 16 SSA,RSS JMP SEOF SET EOF CODE LDB B1000 LDA EQT5 CPA B2 IS DRIVER A PUNCH JMP SEOF GO SET LEADER GENERATION CLB SZA,RSS IF TYPE=0 DON'T DO PAGE EJECT JMP SEOF LDB B1100 LINE SPACE OPTION SEOF LDA PARS2+1 GET LU IOR B MERGE EOF CONTROL SUBFUNCTION JSB SET SET IN DCB CLA JSB SET SET NO SPACEING LEGAL LDA B1001 SET READ&WRITE LEGAL JSB SET AND SECURITY CODES AGREE JSB SET AND UPDATE MODEES AGREE LDA 1717B GET MY ID ADDRESS ISZ T0DCB INCREMENT TO WORD 9 JSB SET SET OPEN FLAG LDA T0DCB ADA B3 STA T0DCB SET TO WORD 13 CLA SET IN CORE BUFFER FLAG JSB SET TO ZERO INA JSB SET SET RECORD COUNT LDA EQT5 GET TYPE CODE LDB T0DCB GET DCB ADDRESS ADB MD15 RESET TO WORD 1 CPB INDEF IS IT THE INPUT DEVICE STA NOPRT SAVE TO INDICATE PRINT / NO PRINT ADB B4 GET TO CONTROL FUNCTION LOCATION LDB B,I GET CONTROL WORD STB SET SAVE IN TEMP LOCATION ADA MD17 IF THE EQUIPMENT TYPE-CODE SSA,RSS IS > 16 (MAG.TAPE,ETC.), JMP T0END THEN AVOID WRITING AN END-OF-FILE. JSB EXEC DO A PAGE EJECT, OR GENERATE LEADER. DEF *+4 DEF B3 DEF SET TEMP WHERE FUNCTION CODE LOCATED DEF M1 FORCE A PAGE EJECT T0END CLA SPECIFY TYPE 0 OPEN STA FERR CLEAR ERROR CODE JMP TYP0,I * SET NOP STA T0DCB,I SET IN DCB ISZ T0DCB INCREMENT TO NEXT WORD JMP SET,I * INDEF DEF INDCB T0DCB NOP EQT5 NOP MD17 DEC -17 MD15 DEC -15 B4 OCT 4 B12 OCT 12 B23 OCT 23 B37 OCT 37 B100 OCT 100 B300 OCT 300 B1000 OCT 1000 B1001 OCT 100001 B1100 OCT 1100 D60 DEC 60 * FILNM ASC 5,FILE NAME? * SKP * * SUBROUTINE TO CREATE A FILE * CALLING SEQUENCE * JSB FCRET * 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 FCRET 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 FCRET,I YES...RETURN JSB CLOSE IF NOT CLOSE FILE IF OPEN DEF *+3 DEF CDCBA,I DEF FERR JSB CREAT TRY CREATING THE FILE DEF *+8 DEF CDCBA,I DEF FERR DEF PARS2+1 DEF CSIZ,I DEF CTYP,I DEF PARS3+1 DEF PARS4+1 JMP FCRET,I