TITLE 'APLFIO-B00,10/16/73,DWG702985' SYSTEM SIG7F SYSTEM BPM PAGE * * REF'S * REF ACQCC ACQUIRE CHARACTER AND CODE REF ACQIT ACQUIRE ALPHANUMERIC ITEM U20-0004 REF ACQNB ACQUIRE NON-BLANK CHAR AND CODE U20-0005 REF ACQNXCC ACQ. NEXT CHAR. AND CODE REF ACQNXNB ACQUIRE NEXT NON-BLANK CHAR. U20-0007 REF ALOCBLK ALLOCATE DATA BLOCK REF ALOCHNW DATA BLOCK ALLOCATION ROUTINE REF BITPOS BIT MASK TABLE REF BLANKS WORD OF BLANKS REF BREAKFLG BREAK FLAG REF CKVDB CHECK DATA BLOCK VALIDITY U20-0009 REF CLOSR CLOSE AND RELEASE DCB REF CLOSV CLOSE AND SAVE DCB REF CONSTBUF CONSTANT BUFFER REF CURRKEYT CURRENT KEY IN FILE REF DREF DEREFERENCE DATA BLOCK REF DXRETURN DYADIC EXECUTION RETURN REF ERDOMAIN DOMAIN ERROR REF ERLENGTH LENGTH ERROR REF ERRANK RANK ERROR REF F:TF DCB REF FFFFFFFE MASK REF FIOABNT FIO INABN MODE FLAG REF FIOACCC ACCOUNT CONTROL WORD IN FPT REF FIOACCT ACCOUNT IN FIO FPT REF FIOBUF ADDRESS OF FIO BUFFER REF FIODCB FIO DCB ADDRESS REF FIODCBNO DCB # REF FIODCBT TABLE OF FIO DCB ADDRESSES REF FIOTIE TABLE OF FILE TIE NUMBERS U20-0011 REF FIOKEY KEY IN USE REF FIOMODE MODE CONTROL REF FIONAME REF FIOPASC FIO PASSWORD CONTROL REF FIOPASS FIO PASSWORD REF FIOREADC READ CONTROL REF FIOSIZ FIO REC SIZE REF FIOWRITC WRITE CONTROL REF FPTOPFIO FPT TO OPEN FIO FILE REF FPTOPNXT OPEN TO NEXT FILE IN ACCT REF FPTOP1ST OPEN TO FIRST FILE IN ACCT REF FPTRD1ST READ 1ST RECORD OF FILE-FOR ID REF FRSTKEYT FIRST KEY IN FILE REF GARBCOLL GARBAGE COLLECT REF GETTIME CAL TO GET TIME-DATE REF GIVEBACK GIVE BACK UNUSED MEMORY IN DB U20-0013 REF IDBUF FIO ID REC. BUFFER REF IV1 REDUCE RTARG TO SCALAR INT. OR QUIT REF J:ACCN USER ACCOUNT REF LASTKEYT LAST KEY IN FILE REF LFARG LEFT ARG ADDRESS REF NAMEBUF NAME BUFFER U20-0015 REF NONAME TEST FOR LETTER-DIGIT REF NUMFILES NO OF FIO CHANNELS REF OP1STACC ACCOUNT IN FPTOP1ST REF OP1STACT ACCT CONTROL IN FPTOP1ST REF RESULT RESULT ADDRESS REF RTARG RIGHT ARG ADDRESS REF XFFFF HW MASK REF X1FFFF ADDRESS MASK REF ZEROZERO 0,0 DW BOUND REF FIOSN SERIAL NO. ENTRIES IN FPT U20-0017 REF FIOSNC SERIAL NO. CONTROL WORD IN FPT U20-0018 REF WHATERR HOLDS INTR. I.D. 0=14T1 & NZ=14T2. REF IOERCODE I/O ERR OR ABN WD. REF ERFILEIO FILE I/O ERROR PROCESSOR. REF IDFILSPC,IDFIOERR,IDFILDAM,IDFILNAM,IDNOTAPL,IDFTFULL REF IDFILACC,IDFILTIE,IDNOPACK,IDFILIDX,IDFILBSY PAGE * * DEF'S * DEF APLFIO@ START OF PROCEDURE DEF ERRFTFIO FIO ERR ON F:TF DCB DEF FILEOPS ENTRY POINT DEF FIOERR FIO MONITOR ERROR PAGE * * STANDARD EQU'S * REGISTERS * R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * NFIOPS EQU 27 NO. OF FILE I/O OPERATIONS SAVER4 EQU CONSTBUF+12 TEMP FOR R4 U20-0021 TYPEINTG EQU 3 INTEGER DATA BLOCK TYPE PAGE * * * MODULE DESCRIPTION: * THIS MODULE CONTAINS THE PROCEDURE FOR THE APL FIO SUBSYSTEM * THE ENTRY POINT IS FILEOPS,WHICH IS REACHED BYTHE * DYADIC INTRINSIC OPERATOR FOR FILE I/O * * THIS MODULE IS PRIMARILY A UTS INTRFACE MODULE, BUT HAS BEEN * SEPARATED FROM APLUTSI TO ALLOW OVERLAY OF APLFIO * * THE CONTEXT USED BY APLFIO IS PRIMARILY IN THE CONTEXT * REGION OF APLUTSI * * EXITS FROM APLFIO ARE TO VARIOUS EXECUTION ERROR ROUTINES, * SUCH AS ERDOMAIN,ERLENGTH,ETC OR TO DXRETURN * * * FILEOPS-PRECHECKS THE ARGUMENTS AND,IF NO ERROR IS INDICATED * BRANCHES TO ONE OF 27 FILE I/O PRIMITIVE ROUTINES * * FIO1- SET A DCB # RANGE 1 TO NUMFILES * FIO2- SET FILE NAME * FIO3- SET OR RESET ACCOUNT * FIO4- SET OR RESET PASSWORD * FIO5- OPEN A DCB (SET MODE-READ CONTROL-WRITE CONTROL-INABN FLAG) * FIO6- CLOSE AND SAVE INDICATED DCG * FIO7- CLOSE AND RELEASE INDICATED DCB * FIO8- GET FIRST,CURRENT,OR LAST KEY VALUE FOR DCB * FIO9- SET CURRENT KEY (AND POSSIBLY LAST KEY) FOR DCB * FIO10-WRITE A DATA RECORD * FIO11-WRITE AN ID RECORD AND A DATA RECORD * FIO12-READ A DATA RECORD USING CURRENTKEY * FIO13-READ AN ID RECORD AND DATA RECORD-KEYED OR SEQUENTIALLY * FIO14-READ AN ID RECORD ONLY-KEYED OR SEQUENTIALLY * FIO15-DELETE RECORD WITH GIVEN KEY * FIO16-DELETE ID AND DATA RECORDS-ID REC MATCHES GIVEN KEY * FIO17-SKIP RECORD OR READ RECORD SEQUENTIALLY * FIO18-GENERATE TEXT ARRAY OF FIO FILES IN INDICATED ACCT. * FIO19-GENERATE TEXT ARRAY OF OPEN FILES OR NUMERIC VECTOR OF OPEN #'S * FIO20-SET OR RESET SERIAL NO. FOR PRIVATE PACK U20-0025 * FIO21-SET FILE ID-SINGLE PRIMITIVE FOR NAME,ACCT,PASSWORD U20-0026 * FIO22-WRITE A NON-APL DATA RECORD * FIO23-READ A NON-APL DATA RECORD USING CURRENT KEY * FIO24-READ A NON-APL DATA RECORD SEQUENTIALLY * FIO25-CONVERT TEXT VECTOR TO LOGIC VECTOR * FIO26-CONVERT TEXT VECTOR TO INTEGER VECTOR * FIO27-CONVERT TEXT VECTOR TO REAL VECTOR * PAGE APLFIO@ CSECT 1 BOUND 8 * * CONSTANTS * YEARANGE DATA 4718765,5046272 6172-1/77 (CHANGE LATER) NONEALL TEXT 'NONEALL ' FIOMBSN DATA X'0C000000'+BA(FIONAME) FIOMBSN1 DATA X'0B000001'+BA(FIONAME) U20-0028 FIOIDHDR DATA X'03010008' INTEGER VECTOR-8 WORD DATA BLOCK FIOTXMAT DATA X'02020004' X1F DATA X'1F' MASK X3F DATA X'3F' MASK XFFFFFF DATA X'00FFFFFF' MASK TO DELETE BYTE 0 KEYBYTE DATA X'03000000' MAXKEY DATA 9999998 MAXIMUM KEY VALUE PAGE * * FILEOPS-CHECKS ARGUMENTS-ERROR EXITS OR BRANCHES TO 1 OF 19 ROUTINES * FILEOPS STW,R6 WHATERR SAVE INTRINSIC IDENTIFIER. LH,R5 *LFARG CHECK LEFT ARGUMENT. LW,R4 LFARG LW,R4 2,R4 ASSUME SCALAR-CHECK VALUE BLZ FILEOP1 NEGATIVE-CHCK FOR LOGIC 1 SCALAR BEZ ERDOMAIN ZERO-NOT VALID IN ANY CASE CI,R5 X'300' POSITIVE-VERIFY INTEGER SCALAR BNE ERDOMAIN NO-ERROR CI,R4 NFIOPS RANGE TEST BLE FILEOP2 OK B ERDOMAIN NO-ERROR FILEOP1 CI,R5 X'100' CHECK-TYPE,LOGIC-RANK, 0 BNE ERDOMAIN NO LI,R4 1 YES-VALUE IS 1 FILEOP2 LB,R5 *RTARG CHECK THE RIGHT ARGUMENT CI,R5 5 CHECK IF RTARG IS DATA TYPE BG ERDOMAIN NO-ERROR LW,R15 FIOPSTBL,R4 GET VALIDITY MASK AND BRANCH ADDRESS LH,R7 R15 BGEZ FILEOPS1 NO TEST NEEDED FOR FILE-OPEN LW,R8 *FIODCB TEST IF FILE IS OPEN CW,R8 BITPOS-10 BANZ FILEOPS1 YES-OK FIOCLSD LW,R12 R4 NO-ERROR EXIT B ERRAPL FILEOPS1 CI,R7 X'4000' CHECK IF WRITE OPERATION BANZ *R15 YES-ANY RTARG IS VALID CI,R5 2 NO-CHECK DATA TYPE BE FILEOPS2 TEXT CI,R7 X'2000' NUMERIC-CHECK IF PERMITTED BAZ ERDOMAIN NO STW,R4 SAVER4 YES-SAVE R4 BAL,R14 IV1 GET INTEGER OR ERROR EXIT LW,R4 SAVER4 AI,R7 0 CHECK VALUE BLZ ERDOMAIN ERROR ON NEGATIVE RTARG B *R15 OK FILEOPS2 CI,R7 X'1000' CHECK FOR CONVERTER PRIMITIVE BANZ FIO25 YES-USE FIO25 FOR ALL 3 CI,R7 X'0800' CHECK IF TEXT PERMITTED BAZ ERDOMAIN NO LH,R5 *RTARG YES-GET TYPE AND RANK LW,R6 RTARG AI,R5 -X'201' CHECK RANK BEZ FILEOPS3 VECTOR BGZ ERRANK ARRAY LI,R8 1 SCALAR-SET LENGTH 1 LW,R9 2,R6 STD,R8 CONSTBUF SET LENGTH AND BYTE B FILEOPS4 FILEOPS3 LW,R8 2,R6 GET LENGTH OV VECTOR BLEZ ERLENGTH TOO SMALL LI,R7 BA(CONSTBUF+1) CI,R8 40 BG ERLENGTH TOO BIG STB,R8 R7 SET BYTE COUNT FOR MBS STW,R8 CONSTBUF SET BYTE COUNT FOR TEXTC AI,R6 3 WA(TEXT STRING) SLS,R6 2 BA(TEXT STRING) MBS,R6 0 FORM TEXTC IN CONSTBUF LW,R6 FIOPSTBL,R4 GET MAX TEXT LENGTH SLS,R6 -20 WHICH IS IN BYTES 5-11 AND,R6 X3F MASK OFF OTHER BITS CW,R8 R6 BG ERLENGTH TOO LONG FILEOPS4 LI,R7 -1 SET TEXT FLAG FIOPSTBL B *R15 GO TO PROPER ROUTINE GEN,1,1,1,1,1,7,20 0,0,1,0,0,0,FIO1 TIE NUMBER-INTEGER GEN,1,1,1,1,1,7,20 0,0,0,0,1,11,FIO2 NAME-TEXT GEN,1,1,1,1,1,7,20 0,0,1,0,1,8,FIO3 ACCOUNT-TEXT OR 0 GEN,1,1,1,1,1,7,20 0,0,1,0,1,8,FIO4 PASSWORD-TEXT OR 0 GEN,1,1,1,1,1,7,20 0,0,1,0,0,0,FIO5 OPEN-INTEGER GEN,1,1,1,1,1,7,20 0,0,1,0,0,0,FIO6 CLOSE-SAVE-INTEGER GEN,1,1,1,1,1,7,20 0,0,1,0,0,0,FIO7 CLOSE-REL-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO8 GET KEY-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO9 SET KEY-INTEGER GEN,1,1,1,1,1,7,20 1,1,0,0,0,0,FIO10 WRITE-ANY DATA GEN,1,1,1,1,1,7,20 1,1,0,0,0,0,FIO11 WRITE COMP-ANY DATA GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO12 READ-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO13 READ COMP-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO14 READ ID-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO15 DELREC-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO16 DELCOMP-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO17 SKIP OR READ-INTEGER GEN,1,1,1,1,1,7,20 0,0,1,0,1,8,FIO18 LIB-TEXT OR 0 GEN,1,1,1,1,1,7,20 0,0,1,0,0,0,FIO19 FNAM-FNUM-INTEGER GEN,1,1,1,1,1,7,20 0,0,1,0,1,12,FIO20 PACK NO-TEXT OR 0 GEN,1,1,1,1,1,7,20 0,0,0,0,1,40,FIO21 FID-TEXT GEN,1,1,1,1,1,7,20 1,1,0,0,0,0,FIO22 WRITE RAW-ANY DATA GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO23 READ RAW-INTEGER GEN,1,1,1,1,1,7,20 1,0,1,0,0,0,FIO24 SEQ READ RAW-INTEGER GEN,1,1,1,1,1,7,20 0,0,0,1,0,0,FIO25 CNVRT C TO L-TEXT GEN,1,1,1,1,1,7,20 0,0,0,1,0,0,FIO25 CNVRT C TO I-TEXT GEN,1,1,1,1,1,7,20 0,0,0,1,0,0,FIO25 CNVRT C TO R-TEXT * * THE FIELDS IN FIOPSTBL,ABOVE,HAVE THE FOLLOWING MEANING * * FIELD 1 (1 BIT) 1=TEST IF FILE OPEN * FIELD 2 (1 BIT) 1=WRITE OPERATION, ANY RTARG OK * FIELD 3 (1 BIT) 1=NUMERIC INTEGER OK FOR RTARG * FIELD 4 (1 BIT) 1='CONVERT' PRIMITIVE-RTARG MUST BE TEXT VECTOR * FIELD 5 (1 BIT) 1=RTARG MAY BE TEXT VECTOR OF SPECIFIED MAX LNGTH * FIELD 6 (7 BITS) MAX LENGTH IF FIELD 5=1 * FIELD 7 (20 BITS) ADDRESS OF PRIMITIVE ROUTINE * * * FI01-SET FIODCB AND FIODCBNO (INDICATES I/O STREAM FOR LATER ACTIONS) * FIO1 BLEZ ERDOMAIN STREAM NO. MUST BE POSITIVE U20-0071 LI,R3 NUMFILES SET LOOP TO LOOK FOR EXISTING TIE U20-0072 FIO1A CW,R7 FIOTIE-1,R3 CHECK FOR MATCH U20-0073 BE FIO1D SCORE U20-0074 BDR,R3 FIO1A NO-LOOP U20-0075 LI,R3 NUMFILES SET LOOP TO LOOK FOR NEW SLOT U20-0076 FIO1B LW,R5 FIOTIE-1,R3 CHECK FOR UNUSED SLOT U20-0077 BEZ FIO1C FOUND--USE IT U20-0078 BDR,R3 FIO1B LOOP U20-0079 LI,R12 3 TABLE FULL U20-0080 B ERRAPL FIO1C STW,R7 FIOTIE-1,R3 FILL NEW SLOT U20-0082 FIO1D STW,R3 FIODCBNO SET DCB NO. U20-0083 LW,R5 FIODCBT-1,R3 U20-0084 STW,R5 FIODCB SET DCB ADDRESS U20-0085 B FIOEX * * FIO2-SET FILE NAME IN FIO OPEN FPT * FIO2 BGEZ ERDOMAIN NUMERIC-INVALID LI,R6 BA(CONSTBUF)+3 SET-UP LW,R7 FIOMBSN MBS MBS,R6 0 FORM NAME IN TEXTC B FIOEX * * FIO3-SET(OR RESET) ACCOUNT IN FIO FPT * FIO3 BLZ FIO3A TEXT-SET ACCT BGZ ERDOMAIN ERROR LI,R4 BA(FIOACCC)+2 RESET ACCOUNT B FIO3OR4R (R7=0) FIO3A LI,R3 FIOACCT ACCT ADDRESS LI,R4 BA(FIOACCC)+2 ACCT CONTROL (BA) LI,R7 BA(FIOACCT) ACCT ADDRESS (BA)-FOR MBS FIO3OR4S LW,R9 CONSTBUF BYTE COUNT STB,R9 R7 SET MBS COUNT LW,R5 BLANKS STD,R5 *R3 PRE-BLANK ACCT OR PASSWORD LI,R6 BA(CONSTBUF+1) SET UPMBS MBS,R6 0 SET ACCT OR PASS LI,R7 2 FIO3OR4R STB,R7 0,R4 SET OR RESET ACCT OR PASS CONTROL B FIOEX EXIT * * FIO4-SET (OR RESET) PASSWORD IN FIO FPT * FIO4 BLZ FIO4A TEXT-SET PASS BGZ ERDOMAIN ERROR LI,R4 BA(FIOPASC)+2 0-RESET PASS B FIO3OR4R FIO4A LI,R3 FIOPASS PASS ADDRESS LI,R4 BA(FIOPASC)+2 PASS CONTROL (BA) LI,R7 BA(FIOPASS) PASS ADDRESS (BA)-FOR MBS B FIO3OR4S SET PASSWORD * * FIO5-SET FIO MODE,READ AND WRITE CONTROL AND FIOABNT FLAG- * OPEN CURRENT I/O CHANNEL IN INDICATED MODE * * ERROR IN CAL---- EXITS TO ERRFF FOR PROCESSING * * ON SUCCESS,OUT OR OUTIN, SET FIRST,CURRENT, AND LAST KEYS=1000 * IN OR INOUT,GET FIRST KEY FROM DCB,POSITION FILE * TO END,GET LAST KEY FROM DCB,REPOSITION * TO BEGINNING,SET CURRENT KEY=FIRST * FIO5 CI,R7 104 64+32+8 BG ERDOMAIN UNGOOD LW,R5 FIODCBNO CHECK IF TIE NO. EXISTS U20-0087 LW,R5 FIOTIE-1,R5 U20-0088 BLEZ FIOCLSD ERROR EXIT IF NOT U20-0089 LD,R4 ZEROZERO PRESET TO 'NONE' STW,R4 FIOABNT RESET FIOABN FLAG CI,R7 64 CHECK WRITE CONTROL BAZ FIO5A LI,R4 1 'ALL' FIO5A CI,R7 32 CHECK READ CONTROL BAZ FIO5B LI,R5 1 'ALL' FIO5B LW,R6 NONEALL,R4 STW,R6 FIOWRITC SET WRITE CONTROL LW,R6 NONEALL,R5 STW,R6 FIOREADC SET READ CONTROL AND,R7 X1F MASK OFF READ-WRITE BEZ ERDOMAIN NO IO MODE CI,R7 17 CHECK FOR INABN BNE FIO5C NO LI,R7 1 YES-SET MODE TO IN STW,R7 FIOABNT AND SET INABN FLAG B FIOSMODE FIO5C CI,R7 8 CHECK I/O MODE BE FIOSMODE OUTIN CI,R7 4 BE FIOSMODE INOUT CI,R7 2 BLE FIOSMODE IN OR OUT B ERDOMAIN INCONSISTENT I/O MODE FIOSMODE STW,R7 FIOMODE CALOPFIO CAL1,1 FPTOPFIO OPEN DCB LW,R6 FIOABNT CHECK IF INABN BNEZ FIOINABN YES-ERROR LW,R5 FIODCBNO CI,R7 10 CHECK IF OUT OR OUTIN BAZ FIOINOK NO-MUST BE IN OR INOUT FIOMPTF LW,R6 MAXKEY SET FIRST KEY FOR EMPTY FILE 20-00002 STW,R6 FRSTKEYT-1,R5 LI,R6 1 SET CURR.-LAST KEYS FOR EMPTY FILE 20-00004 STW,R6 LASTKEYT-1,R5 STW,R6 CURRKEYT-1,R5 B FIOEX FIOINABN LI,R12 0 ERROR TYPE=0 (OLD FILE) LW,R5 FIODCB DCB ADDRESS LI,R6 ERRAPL ERROR EXIT B CLOSV CLOSE AND SAVE FIOINOK RES 0 CALRDFII CAL1,1 FPTRDFIS READ 1ST RECORD BAL,R8 FIOSETKY GET KEY FROM DCB STW,R4 FRSTKEYT-1,R5 SET FIRST KEY CALFPFEX CAL1,1 FPTFPFE POSITION TO END OF FILE BAL,R8 FIOSETKY GET KEY FROM DCB STW,R4 LASTKEYT-1,R5 SET LAST KEY LW,R4 FRSTKEYT-1,R5 SET CURRENT STW,R4 CURRKEYT-1,R5 KEY=FIRST KEY CALFPFBX CAL1,1 FPTFPFB POSITION TO BEGINNING OF FILE B FIOEX * * FIO6-CLOSE AND SAVE FILE FOR INDICATED DCB # * FIO6 BAL,R6 FIONUMCK GET DCB NO. (OR ERROR EXIT) U20-0091 LI,R6 FIOEX SET EXIT B CLOSV CLOSE AND SAVE * * FIO7-CLOSE AND RELEASE FILE FOR INDICATED DCB # * FIO7 BAL,R6 FIONUMCK GET DCB NO. (OR ERROR EXIT) U20-0093 LI,R6 X'FF00' SET MASK U20-0094 AND,R6 26,R5 CHECK IF ACCT SET IN DCB U20-0095 BEZ FIO7A NO-OK U20-0096 LW,R6 J:ACCN YES-CHECK IF USERS ACCT U20-0097 LW,R7 J:ACCN+1 U20-0098 LW,R8 27,R5 (ACCT IN DCB) U20-0099 LW,R9 28,R5 U20-0100 CD,R6 R8 U20-0101 BE FIO7A OK U20-0102 BAL,R6 CLOSV NOT USERS ACCT,CLOSE AND SAVE U20-0103 LI,R12 4 SET ERROR VALUE U20-0104 B ERRAPL FIO7A LI,R6 FIOEX SET EXIT U20-0106 B CLOSR CLOSE AND RELEASE * * FIONUMCK-SEARCH DCB TABLE FOR TIE NO. IN R7-ERROR EXIT IF NOT FOUND U20-0108 * USED IN 'CLOSE' OPERATIONS ONLY-'UNTIES' FILE U20-0109 * IF FOUND,SET R5 TO ADDRESS OF DCB U20-0110 * R3 IS TABLE INDEX U20-0111 * R6 IS LINK U20-0112 * TABLE VALUE IS ZEROED U20-0113 * U20-0114 * FIONUMCK BLEZ ERDOMAIN OUT OF RANGE LI,R3 NUMFILES SET LOOP U20-0116 FIONUMC1 CW,R7 FIOTIE-1,R3 CHECK FOR TIE NUMBER U20-0117 BE FIONUMC2 FOUND U20-0118 BDR,R3 FIONUMC1 LOOP U20-0119 B FIOCLSD NOT FOUND-NO OPEN FILE U20-0120 FIONUMC2 LI,R5 0 U20-0121 STW,R5 FIOTIE-1,R3 ZERO TABLE ENTRY (FOR 'UNTIE') U20-0122 LW,R5 FIODCBT-1,R3 GET DCB ADDRESS (FOR CLOSE) U20-0123 B 0,R6 RETURN U20-0124 * * FIO8-GETS VALUE OF FIRST,CURRENT,OR LAST KEY FOR DCB * FIO8 BLEZ ERDOMAIN OUT OF RANGE CI,R7 3 BG ERDOMAIN OUT OF RANGE LW,R7 WHICHKEY-1,R7 GET KEY TABLE ADDRESS AW,R7 FIODCBNO OFFSET BY DCB # LW,R12 0,R7 GET KEY VALUE B GENSCLR GEN. SCALAR INTG DATA BLK & EXIT. WHICHKEY DATA FRSTKEYT-1 DATA CURRKEYT-1 DATA LASTKEYT-1 * * FIO9-SET CURRENT KEY FOR DCB 20-00006 * FIO9 BLEZ ERDOMAIN OUT OF RANGE BAL,R4 FIOKEYSZ CHECK IF IN KEY RANGE LW,R6 FIODCBNO GET DCB # STW,R7 CURRKEYT-1,R6 SET CURRENT KEY B FIOEX * * FIO10-WRITE A DATA RECORD WITH CURRENT KEY AND DCBNO * USES FIORECSU,IN FIO11, AND GOES TO CALWRFD IN FIO11 * TO WRITE THE RECORD * FIO10 BAL,R6 FIORECSU SET UP TO WRITE RECORD B CALWRFD * * FIO11-WRITE AN FIO ID RECORD AND A DATA RECORD * THIS MAKES UP ONE FIO-'COMPONENT' * * ERROR IN CAL---- EXITS TO ERRFF FOR PROCESSING * FIO11 BAL,R7 GETTIME LEAVES TIME IN R8-R9 USES R6-R10 BAL,R6 FIORECSU SET UP TO WRITE RECORDS-SIZE IN R7 LW,R10 J:ACCN LW,R11 J:ACCN+1 ACCOUNT IN R10-R11 LCI 5 STM,R7 FIDBUF FORM ID RECORD CALWRFI CAL1,1 FPTWRFI WRITE IT BAL,R8 FIOSETKY FIRST KEY MAY NEED UPDATE 20-00009 MTW,1 FIOKEY UPDATE KEYS CALWRFD CAL1,1 FPTWRFD WRITE DATA RECORD BAL,R8 FIOSETKY UPDATE CURRENT (AND MAYBE LAST)KEY B FIOEX * * FIORECSU-ROUTINE TO SETUP FOR WRITE OF DATA RECORD * GETS ADDRESS AND SIZE OF RTARG-CONTINUE AT- * FIORCSUA-SECOND ENTRY POINT * SETS RECORD SIZE IN BYTES * SETS KEY * R6=LINK R4,R5,R7 USED * FIORECSU LW,R5 RTARG SET-UP TO WRITE FIO RECORD STW,R5 FIOBUF ADDRESS LW,R7 *RTARG FIORCSUA AND,R7 XFFFF SLS,R7 2 FIORCSUB STW,R7 FIOSIZ SIZE IN BYTES LW,R5 FIODCBNO DCB # LW,R4 CURRKEYT-1,R5 OR,R4 KEYBYTE STW,R4 FIOKEY KEY B 0,R6 * * FIO12-READ A DATA RECORD USING CURRENT KEY * * ALSO ENTERED AT FIO14D FROM FIO13-FIO14(AFTER READING ID RECORD) * * INCLUDES ROUTINES: * FIOSETRD-SETUP FOR READ-(CALLED FROM FIO17) * * R8=LINK * * R4,R5,R6,R7,R10,R11 USED * * CALLS ALOCBLK AND FIORCSUA * FIOENDRD-SET UP RESULT AFTER READ-(CALLED FROM FIO17) * * R8=LINK * * R4,R5,R7 USED * * ERROR IN CALRDFDK EXITS TO ERRFF FOR PROCESSING * FIO14D MTW,1 CURRKEYT-1,R5 SET KEY TO READ DATA RECORD LW,R7 FIDBUF FIO12 BLEZ ERDOMAIN NO DICE LI,R8 CALRDFDK SET EXIT FROM FIOSETRD FIOSETRD AI,R7 3 ADD 3 BYTES FOR WORD BOUND 20-00012 SLS,R7 -2 SET WORD SIZE 20-00013 LW,R11 R7 20-00014 AI,R11 1 AND,R11 FFFFFFFE INSURE EVEN VALUE FOR DATA BLOCK STW,R11 CONSTBUF SAVE SIZE IN WORDS BAL,R7 ALOCBLK ALLOCATE DATA BLOCK STW,R4 RESULT SET RESULT STW,R4 FIOBUF SET READ ADDRESS LW,R7 CONSTBUF RESTORE SIZE IN WORDS BAL,R6 FIORCSUA SET SIZE IN BYTES AND KEY B *R8 RETURN CALRDFDK CAL1,1 FPTRDFDK READ RECORD LI,R8 DXRETURN SET EXIT FROM FIOENDRD FIOENDRD LH,R6 *RESULT SAVE TYPE-RANK IN R6 U20-0126 LW,R4 CONSTBUF ALLOCATED SIZE,TEMP TYPE-RANK=0 U20-0127 LI,R5 1 REF COUNT=1 U20-0128 STD,R4 *RESULT U20-0129 LI,R7 13 U20-0130 LW,R11 *FIODCB,R7 GET ACTUAL RECORD SIZE U20-0131 AI,R11 7 U20-0132 SLS,R11 -2 U20-0133 AND,R11 FFFFFFFE NO. OF WORDS,ROUNDED TO EVEN NO. U20-0134 XW,R11 CONSTBUF SWITCH WITH ALLOCATED SIZE U20-0135 SW,R11 CONSTBUF ALLOCATED SIZE-NEEDED SIZE U20-0136 LW,R4 RESULT DB POINTER U20-0137 BAL,R7 GIVEBACK RETURN UNUSED MEMORY U20-0138 STH,R6 *RESULT RESTORE ORIGINAL TYPE-RANK U20-0139 SLS,R6 -8 R6=TYPE U20-0140 LW,R4 RESULT U20-0141 LH,R7 *RESULT CHECK FOR SCALAR INTEGER 20-00045 CI,R7 X'0300' 20-00046 BNE FIOVCK NO 20-00047 STB,R5 *RESULT,R5 YES,SET TO VECTOR 20-00048 XW,R5 2,R4 SET LENGTH TO ONE 20-00049 STW,R5 3,R4 AND MOVE VALUE DOWN 20-00050 FIOVCK BAL,R7 CKVDB CHECK VALIDITY OF DATA BLOCK U20-0143 B ERRBADDB NO GOOD U20-0144 B *R8 EXIT * * FIO13-READ AN ID RECORD AND DATA RECORD-KEYED OR SEQUENTIALLY * FIO14-READ AN ID RECORD ONLY-KEYED OR SEQUENTIALLY * * COMMON CODE USED TO READ THE ID RECORD FOR EITHER ENTRY * * * ERROR IN CAL---- EXITS TO ERRFF FOR PROCESSING * * IF SEQUENTIAL,FIO14C DOES THE READ * * FIOSETKY-GETS KEY FROM DCB,SETS AS CURRENT KEY * * (CALLED FROM FIO5 AND FIO17) * * R8=LINK * * R4,R5 USED * * FIO14B-CHECKS ID RECORD FOR APPARENT VALIDITY * -SIZE =20 BYTES * -TIME WORD IN REASONABLE RANGE * DAY #173 OF YEAR #72 TO DAY #0 OF YEAR #77 * THIS TEST SHOULD ELIMINATE ESSENTIALLY ALL FALSE FIO ID RECRDS * * FIO14B THEN CHECKS IF ENTRY WAS FOR ID RECORD ONLY OR 'COMPONENT' * IF COMPONENT, GOES TO FIO14D * IF ID RECORD ONLY, FORMS RESULT AND EXITS * FIO13 RES 0 FIO14 BEZ FIO14C SEQUENTIAL READ BAL,R4 FIOKEYSZ RANGE CHECK KEY LW,R5 FIODCBNO GET DCB H STW,R7 CURRKEYT-1,R5 SET CURR KEY OR,R7 KEYBYTE STW,R7 FIOKEY AND FIOKEY CALRDFIK CAL1,1 FPTRDFIK READ ID RECORD FIO14B LI,R4 8 CHECK ID RECORD FORMAT LI,R12 1 ERROR CODE=0,SUBCODE=1 LH,R14 *FIODCB,R4 SLS,R14 -1 CHECK ARS AI,R14 -20 IF NOT 20,ERROR EXIT BNEZ ERRAPL LW,R14 FIDBUF+1 CHECK TIME WORD CLM,R14 YEARANGE IF NOT IN REASONABLE BCS,9 ERRAPL LW,R14 SAVER4 CHECK IF U20-0146 CI,R14 13 ID ONLY BEZ FIO14D NO-PROCEED TO READ DATA RECORD LI,R11 8 YES-CREATE BAL,R7 ALOCBLK TEXT DATA BLOCK STW,R4 RESULT FOR ID REC LW,R5 FIOIDHDR AS RESULT LI,R6 1 MOVE DATA REF COUNT=1 LI,R7 5 AND HEADER LENGTH=5 LCI 5 TO ALLOCATED LM,R8 FIDBUF DATA BLOCK LCI 8 STM,R5 *R4 B DXRETURN * FIO14C RES 0 CALRDFIS CAL1,1 FPTRDFIS READ SEQUENTIAL-LOOK FOR ID REC. LI,R8 FIO14B SET EXIT FROM FIOSETKY FIOSETKY LW,R4 FIODCB LW,R4 10,R4 GET KEY FROM DCB LW,R4 *R4 AND,R4 XFFFFFF MASK OFF BYTE 0 LW,R5 FIODCBNO STW,R4 CURRKEYT-1,R5 SET IN CURRKEYT CW,R4 LASTKEYT-1,R5 BLE FIOSK1 20-00016 STW,R4 LASTKEYT-1,R5 FIOSK1 CW,R4 FRSTKEYT-1,R5 CHECK FIRST KEY 20-00018 BGE *R8 20-00019 STW,R4 FRSTKEYT-1,R5 SET NEW FIRST KEY 20-00020 B *R8 * * FIO15-DELETE A RECORD WITH INDICATED KEY * * ERROR IN CALDELR EXITS TO ERRFF FOR PROCESSING * FIO15 BAL,R4 FIOMODCK CHECK FOR MODE AND KEY U20-0148 BAL,R4 FIOKEYSZ CHECK RANGE OR,R7 KEYBYTE STW,R7 FIOKEY SET KEY CALDELR CAL1,1 FPTDELR DELETE RECORD CALFPFBD CAL1,1 FPTFPFB POSITION TO BEGINNING OF FILE 20-00022 B FIOINOK GET NEW FIRST AND LAST KEYS 20-00023 * * FIO16-DELETE 'COMPONEMT'-ID REC AND DATA REC WITH INDICATED KEY * TRIES TO DELETE DATA RECORD FIRST,THEN ID REC * * ERROR IN CALDELR1 EXITS TO ERRFF FOR PEOCESSING * FIO16 BAL,R4 FIOMODCK CHECK FOR MODE AND KEY U20-0150 AI,R7 1 GET KEY OF DATA RECORD BAL,R4 FIOKEYSZ CHECK RANGE OR,R7 KEYBYTE STW,R7 FIOKEY SET KEY CALDELR1 CAL1,1 FPTDELR DELETE DATA RECORD MTW,-1 FIOKEY BACK UP TO ID RECORD B CALDELR DELETE IT * U20-0152 * FIOMODCK-CHECK FOR NEGATIVE KEY OR NON-UPDATE MODE ON DELETE OPER. U20-0153 * R4=LINK,R5 AND R6 USED U20-0154 * U20-0155 FIOMODCK BLEZ ERDOMAIN BAD KEY VALUE U20-0156 LI,R6 5 U20-0157 LB,R5 *FIODCB,R6 GET MODE FROM DCB U20-0158 SLS,R5 -1 U20-0159 AI,R5 -4 U20-0160 BEZ 0,R4 UPDATE-RETURN U20-0161 LI,R12 20 OTHER MODE-SET ERROR CODE B ERRAPL * * FIO17-READ DATA RECORD SEQUENTIALLY OR SKIP RECORD * * ERROR IN CALRDFDS EXITS TO ERRFF FOR PROCESSING * FIO17 BGZ FIO17A CALFPR CAL1,1 FPTFPR SKIP RECORD BAL,R8 FIOSETKY SET CURRENT KEY FROM DCB B FIOEX FIO17A BAL,R8 FIOSETRD SET UP FOR SEQ. READ(+UNUSED KEY) CALRDFDS CAL1,1 FPTRDFDS READ SEQUENTIAL DATA BAL,R8 FIOENDRD CLEAN UP ALLOCATED DATA BLOCK BAL,R8 FIOSETKY SET CURRENT KEY FROM DCB B DXRETURN RETURN * * FIO18-FORM TEXT ARRAY OF FILES IN INDICATED ACCOUNT * FILES LISTED ARE THOSE WHOSE FIRST RECORDS APPEAR * TO BE PROPERLY FORMATTED FIO ID RECORDS, AND FILES * WHICH ARE PASSWORDED OR READ PROTECTED * * ERROR IN CAL---- EXITS TO ERRFF FOR PROCESSING * * FIO18 CALLS GARBCOLL AND PERFORMS DATA BLOCK EXTENSION BECAUSE * THE SIZE OF THE RESULT CANNOT BE PREDETERMINED * FIO18 BGZ ERDOMAIN CHECK IF NUMERIC-YES-QUIT BEZ %+2 ZERO-OK-RESET ACCT. LI,R7 2 TEXT-SET ACCT LI,R6 2 STB,R7 OP1STACC,R6 SET OR RESET ACCOUNT CONTROL LW,R5 BLANKS STD,R5 OP1STACT PRESET ACCT DATA TO BLANKS AI,R7 0 CHECK IF ACCT INDICATED BEZ FIO18A NO-LEAVE BLANKS LI,R6 BA(CONSTBUF+1) LI,R7 BA(OP1STACT) LW,R8 CONSTBUF STB,R8 R7 MBS,R6 0 SET ACCT DATA-WITH TRAILING BLANKS FIO18A BAL,R8 GARBCOLL GARBAGE COLLECT-CONTIGUOUS SPACE LI,R11 4 NEEDED FOR TEXT DATA BLOCK BAL,R7 ALOCBLK GET 1ST 4 WORDS-WILL BE EXTENDED LW,R7 FIOTXMAT STW,R7 *R4 SET UP AS TEXT MATRIX-4 WORDS STW,R4 RESULT SET AS RESULT LI,R7 0 STW,R7 2,R4 SET # OF ROWS=0 LI,R7 24 STW,R7 3,R4 SET # OF COLUMNS=24 AI,R4 2 STW,R4 CONSTBUF SAVE POINTER TO # OF ROWS CALFION1 CAL1,1 FPTOP1ST B CALFIOR1 FIONXTF LI,R5 F:TF BAL,R6 CLOSV MTW,0 BREAKFLG CHECK FOR BREAK BNEZ DXRETURN YES(OR HANGUP)-CLEAR OUT CALFIONX CAL1,1 FPTOPNXT OPEN NEXT FILE CALFIOR1 CAL1,1 FPTRD1ST READ 1ST RECORD LH,R14 F:TF+4 CHECK ARS SLS,R14 -1 AI,R14 -20 BNEZ FIONXTF NOT AN FIO ID REC. LW,R14 FIDBUF+1 CHECK TIME WORD CLM,R14 YEARANGE BCS,9 FIONXTF NOT AN FIO ID REC LI,R0 X'40' BLANK FIO18B LI,R11 6 GET AN EXTENSION TO DATA BLOCK BAL,R7 ALOCBLK MTW,6 *RESULT UPDATE TRU DATA BLOCK SIZE MTW,1 *CONSTBUF AND # OF ROWS LD,R6 OP1STACT STORE STD,R6 *R4 ACCOUNT LW,R7 BLANKS SLS,R4 -1 DW ALIGNMENT STD,R7 2,R4 PREBLANK STD,R7 4,R4 NAME FIELD LI,R6 BA(F:TF+23)+1 SOURCE ADDRESS-NAME LW,R7 R4 SLS,R7 3 BYTE ALIGNMENT AI,R7 10 DESTINATION ADDRES LB,R8 F:TF+23 BYTE COUNT STB,R8 R7 MBS,R6 0 MOVE NAME SLS,R4 3 BA ALIGNMENT AI,R4 22 OFFSET TO END OF NAME STB,R0 0,R4 STORE BLANK OR ASTERISK B FIONXTF GO TO NEXT FILE * * FIO19-FORMS TEXT ARRAY OF CURRENTLY OPEN FILE-ACCT-NAMES * OR INTEGER VECTOR OF CURRENTLY OPEN DCB NO'S * FIO19 BLEZ ERDOMAIN AI,R7 -2 RANGE TEST BGZ ERDOMAIN TOO BIG-QUIT LI,R6 1 LI,R5 0 PRESET ITEM COUNT FIO19A LW,R8 FIODCBT-1,R6 GET DCB ADDRESS LW,R8 *R8 CHECK IF OPEN CW,R8 BITPOS-10 BAZ FIO19B NO AI,R5 1 YES-KICK ITEM COUNT STW,R6 CONSTBUF+1,R5 STORE DCB # FIO19B AI,R6 1 CI,R6 NUMFILES BLE FIO19A LOOP STW,R5 CONSTBUF+1 SAVE ITEM COUNT AI,R7 0 CHECK WHICH OPTION BLZ FIO19C TEXT AI,R5 4 NUMBERS B FIO19D FIO19C MI,R5 5 TEXT TAKES 5 WORDS/ACCT-NAME U20-0165 AI,R5 5 AND IS ARRAY (RANK 2) FIO19D AND,R5 FFFFFFFE LW,R11 R5 BAL,R7 ALOCBLK GET THE DATA BLOCK STW,R4 RESULT MTW,-2 CONSTBUF BLZ FIO19E LI,R7 X'0301' INTEGER VECTOR STH,R7 *R4 SET TYPE AND RANK LW,R5 CONSTBUF+1 GET COUNT U20-0167 BNEZ FIO19S BRANCH IF NOT EMPTY U20-0168 STW,R5 2,R4 EMPTY-INDICATE IT U20-0169 B DXRETURN U20-0170 FIO19S LW,R6 CONSTBUF+1,R5 SWITCH FROM U20-0171 LW,R6 FIOTIE-1,R6 DCB NUMBERS U20-0172 STW,R6 CONSTBUF+1,R5 TO TIE NUMBERS U20-0173 BDR,R5 FIO19S LOOP U20-0174 LW,R5 CONSTBUF+1 GET COUNT AI,R5 1 +1 SCS,R5 -4 LC R5 LM,R5 CONSTBUF+1 GET COUNT+VALUES STM,R5 2,R4 STASH IN RESULT B DXRETURN RETURN FIO19E LI,R7 X'0202' TEXT-MATRIX STH,R7 *R4 SET TYPE-RANK LI,R6 20 NO. OF COLUMNS U20-0176 STW,R6 3,R4 LW,R7 CONSTBUF+1 STW,R7 2,R4 # OF ROWS BEZ DXRETURN QUIT IF EMPTY LI,R5 1 FIO19F LW,R6 CONSTBUF+1,R5 POINT TO DCB TABLE LW,R6 FIODCBT-1,R6 THEN TO DCB AI,R6 23 THEN TO NAME LW,R9 BLANKS STD,R9 R10 BLANK R9-R11 STD,R9 R12 BLANK R12-R13 U20-0178 LI,R7 X'FF00' MASK U20-0179 AND,R7 3,R6 CHECK IF ACCT SPECIFIED U20-0180 BEZ FIO19G NO U20-0181 LW,R9 4,R6 YES-SET UP R9-R10 U20-0182 LW,R10 5,R6 U20-0183 FIO19G LB,R8 *R6 BYTE COUNT OF NAME U20-0184 SLS,R6 2 BA(NAME)-1 AI,R6 1 SOURCE ADDRESS FOR MBS LI,R7 45 BA(R11)+1,DESTINATION ADDRESS U20-0186 STB,R8 R7 COUNT MBS,R6 0 FORM NAME+TRAILING BLANKS IN R11-R13U20-0188 LCI 5 U20-0189 STM,R9 4,R4 LOAD ACCT-NAME IN DATA BLOCK U20-0190 AI,R4 5 UPDATE R4 U20-0191 AI,R5 1 AND POINTER CW,R5 CONSTBUF+1 LOOP BLE FIO19F B DXRETURN DONE * * FIOKEYSZ-CHECK FOR VALID KEY NUMBER * R4=LINK,R7 USED BUT NOT CHANGED * FIOKEYSZ CW,R7 MAXKEY BLE 0,R4 B ERDOMAIN * U20-0193 * FIO20-SET(OR RESET) SERIAL NUMBER FOR PRIVATE PACKS U20-0194 * U20-0195 FIO20 BLZ FIO20A TEXT-SET SERIAL NO. U20-0196 BGZ ERDOMAIN ERROR U20-0197 LI,R4 BA(FIOSNC)+2 RESET SERIAL NO. CONTROL U20-0198 B FIO3OR4R (R7=0) U20-0199 FIO20A LI,R3 FIOSN SERIAL NO. ADDRESS U20-0200 LI,R4 BA(FIOSNC)+2 SN CONTROL WORD COUNT U20-0201 LI,R7 BA(FIOSN) SERIAL NO. ADDRESS U20-0202 LW,R9 CONSTBUF GET COUNT U20-0203 STB,R9 R7 SET UP FOR MBS U20-0204 LW,R5 BLANKS U20-0205 STD,R5 *R3 U20-0206 STW,R5 2,R3 PRE-BLANK FIOSN U20-0207 LI,R6 BA(CONSTBUF+1) U20-0208 MBS,R6 0 LOAD FIOSN U20-0209 LW,R7 CONSTBUF GET COUNT AGAIN U20-0210 AI,R7 3 ROUND UP TO U20-0211 SLS,R7 -2 NO. OF WORDS U20-0212 B FIO3OR4R USE 'RESET' TO SET CONTROL WORD U20-0213 * U20-0214 * FIO21-ESTABLISHES FILE ID (NAME-ACCT-PASSWORD) AS SINGLE PRIMITIVE U20-0215 * U20-0216 FIO21 BGEZ ERDOMAIN RTARG MUST BE TEXT U20-0217 LW,R5 BLANKS U20-0218 STD,R5 FIOACCT RESET ACCOUNT AND PASSWORD U20-0219 STD,R5 FIOPASS U20-0220 LI,R9 0 U20-0221 LI,R6 BA(FIOACCC)+2 U20-0222 LI,R7 BA(FIOPASC)+2 U20-0223 STB,R9 0,R6 U20-0224 STB,R9 0,R7 U20-0225 LW,R5 CONSTBUF U20-0226 LI,R8 X'15' U20-0227 STB,R8 CONSTBUF+1,R5 SET CR AT END OF TEXT U20-0228 LI,R1 BA(CONSTBUF+1) SET TO SCAN U20-0229 BAL,R4 ACQNB GET FIRST NON-BLANK IN TEXT U20-0230 FIO21A BAL,R14 ACQIT ACQUIRE ALPHANUMERIC VALUE U20-0231 AI,R5 0 U20-0232 BEZ FIO21E QUIT IF EMPTY U20-0233 CLM,R3 NONAME CHECK IF NEXT ITEM IS ALPHANUMERIC U20-0234 BCR,9 FIO21B NO U20-0235 AI,R9 0 YES-CHECK IF ACCT ALREADY SET U20-0236 BNEZ FIO21E YES-ERROR U20-0237 CI,R5 8 CHECK SIZE U20-0238 BG FIO21E U20-0239 LD,R8 NAMEBUF U20-0240 STD,R8 FIOACCT SET ACCOUNT U20-0241 LI,R9 2 U20-0242 STB,R9 0,R6 U20-0243 B FIO21A LOOP FOR NAME U20-0244 FIO21B CI,R5 11 NAME ITEM U20-0245 BG FIO21E TOO LONG U20-0246 STB,R5 FIONAME U20-0247 LI,R4 BA(NAMEBUF) MOVE NAME TO U20-0248 LW,R5 FIOMBSN1 FIONAME IN TEXTC U20-0249 MBS,R4 0 U20-0250 CI,R2 ':' CHECK FOR PASSWORD U20-0251 BE FIO21C YES U20-0252 CI,R2 '.' CHECK FOR ACCT U20-0253 BNE FIO21X NO U20-0254 BAL,R4 ACQNXNB MAYBE U20-0255 CI,R2 '.' U20-0256 BE FIO21C NO-PASSWORD ONLY U20-0257 BAL,R14 FIOAORP YES-GET ACCOUNT U20-0258 STD,R8 FIOACCT U20-0259 LI,R9 2 U20-0260 STB,R9 0,R6 U20-0261 BAL,R4 ACQNB GET NON-BLANK U20-0262 CI,R2 '.' CHECK FOR PASSWORD U20-0263 BE FIO21C YES U20-0264 FIO21X CI,R2 X'15' CHECK FOR CR U20-0265 BE FIOEX U20-0266 FIO21E LI,R12 21 SET ERROR CODE U20-0267 B ERRAPL FIO21C BAL,R4 ACQNXNB PROCESS PASSWORD U20-0269 BAL,R14 FIOAORP U20-0270 STD,R8 FIOPASS U20-0271 LI,R9 2 U20-0272 STB,R9 0,R7 U20-0273 B FIO21X U20-0274 * U20-0275 FIOAORP AI,R1 -1 U20-0276 LW,R8 BLANKS U20-0277 LW,R9 BLANKS PRESET R8-R9 TO BLANKS U20-0278 LI,R5 -1 U20-0279 FIOAORP1 AI,R5 1 U20-0280 BAL,R4 ACQNXCC GET NEXT CHAR. U20-0281 CI,R2 X'40' BLANK U20-0282 BE FIOAORP2 YES-QUIT U20-0283 CI,R2 '.' PERIOD U20-0284 BE *R14 YES-QUIT U20-0285 CI,R2 ',' COMMA U20-0286 BE *R14 YES-QUIT U20-0287 CI,R2 X'15' CR U20-0288 BE *R14 YES-QUIT U20-0289 STB,R2 R8,R5 STASH BYTE U20-0290 CI,R5 7 HOW MANY U20-0291 BG FIO21E TOO MANY U20-0292 B FIOAORP1 LOOP U20-0293 FIOAORP2 BAL,R4 ACQNXNB SKIP TRAILING BLANKS U20-0294 B *R14 * * FIO22-WRITES APL DATA WITHOUT HEADER INFORMATION FOR EXTERNAL * FILE CREATION. WRITES KEYED FILE. * SIZE IS ACTUAL SIZE OF DATA EXCEPT FOR LOGIC VALUES,WHICH * ARE ROUNDED UP TO BYTES(MULTIPLES OF 8 BITS) * INDEX SEQUENCES ARE CONVERTED TO INTEGER VECTORS PRIOR TO * OUTPUT. * FIO22 LB,R5 *RTARG R5=DATA TYPE CI,R5 5 BE FIO22F INDEX SEQ-NEEDS TO BE EXPANDED FIO22A LI,R7 1 LB,R6 *RTARG,R7 R6=RANK LW,R4 RTARG START OF DATA BLOCK HEADER AI,R4 2 SKIP 2 HEADER WORDS AW,R4 R6 SKIP LENGTH WORDS CI,R5 4 IS DATA TYPE REAL BNE FIO22B NO AI,R4 1 YES-ROUND TO DW BOUND AND,R4 FFFFFFFE FIO22B STW,R4 FIOBUF WORD ADDRESS-OUTPUT BUFFER LI,R4 2 LI,R7 1 ASSUME SCALAR AI,R6 0 CHECK IF IT IS BLEZ FIO22D YES FIO22C MW,R7 *RTARG,R4 NO-COMPUTE NO. OF UNITS AI,R4 1 BDR,R6 FIO22C LOOP FIO22D EXU FIO22I-1,R5 CONVERT FROM NO. OF UNITS TO BYTES FIO22E LI,R6 CALWRFD SET EXIT FROM FIORCSU B FIORCSUB COMPLETE PROCESSING FIO22F LW,R5 RTARG LW,R11 2,R5 LENGTH OF INDEX SEQUENCE AI,R11 1 +1 FOR LENGTH WORD BAL,R7 ALOCHNW ALLOCATE DATA BLOCK FOR INTEGER VECT XW,R4 RTARG R4= ADDR OF ISEQ DB,RTARG =NEW DB LW,R5 RTARG R5= ADDR OF NEW DB LI,R11 X'0301' STH,R11 *RTARG SET TYPE AND RANK LW,R11 2,R4 LENGTH STW,R11 2,R5 BEZ FIO22H EMPTY LW,R8 3,R4 BASE VALUE FIO22G AW,R8 4,R4 INCREMENT VALUE STW,R8 3,R5 STORE INTEGER VECTOR ELEMENT AI,R5 1 BDR,R11 FIO22G LOOP FIO22H BAL,R7 DREF DROP THE INDEX SEQUENCE LI,R5 3 SET INTEGER TYPE B FIO22A AND OUTPUT THAT BLOCK FIO22I B FIO22J LOGIC VALUE NOP CHARACTER SLS,R7 2 INTEGER SLS,R7 3 REAL FIO22J AI,R7 7 ROUND LOGIC UP SLS,R7 -3 DIVIDE BY 8 B FIO22E * * FIO23-READ A DATA RECORD OF NON-APL FORM USING CURRENT KEY * RESULT IS A CHARACTER VECTOR WITH LENGTH=ARS * PRIMITIVES 25,26, AND 27 USED TO CONVERT CHARACTER * VECTOR RESULT TO LOGIC,INTEGER,OR REAL IF REQUIRED * FOR PROPER DATA REPRESENTATION. * FIO23 BLEZ ERDOMAIN AI,R7 12 ADD 3 WORDS FOR HEADER BAL,R8 FIOSETRD USE NORMAL SETUP FOR READ LI,R8 -12 AWM,R8 FIOSIZ ADJUST TO READ BEYOND HEADER MTW,3 FIOBUF CALRDRDK CAL1,1 FPTRDFDK READ KEYED RECORD LI,R8 DXRETURN SET EXIT FROM FIOENDRR FIOENDRR LW,R4 CONSTBUF ALLOCATED NUMBER OF WORDS LI,R5 X'0201' CHARACTER VECTOR ID STH,R5 R4 LI,R5 1 REF COUNT=1 LI,R6 13 LW,R6 *FIODCB,R6 R6=ARS LCI 3 STM,R4 *RESULT SET UP HEADER AI,R6 19 ARS+HEADER+DW ROUND SLS,R6 -2 AND,R6 FFFFFFFE SIZE OF BLOCK ACTUALLY NEEDED LW,R11 CONSTBUF SIZE ALLOCATED SW,R11 R6 SURPLUS LW,R4 RESULT BAL,R7 GIVEBACK RETURN IT B *R8 EXIT * * FIO24-READ SEQUENTIALLY,NON-APL DATA RECORD * SIMILAR TO FIO23 BUT NOT KEYED READ * FIO24 BLEZ ERDOMAIN AI,R7 12 ADD 3 WORDS FOR HEADER BAL,R8 FIOSETRD USE NORMAL SETUP FOR READ LI,R8 -12 AWM,R8 FIOSIZ ADJUST TO READ DATA ONLY MTW,3 FIOBUF CALRDRDS CAL1,1 FPTRDFDS SEQUENTIAL READ BAL,R8 FIOENDRR PROCESS RESULT BAL,R8 FIOSETKY SET KEY (IF ANY) B DXRETURN EXIT * * FIO25-CONVERT CHARACTER VECTOR TO LOGIC VECTOR * FIO26(EQU FIO25) INTEGER VECTOR * FIO27(EQU FIO25) REAL VECTOR * FIO25 LH,R5 *RTARG CI,R5 X'0201' CHECK IF TEXT VECTOR BNE ERRANK NO-RANK ERROR LW,R3 RTARG LW,R11 2,R3 CHECK LENGTH FOR CONFORMABILITY CW,R11 FIO25T1-25,R4 (0,3,OR 7) BANZ ERLENGTH LENGTH NOT CONFORMABLE LW,R6 R4 SAVE PRIMITIVE NO. IN R6 LW,R5 1,R3 REF COUNT OF RTARG AI,R5 -1 BEZ FIO25D DATA BLOCK IS REUSEABLE INT,R11 0,R3 NOT REUSEABLE,GET NEW BLOCK BAL,R7 ALOCBLK STW,R4 RESULT SET RESULT FIO25A INT,R11 0,R3 LENGTH OF DATA BLOCK AW,R4 R11 POINT 1 PAST END OF RESULT AW,R3 R11 POINT 1 PAST END OF RTARG CI,R6 27 CHECK IF CONVERT TO REAL BNE FIO25B NO AI,R3 -1 YES-SET FOR OFFSET FIO25B AI,R11 -3 SUBTRACT HEADER WORDS FIO25C AI,R3 -1 MOVE DATA AI,R4 -1 FROM RTARG LW,R7 0,R3 TO RESULT, STW,R7 0,R4 OFFSETTING IF BDR,R11 FIO25C RESULT IS REAL. LW,R3 RTARG LW,R4 RESULT B FIO25E FIO25D MTW,1 1,R3 REUSE RTARG-INCREMENT REF COUNT LW,R4 RTARG STW,R4 RESULT SET RESULT=RTARG CI,R6 27 CHECK IF REAL BE FIO25A YES-OFFSET DATA FIO25E LW,R7 FIO25T2-25,R6 STH,R7 *RESULT SET TYPE-RANK LW,R7 2,R3 GET LENGTH EXU FIO25T3-25,R6 ADJUST TO NEW TYPE STW,R7 2,R4 B DXRETURN EXIT FIO25T1 DATA 0,3,7 FIO25T2 DATA X'0101',X'0301',X'0401' FIO25T3 SLS,R7 3 SLS,R7 -2 SLS,R7 -3 * PAGE * * FPT'S FOR FILE I/O SUBSYSTEM FOLLOW: * * EXCEPTIONS: FPTOPFIO-IN CSECT 0 OF APLUTSI * FPTOP1ST-IN CSECT 0 OF APLUTSI * FPTOPNXT-IN CSECT 1 OF APLUTSI * FPTRD1ST-IN CSECT 1 OF APLUTSI * * * ERROR EXIT 'EQUATES'-ERRFF IS COMMON ACTUAL FIO ERROR ADDRESS ABNFPR EQU ERRFF ABN-SKIP RECORD ERRRDFI EQU ERRFF READ ID REC-ERR ABNRDFI EQU ERRFF READ ID REC-ABN ERRRDFD EQU ERRFF READ DATA REC-ERR ABNRDFD EQU ERRFF READ DATA REC-ABN ERRWRFI EQU ERRFF WRITE ID REC-ERR ABNWRFI EQU ERRFF WRITE ID REC-ABN ERRWRFD EQU ERRFF WRITE DATA REC-ERR ABNWRFD EQU ERRFF WRITE DATA REC-ABN * FPTRDFIS-FPT TO READ ID-FIO RECORD-SEQUENTIALLY * FPTRDFIS GEN,1,7,7,17 1,X'10',0,FIODCB DCB ADDRESS-INDIRECT DATA X'F4000010' P1,2,3,4,6 AND WAIT DATA ERRRDFI ERR (P1) DATA ABNRDFI ABN (P2) DATA FIDBUF BUF (P3) DATA FIDSIZ SIZ (P4) DATA 0 BTD (P6) FIDSIZ EQU 20 BYTES PER FID RECORD FIDBUF EQU IDBUF * * FPTRDFIK-FPT TO READ KEYED FIO-ID RECORD * FPTRDFIK GEN,1,7,7,17 1,X'10',0,FIODCB DATA X'FC000010' P1,2,3,4,5,6 AND WAIT DATA ERRRDFI ERR (P1) DATA ABNRDFI ABN (P2) DATA FIDBUF BUF (P3) DATA FIDSIZ SIZ (P4) DATA FIOKEY KEY (P5) DATA 0 BTD (P6) * * FPTRDFDS-FPT TO READ FIO RECORD-SEQUENTIALLY * FPTRDFDS GEN,1,7,7,17 1,X'10',0,FIODCB DCB ADDRESS-INDIRECT DATA X'F4000010' P1,2,3,4,6 AND WAIT DATA ERRRDFD ERR (P1) DATA ABNRDFD ABN (P2) GEN,1,31 1,FIOBUF BUF (P3) GEN,1,31 1,FIOSIZ SIZ (P4) DATA 0 BTD (P6) * * FPTRDFDK-FPT TO READ FIO DATA RECORD-KEYED * FPTRDFDK GEN,1,7,7,17 1,X'10',0,FIODCB DCB ADDRESS-INDIRECT DATA X'FC000010' P1,2,3,4,5,6 AND WAIT DATA ERRRDFD ERR (P1) DATA ABNRDFD ABN (P2) GEN,1,31 1,FIOBUF BUF (P3) GEN,1,31 1,FIOSIZ SIZ (P4) DATA FIOKEY KEY (P5) DATA 0 BTD (P6) * * FPTWRFI-WRITE FIO ID RECORD * FPTWRFI GEN,1,7,7,17 1,X'11',0,FIODCB DCB ADDRESS-INDIRECT DATA X'FC000070' P1,2,3,4,5,6+WAIT,NEWKEY,ONEWKEY DATA ERRWRFI ERR (P1) DATA ABNWRFI ABN (P2) DATA FIDBUF BUF (P3) DATA FIDSIZ SIZ (P4) DATA FIOKEY KEY (P5) DATA 0 BTD (P6) * * FPTWRFD-WRITE FIO DATA RECORD * FPTWRFD GEN,1,7,7,17 1,X'11',0,FIODCB DCB ADDRESS-INDIRECT DATA X'FC000070' P1,2,3,4,5,6+WAIT,NEWKEY,ONEWKEY DATA ERRWRFD ERR (P1) DATA ABNWRFD ABN (P2) GEN,1,31 1,FIOBUF BUF (P3) GEN,1,31 1,FIOSIZ SIZ (P4) DATA FIOKEY KEY (P5) DATA 0 BTD (P6) * * FPTDELR-DELETE RECORD-KEYED * FPTDELR GEN,1,7,7,17 1,X'0D',0,FIODCB DCB ADDRESS-INDIRECT DATA X'80000000' P1 DATA FIOKEY KEY * * FPTFPFB-POSITION TO BEGINNING OF FILE * FPTFPFB GEN,1,7,7,17 1,X'1C',0,FIODCB DCB ADDRESS-INDIRECT DATA 16 * * FPTFPFE-POSITION TO END OF FILE * FPTFPFE GEN,1,7,7,17 1,X'1C',0,FIODCB DCB ADDRESS-INDIRECT DATA 0 * * FPTFPR-SKIP RECORD -FORWARD * FPTFPR GEN,1,7,7,17 1,X'1D',0,FIODCB DCB ADDRESS-INDIRECT DATA X'C0000000' P1,2 FORWARD DATA 1 SKIP 1 RECORD DATA ABNFPR ABN * PAGE * * FIOERR-FILE I/O MONITIOR ERROR PROCESSOR * FIOERR RES 0 ERRFF STW,R10 IOERCODE RECORD LATEST ERR OR ABN CONDITION. LH,R12 R10 GET ERROR CODE AND SUBCODE SLS,R12 -1 SHIFT OUT EXTRA BIT AND,R8 X1FFFF MASK ERROR ADDRESS CI,R12 3*128 CHECK FOR FILE NOT FOUND BNE ERRFF1 NO MTW,0 FIOABNT YES-CHECK FOR INABN MODE BNEZ FIOEX YES-NORMAL EXIT ERRFF1 CI,R8 CALRDFII+1 CHECK IF READ FOR 'OPEN' 20-00025 BE ERRFF4 YES 20-00026 CI,R8 CALRDFDS+1 NO-CHECK IF READ ERROR 20-00027 BE ERRFF2 YES CI,R8 CALRDFDK+1 MAYBE BE ERRFF2 YES CI,R8 CALRDRDS+1 MAYBE BE ERRFF2 YES CI,R8 CALRDRDK+1 MAYBE BE ERRFF2 YES CI,R8 CALRDFIS+1 CHECK IF SEQUENTIAL ID REC READ BNE ERRFF3 NO CI,R12 7*128 YES-CHECK IF RECORD TOO BIG BNE ERRFF3 NO B CALRDFIS YES-KEEP ON READING ERRBADDB LI,R12 2 ERROR CODE=0,SUBCODE=2 LI,R10 X'40000' FAKE SAME CODES FOR R10. ERRFF2 LW,R6 CONSTBUF ERROR ON READ,SET PROPER 20-00029 LI,R7 1 SIZE AND REF COUNT 20-00030 STD,R6 *RESULT IN RESULT DATA BLOCK 20-00031 LI,R4 0 SET TO DEREF 20-00032 XW,R4 RESULT DEREFERENCE THE RESULT BLOCK BAL,R7 DREF ERRFF3 STW,R10 IOERCODE SAVE CODE, SUBCODE, (MAYBE) DCB LOC. LW,R11 WHATERR SHOULD APL PROCESS THE ERROR... BNEZ HANDLERR YES (14 T-BAR 2 WAS THE INTRINSIC) GENSCLR LI,R11 4 NO (14 T-BAR 1 WAS THE INTRINSIC). BAL,R7 ALOCBLK ALLOCATE DATA BLOCK LI,R11 TYPEINTG INTEGER TYPE STB,R11 *R4 FIOEX1 STW,R12 2,R4 STW,R4 RESULT SET RESULT B DXRETURN ERRFF4 LW,R5 FIODCBNO SET STREAM NO. 20-00034 CI,R12 6*128 CHECK IF EOF 20-00035 BE FIOMPTF YES-EMPTY FILE 20-00036 CI,R12 7*128 CHECK IF RECORD TOO BIG 20-00037 BE CALRDFII+1 YES-NOT ID RECORD-OK 20-00038 B ERRFF3 NO-REAL ERROR 20-00039 * * ERRFTFIO-MONITOR CALL ERROR ON F:TF (FIO18) * ERRFTFIO CI,R8 CALFION1+1 CHECK IF OPEN OF 1ST FILE BE ERRFTFN1 YES-TREAT SAME AS NEXT FILE OPEN CI,R8 CALFIONX+1 CHECK IF NXTF OPEN BE ERRFTFN1 YES- CI,R10 7 NO-MUST BE READ,CHECK IF BE FIONXTF RECORD TOO BIG LI,R0 '*' SET '*' FLAG B FIO18B NO-PROBABLY TIED,LIST IT ERRFTFN1 CI,R10 2 CHECK IF LAST FILE BE DXRETURN YES-QUIT LI,R0 '*' SET '*' FLAG B FIO18B NO-ASSUME PROTECTED AND LIST IT * * FIOEX-EXIT WITH EMPTY VECTOR RESULT * FIOEX LI,R11 4 BAL,R7 ALOCBLK LI,R11 X'0301' INTEGER VECTOR' STH,R11 *R4 LI,R12 0 B FIOEX1 * * ERRAPL-FILE I/O ERR DETECTED BY APL, NOT BY THE MONITOR. * ERRAPL LW,R10 R12 COPY APL-ERROR (SUBCODE). FAKE THE SLS,R10 17 I/O ERR CODE WD: CODE=0, B ERRFF3 SUBCODE=APL-ERR, DCB ADDR = 0. PAGE * * THE 'CASECODE' & 'CASEID' TABLES ARE IN 1-TO-1 CORRESPONDENCE. * CASECODE CONSISTS OF HALFWDS CONTAINING AN I/O ERR OR ABN VALUE, * CODE & SUBCODE. THESE HEX CODES OCCUPY BITS 1-8 & 9-15 * RESPECTIVELY, WITH BIT 0 OF THE HALFWD ZEROED (NOTE THE GEN'S). * CASEID IS A MATCHED SET OF BYTES CONTAINING INTERNAL ERROR I.D. * VALUES FOR EACH CODE & SUBCODE OF INTEREST. * BOUND 4 CASECODE GEN,1,8,7 0,X'FF',X'7F' 0 (NEVER USED) GEN,1,8,7 0,0,0 1 GEN,1,8,7 0,0,21 2 GEN,1,8,7 0,0,1 3 GEN,1,8,7 0,0,2 4 GEN,1,8,7 0,0,3 5 GEN,1,8,7 0,0,4 6 GEN,1,8,7 0,0,20 7 GEN,1,8,7 0,X'03',0 8 GEN,1,8,7 0,X'14',0 9 GEN,1,8,7 0,X'14',X'01' 10 GEN,1,8,7 0,X'56',0 11 GEN,1,8,7 0,X'06',0 12 GEN,1,8,7 0,X'0D',0 13 GEN,1,8,7 0,X'42',0 14 GEN,1,8,7 0,X'43',0 15 GEN,1,8,7 0,X'57',0 16 GEN,1,8,7 0,X'75',0 17 GEN,1,8,7 0,X'75',X'01' 19 GEN,1,8,7 0,X'75',X'02' 19 GEN,1,8,7 0,X'75',X'03' 20 GEN,1,8,7 0,X'75',X'04' 21 GEN,1,8,7 0,X'75',X'05' 22 GEN,1,8,7 0,X'75',X'06' 23 GEN,1,8,7 0,X'20',X'01' 24 GEN,1,8,7 0,X'20',X'02' 25 GEN,1,8,7 0,X'20',X'03' 26 GEN,1,8,7 0,X'20',X'04' 27 GEN,1,8,7 0,0,5 28 GEN,1,8,7 0,0,6 29 GEN,1,8,7 0,0,7 30 GEN,1,8,7 0,0,8 31 GEN,1,8,7 0,0,9 32 GEN,1,8,7 0,0,10 33 GEN,1,8,7 0,0,11 34 GEN,1,8,7 0,0,12 35 GEN,1,8,7 0,0,13 36 GEN,1,8,7 0,0,14 37 GEN,1,8,7 0,0,15 38 GEN,1,8,7 0,0,16 39 GEN,1,8,7 0,0,17 40 GEN,1,8,7 0,X'2E',0 41 GEN,1,8,7 0,X'44',0 42 GEN,1,8,7 0,X'51',X'00' 43 GEN,1,8,7 0,X'25',0 44 SPACE NCASES EQU HA(%)-HA(CASECODE) # SPEC.CASES OF INTEREST. SPACE * NOTE -- CASEID TABLE MUST MATCH CASECODE TABLE. SPACE BOUND 4 I.D. FOR: CASEID DATA,1 IDFIOERR 0 FILE I/O ERR DATA,1 IDFILNAM 1 FILE NAME ERR DATA,1 IDFILNAM 2 DATA,1 IDFILDAM 3 FILE DAMAGE DATA,1 IDNOTAPL 4 NOT APL FILE DATA,1 IDFTFULL 5 FILE TBL FULL DATA,1 IDFILACC 6 FILE ACCESS ERR DATA,1 IDFILACC 7 DATA,1 IDFILNAM 8 FILE NAME ERR DATA,1 IDFILACC 9 FILE ACCESS ERR DATA,1 IDFILBSY 10 FILE IN USE DATA,1 IDFILSPC 11 FILE SPACE TOO LOW DATA,1 IDFILIDX 12 FILE INDEX ERR DATA,1 IDFILIDX 13 DATA,1 IDFILIDX 14 DATA,1 IDFILIDX 15 DATA,1 IDFILSPC 16 FILE SPACE TOO LOW DATA,1 IDFILDAM 17 FILE DAMAGE DATA,1 IDFILDAM 18 DATA,1 IDFILDAM 19 DATA,1 IDFILDAM 20 DATA,1 IDFILDAM 21 DATA,1 IDFILDAM 22 DATA,1 IDFILDAM 23 DATA,1 IDNOPACK 24 PRIVATE PACK UNAVAIL, CALL OPR. DATA,1 IDNOPACK 25 DATA,1 IDNOPACK 26 DATA,1 IDNOPACK 27 DATA,1 IDFILTIE 28 FILE TIE ERR DATA,1 IDFILTIE 29 DATA,1 IDFILTIE 30 DATA,1 IDFILTIE 31 DATA,1 IDFILTIE 32 DATA,1 IDFILTIE 33 DATA,1 IDFILTIE 34 DATA,1 IDFILTIE 35 DATA,1 IDFILTIE 36 DATA,1 IDFILTIE 37 DATA,1 IDFILTIE 38 DATA,1 IDFILTIE 39 DATA,1 IDFILTIE 40 DATA,1 IDFILTIE 41 DATA,1 IDFILTIE 42 DATA,1 IDFILTIE 43 DATA,1 IDFILTIE 44 SPACE BOUND 4 PAGE * * HANDLERR-ENTERED ON ERROR IF THE 'ERROR-HANDLING' VERSION OF THE * FILE I/O INTRINSIC (14 T-BAR 2) IS CURRENTLY APPLICABLE. * * R10 CONTAINS THE ERROR CODE (BITS 0-7) & SUBCODE (BITS 8-14). * HANDLERR SLS,R10 -17 GET ONLY CODE & SUBCODE. LI,R1 NCASES = NO.OF ERROR CASES TO CK. CASECHK CH,R10 CASECODE,R1 DOES CODE,SUBCODE MATCH A SPEC.CASE BNE NEXTCASE NO. B CASEHIT YES. NEXTCASE BDR,R1 CASECHK LOOP TILL R1=0 (JUST 'FILE I/O ERR') CASEHIT LB,R2 CASEID,R1 GET ERROR I.D. FOR THIS CASE. B ERFILEIO EXIT TO HANDLE ERR PROCESSING. END