FILEPROCS MODULE INCLUDE SMACS AREAPROPS AREATYPE=PLT,PUBLIC=0 INCLUDE XMACS INCLUDE DBMACS &OPTIONE AWORD B'27' *AS PUT INTO OPTIONMASK BY SETOPTIONS *CTVS AND MACROS FOR FILE PACKAGE UNLISTG SUBTITLE 1 *FORNAT OF FILE BLOCK &FILENUMBER AWORD 0 &FILENAME AWORD 1 &FILEUS AWORD (&FILENAME+4) &FILESTATUS AWORD (&FILEUS+2) &FILEMARGIN AWORD (&FILESTATUS+1) &FILEROUTE AWORD (&FILEMARGIN+1) &FILECURR AWORD (&FILEROUTE+1) &FILEBUFFER AWORD (&FILECURR+2) &FILEBUFDR AWORD (&FILEBUFFER+2) *ACTUAL BUFFER DESC &FILEENDGOTO AWORD (&FILEBUFDR+2) &FILERECNUMB AWORD (&FILEENDGOTO+1) &FILEHDLENG AWORD (&FILERECNUMB+1) SUBTITLE 1 *STATUS BITS FOR FILE STATUS &NULLSTATUS AWORD 0 &FILEMODEIN AWORD 1 &FILEMODEOUT AWORD 2 &ASSDSTATUS AWORD 4 &SELDSTATUS AWORD 8 &ATENDSTATUS AWORD 16 &FILEMODEDEL AWORD 32 *DELETE OPERATION SUBTITLE 1 *OTHER ATVS &MAXFILEBLKS AWORD 16 *MAX NO OF FILES &FBTSZ AWORD (&MAXFILEBLKS*2) *FILE BLOCK TABLE SIZE &FILEBUFSIZE AWORD 132 *MAX BUFFER SIZE &FILEDEFMARG AWORD 80 &FILEBLKSIZE AWORD (&FILEBUFSIZE+4/4+&FILEHDLENG) *INCLUDE EOL CHAR &MFBSIZE AWORD (&MAXFILEBLKS*&FILEBLKSIZE) *SIZE OF FILE BLOCK SPACE &FILEERRNUMB AWORD 1 *FILE ERROR NUMBERS START AT THIS &ENDOFLINE AWORD 21 *END OF LINE CHAR SUBTITLE 12 *AN EXTENDABLE SEGMENT IS USED TO CONTAIN THE *FILE BLOCKS EACH OF WHICK CONTAINS INFORMATION *ABOUT A FILE NUMBER. * ITITIALLY 3 FILE BLOCKS ARE CREATED, 2 FOR FILE *0 (THIS IS A SPECIAL) AND ONE FOR -1 THE SYSTEM FILE. * FILEBLKSPACE CONTAINS A DESCRIPTOR TO THIS SEGMENT. * A SUBSIDUARY TABLE FILEBLKTAB CONTAINS 2 WORD *ITEMS, THE FIRST IS THE FILE NUMBER, THE SECOND THE ADDRESS *OF THE CORRESPONDING FILE BLOCK. THIS IS SUPERFLUOUS IN THE CURRENT *SCHEME AS FILE BLOCKS ARE ALLOCATED SEQUENTIALLY AND ONLY *RELEASED AS A WHOLE. NFILEBLKS CONTAINS THE *NUMBER OF ENTRIS IN FILEBLKTAB. CDATA FILEDATA RESTOFFORMAT LWORD *DESC TO REMAINDER OF FORMAT FORMAT LWORD *DESC TO WHOLE FORMAT INUSING WORD *NONZERO IF IN PRINT USING NFILEBLKS WORD *CURRENT NO OF FILE BLOCKS ALLOCATED INPUTFILE WORD *POINTER TO CURRENT INPUT FILE BLOCK OUTPUTFILE WORD *POINTER TO CURRENT OUPUT FILE BLOCK JLINELIMIT INT *LINE LIMIT FOR JOURNAL OUTPUT INTERACTIVE INT *SET NONZERO IF I-O ROUTES EQUAL OPTIONMASK WORD *BIT MAP OF SETOPTIONS *BIT 0=A ETC FILEBLKSPACE LWORD *DESC TO SPACE CONTAINING FILE BLOCKS FILEBLKTAB W(&FBTSZ) *TABLE OF FILE NUMBER AND FILE BLOCK ADDRESS *PARAM PAIRS FOR CREATE AREAF NEED 3 FILE BLOCKS TO START WITH DATA AREAPROPS AREATYPE=DATA,PUBLIC=0 CAPARAMS WORD(6) 1,(&FILEBLKSIZE*4*3/1024+1*1024), -6,1, -7,(&MFBSIZE*4/1024+1*1024), ULPPARAMS WORD(2) 1,0 SUBTITLE 1 *FILE PROCS MACROS FILEERREXIT MACRO FILEERREXIT LISTG &0 LSS &FILEERRNUMB UNLISTG SET &FILEERRNUMB,(&FILEERRNUMB+1) EXIT MEND CHAPTER AREAPROPS AREATYPE=CODE,PUBLIC=1 INPUTNL PROC SUBTITLE 2 * ------------------- INPUTNL ------------- *INPUT NEW LINE FROM CURRENT INPUT FILE REMOVES TRAINING SPACES LOCAL CURR LWORD *INPUT FILE CURRENCY FBUFF LWORD *CURRENT INPUT BUFFER SPACE PPSDR LWORD PROMPTDR LWORD NUMBER INT *FILE NUMBER BUFLEN INT *INPUT BUFFER LENGTH CODE SUBTITLE 1 *SETUP LOCALS FROM FILE BLOCK LXN INPUTFILE LSS.X &FILENUMBER ST NUMBER LSD.X &FILECURR ST CURR *RECORD CURRENCY LD.X &FILEBUFFER *DR TO BUFFER SPCCE LDB.X &FILEMARGIN *SET MARGIN STD FBUFF *SAVE IN LOCAL LSS.X &FILESTATUS *SEE IF AT END OF FILE RESTOREXNB AND &ATENDSTATUS JNZ FILEATEND SUBTITLE 1 *CREATE PARAMETER PAIRS ON STACK FOR READ ACCESS CREATEPPS PPSDR,5,(VEC,FBUFF), -6,(REF,BUFLEN,(&WV+1)), SUBTITLE 1 *SEE IF PROMPT NEEDED LSS NUMBER *FILE NUMBER JNZ NOTINTER *NOT FILE ZERO LSS INTERACTIVE JZ NOTINTER *NOT FILE 0 OR NOT INTERACTIVE *USE PROMPT IF THERE IS ONE IN OUTPUTFILE LXN OUTPUTFILE LB.X (&FILEBUFDR+1) SBB.X (&FILEBUFFER+1) JZB NOPROMPT LD.X &FILEBUFFER *GET DR TO PROMPT LDB.X &FILEMARGIN STD.X &FILEBUFDR *RESET BUFFER DR TO EMPTY LDB.B LSS 9 ST.T *ADD PROOMPT PARAM PAIR TO STACK STD.T LD PPSDR *INCREASE LENGTH OF PPS DR LDB (&PPSLEN+3) *FOR PROMPT STD PPSDR NOTINTER NOPROMPT DOREAD RESTOREXNB LSD PPSDR LD CURR DOACCESS ASF (-&PPSLEN) ICP X'603' *SEE IF END OF FILE JE EOF JP GETOFF *REMOVE TRAILING SPAES LD FBUFF LDTB (&BV+&BCI) *BECAUSE MIGHT MODD TO END LDB BUFLEN SCAN STD.T *SEEIF REST OF BUFFER IS SPACES SWEQ X'0',C' ' JE ATEND MODD 1 *SKIP NON SPACE ASF -2 *DELETE DR ON STACK J SCAN ATEND LB.T *ADDRESS OF START OF TRAILING SPS ASF -1 *SKIP REST OF DR LDA.B LSS &ENDOFLINE *END OF LINE CJARACTER ST.D SBB.L (R'FBUFF+1) *START ADDRESS ADB (&BV+1) *INCLUDE END OF LINE CHAR LSS.L (R'FBUFF+1) LUH.B *TRYE AND BOUND LXN INPUTFILE *SET DR IN FILE BLOCK ST.X &FILEBUFDR ISB 1/0 *IGNORE END OF LINE CHAR ST FBUFF *INCREMENT RECORD NUMBER LSS.X &FILERECNUMB IAD 1 ST.X &FILERECNUMB RESTOREXNB *IF NOT INTERACTIVE (BUT CHANNEL 0) OUTPUT RECORD JUST READ *TO OUTPUTFILE LSS NUMBER JNZ FINISH LSS INTERACTIVE JNZ FINISH *SEE IF ECHO OPTION HAS BEEN SWITCHED OFF BT SETOPTION E LSS OPTIONMASK AND &OPTIONE JNZ FINISH #HLCALL .OUTSTR,CP,(FBUFF) #HLCALL .OUTPUTNL *IF ERROR RESPONSE TREAT AS END OF INPUT FIOLE JP EOF FINISH LSS 0 *OK RESPONSE GETOFF EXIT EOF LXN INPUTFILE *SET AT END BIT IN STATUS LSS.X &FILESTATUS OR &ATENDSTATUS ST.X &FILESTATUS RESTOREXNB FILEERREXIT FILEATEND FILEERREXIT SETSUBS OUTPUTNL PROC SUBTITLE 3 * --------------- OUTPUTNL ---------------- *OUTPUT NL TO CURRENT FILE * RESET FORMAT DR IN CASE PRINT USING LOCAL CURR LWORD *OUPUT FILE RECORD CURRENCY FBUFF LWORD RESTOFBUF LWORD *DYNAMIC BUFFER DR CODE *RESET PRINT-USING FORMAT DESCRIPTORS LSD FORMAT ST RESTOFFORMAT SUBTITLE 1 *GET INFO FROMFILE BLOCK LXN OUTPUTFILE LSD.X &FILECURR ST CURR LSD.X &FILEBUFDR ST RESTOFBUF LD.X &FILEBUFFER STD FBUFF LDB.X &FILEMARGIN STD.X &FILEBUFDR *RESET DYNAMIC BUFFER DR *INCREMENT NUMBER OF RECORD READ LSS.X &FILERECNUMB IAD 1 ST.X &FILERECNUMB RESTOREXNB *CALCULATE BUFFER LENGTH LB.L (R'RESTOFBUF+1) SBB.L (R'FBUFF+1) LD FBUFF JNZB NOTZERO *BEWARE ZERO LENGTH RECORDS *OUTPUT 1 SPACE RECORD LSS C' ' ST.D LB 1 NOTZERO LDB.B STD FBUFF *NOW OUTPUT THE LINE CREATEPPS ,5,(VEC,FBUFF),12,X'81' LD CURR DOACCESS ASF (-&PPSLEN) EXIT SETSUBS INITFILES PROC SUBTITLE 5 * ------------- INITFILES ------------- *OPEN 3 STANDARD FILES FOR DEFAULT INPUT AND OUTPUT *AND FOR COMPILER FILE ACCESS *IF THIS IS NOT THE FIRST ENTRY THEN CALL CLOSEFILE TO CLOSE *ALL THE FILES BUT 0 AND -1 THEN SET NFILEBLKS TO 3 LOCAL SPACEDR LWORD FILEBLKTABDR LWORD CODE LSS NFILEBLKS JZ FIRSTENTRY #HLCALL .CLOSEFILE,CP,(B'0') *CLOSE ALL BUT 0 AND -1 LB 3 STB NFILEBLKS EXIT *RESPONSE IN ACC FROM CLOSEFILE CALL FIRSTENTRY *MARK SEGMENT DECRIPTOR AS UNALLOCATED LSD 0 ST FILEBLKSPACE *ALLOCATE SEGMENT FOR FILE BLOCKS *PUT DR IN FILEBLKSPACE #HLCALL .CREATEAREA,CP,(0,0), -RW,(CAPARAMS,FILEBLKSPACE) JNZ TOEXIT *ERROR LSD D'FILEBLKTAB ST FILEBLKTABDR *IF IN MAC MAKE SURE THAT INPUT & OUTPUT IF NOT *ALREADY ASSIGNED ARE SET TO SOURCE. SOURCEASSIGN C'INPUT',C'OUTPUT' SUBTITLE 2 *CREATE FILE BLOCK FOR INPUT *& OPEN INPUT FILE DUMP FILEBLKSPACE LD FILEBLKSPACE *SET TO WORD VECTOR LDTB (&WV+&FILEBLKSIZE) STD SPACEDR LSS 0 *FILE NUMBER SLSD C'INPU'/C'T ' SLSS 1 *NO OF FILE BLOCKS JLK SETUP #HLCALL .OPENFILE, -CP,(0,&FILEMODEIN,SPACEDR) JNZ TOEXIT *ERROR RESPONSE LSS.L (R'SPACEDR+1) *SET CURRENT INPUT FILE ST INPUTFILE SUBTITLE 1 *CREATE FILE BLOCK & OPEN 'OUTPUT' JLK NEXTBLOCK LSS 0 *FILE NUMBER SLSD C'OUTP'/C'UT ' SLSS 2 *NO OF FILE BLOCKS JLK SETUP #HLCALL .OPENFILE, -CP,(0,&FILEMODEOUT,SPACEDR) JNZ TOEXIT *ERROR RESPONSE *SET CURRENT OUPUT FILE LSS.L (R'SPACEDR+1) ST OUTPUTFILE SUBTITLE 1 *CREATE FILE BLOCK FOR SYSTEM FILE JLK NEXTBLOCK LSS -1 *FILE NUMBER SLSD 0 SLSS 3 *NO. OF FILE BLOCKS JLK SETUP *SET INTERACTIVE NONZERO IF I-O ROUTES THE SAME LXN INPUTFILE LSS.X &FILEROUTE RESTOREXNB LXN OUTPUTFILE ICP.X &FILEROUTE RESTOREXNB LSS 0 JNE NOTINTER LSS 1 NOTINTER ST INTERACTIVE LSS 0 TOEXIT EXIT SUBTITLE 1 *POINT SPACEDR AT NEXT BLOCK NEXTBLOCK LD SPACEDR INCA (&FILEBLKSIZE*4) STD SPACEDR J.T SUBTITLE 1 *INITIALISE FILE BLOCK FORM VALUE ON THE STACK SETUP LB.T *RETURN LINK ST NFILEBLKS LXN.L (R'SPACEDR+1) LSD C' '/C' ' *MAKE UP 16 BYTE FILE NAME LUH.T *MOST SIG 8 BYTES ST.X &FILENAME LSD 0 ST.X &FILEUS *SET FILE USER TO DEFAULT LSS.T *FILE NUMBER ST.X &FILENUMBER SUBTITLE 2 *SETUP ENTRIES IN FILE BLOCK TABLE * & UPDATA FILEBLKTABDR TO NEXT ENTRY ST.I FILEBLKTABDR *FILE NUMBER IN FIRST WORD LSS.L (R'SPACEDR+1) *POINTER TO FILE BLOCK IN SECOND WORD ST.D 1 INCA 8 STD FILEBLKTABDR LSS &NULLSTATUS *SET INITIAL STAUS ST.X &FILESTATUS * CLEAR "IF END GOT" LOCATION LSS 0 ST.X &FILEENDGOTO *SET FILE MARGIN TO UNDEFINED LSS -1 ST.X &FILEMARGIN RESTOREXNB J.B SETSUBS STARTFILE PROC SUBTITLE 3 * ---------- STARTFILE --------------- *CREATE FILE BLOCK FOR FILE WITH SPECIFIED *NUMBER AND NAME PARAMS NUMBER INT NAME LWORD USER LWORD *DR TO USER NAME (OR NIL) LOCAL SPACEDR LWORD RESPONSE INT CODE *SEE IF USER NAME PARAMETER ON STACK *AND IF NOT SET IT TO NIL STSF.B STLN.T SBB.T CPB (&'L*4) JE GOTUSER ASF 2 *RESERVE SPACE FOR MISSING PARAMETER LSD &NIL ST USER GOTUSER LSS 0 ST RESPONSE *SEARCH FOR BLOCK WITH THE REQD NUMBER LB NFILEBLKS LD D'FILEBLKTAB *2 WORD ENTRIES JZB NOTFOUND *NUMBER NOT SETUP LSS NUMBER SRCHBLKS ICP.D JE FOUND INCA 8 DEBJ SRCHBLKS NOTFOUND *RETURN HERE IF NOT FOUND *CREATE NEW BLOCK IF THERES ROOM LSS NFILEBLKS ICP &MAXFILEBLKS JGE NOROOM JLK CHECKSPACE *CREATE POINTER TO NEXT FILE BLOCK LSD FILEBLKSPACE STUH.B LB NFILEBLKS MYB (&FILEBLKSIZE*4) IAD.B *INCREMENT COUNT OF FILE BLOCKS LB NFILEBLKS ADB 1 STB.D *BACK INTO NFILEBLKS SBB 1 *CREATE DR TO ENTRY IN FILEBLOCK TABLE MYB 8 *2 WORD ENTRIES LD D'FILEBLKTAB INCA.B *SAVE POINTER TO FILE BLOCK ST.D 1 *SAVE FILE NUMBER LSS NUMBER ST.D SETENTRY LDA.D 1 *CREATE DR TO FILEBLOCK LDTB (&WV+&FILEBLKSIZE) *PUT INITIAL PARAMETERS INTO FILE BLOCK LSS NUMBER ST.D &FILENUMBER *SET INITIAL STATUS LSS &NULLSTATUS ST.D &FILESTATUS * SET "IF END GOTO" LOCATION LSS 0 ST.D &FILEENDGOTO *SET MARGIN TO UNDEFINED LSS -1 ST.D &FILEMARGIN *NOW COPY NAME ACROSS INCA (&FILENAME*4) LDTB (&BV+16) *UP TO 16 CHAR FILE NMAES LSD NAME MV X'0',C' ' *COPY USER NAME INTO FILE BLOCK LDTB (&BV+8) *USER NAME LSD USER ICP &NIL JE NOUSER MV X'0',C' ' J FINISH NOUSER MVL X'0',0 *SET US NAME TO ZERO IF NOT SET FINISH LSS RESPONSE GOEXIT EXIT NOROOM FILEERREXIT FOUND LSS -1 *BLOCK ALREADY EXISTS ST RESPONSE *BLOCK OVERWRITTEN RESPONSE *CLOCE DOWN THE FILE STD.T *SAVE DR TO BLOCK #HLCALL .CLOSEFILE,CP,(NUMBER) JP 1 *CRASH IF ERROR RESPONSE ************************** LD.T J SETENTRY CHECKSPACE SUBTITLE 2 *CHECK IF THERE IS SPACE TO ALLOCATE A NEW FILE BLOCK, *IF NOT , EXTEND THE AREA. *SEE IF SPACE AVAILABLE FOR 1 MORE BLOCK LSD FILEBLKSPACE STUH.B *GET BOUND FIELD LSS.B AND X'FFFFF' *BOUND FIELD FOR FILE BLOCK SPCE ST.B LSS NFILEBLKS IAD 1 IMY (&FILEBLKSIZE*4) *SIZE REQD ICP.B *SIZE GOT JLE NOPROBLEM *ALLOATE ANOTHER 1024 BYTES ADB 1024 LD D'ULPPARAMS STB.D 1 #HLCALL .UPDATEAREALOCALPROPERTIES,CP,(FILEBLKSPACE), -RW,(ULPPARAMS) JNZ GOEXIT LSD FILEBLKSPACE IAD 1024/0 *UPDATA FILE BLOCK SPACE DESC ST FILEBLKSPACE ST SPACEDR DUMP SPACEDR NOPROBLEM J.T SETSUBS CLOSEFILE PROC SUBTITLE 3 * ------------- CLOSEFILE ----------------- *DESELECT/DEASSIGN FILE OR IF NUMBER = 0 CLOSE ALL FILES *NUMBER = B'0' IS SPECIAL ENTRY TO CLOSE ALL BUT 0 AND -1 FILES PARAMS NUMBER INT LOCAL CURR LWORD FILEBLOCK LWORD FBT LWORD *FILE BLOCK TABLE DR ROUTE WORD COUNT INT *NO. OF FILEBLOCKS TO DO CODE LSS NFILEBLKS JZ FINISH *NO BLOCKS CREATED ST COUNT LD D'FILEBLKTAB STD FBT LSS NUMBER *SEE WHAT KIND OF ENTRY IT IS JZ CLOSEALL ICP B'0' JE ALLBUT *CLOSE ALL BUT 0 AND -1 *NORMAL ENTRY, CLOSE FILE WITH THIS NUMBER LOOK ICP.D JE FOUND JLK GETBLOCK *UPDATA FILEBLOCK AND COUNT JPB LOOK *LLO IN NEXT BLOCK FILEERREXIT *CAN'T FIND FILE FOUND JLK DOCLOSE EXIT *CLOSE ALL THE FILES CLOSEALL JLK DOCLOSE JLK GETBLOCK JPB CLOSEALL LSS 0 ST NFILEBLKS *DELETE WORKSPACE AREA LSD FILEBLKSPACE JZ NOTTHERE #HLCALL .DELETEAREA,ACC2 LSD 0 ST FILEBLKSPACE NOTTHERE FINISH LSS 0 EXIT ALLBUT JLK GETBLOCK *FIRST 3 BLOCKS ARE 0,0,-1 JLK GETBLOCK NEXT JLK GETBLOCK JNPB FINISH *NO MORE FILES BLOCKS JLK DOCLOSE J NEXT SUBTITLE 1 *SUBROUTINE TO UPDATA FBT AND COUNT GETBLOCK LD FBT INCA 8 STD FBT LB COUNT SBB 1 STB COUNT *B <=0 WHEN NO MORE BLOCKS J.T SUBTITLE 2 *CLOSE FILE ADDRESSED BY FBT *IF FILE HAS BEEN ASSIGNED TO BY BASIC THEN DEASSIGN DOCLOSE LD FBT *GET DR TO FILEBLOCK LDA.D 1 LDTB (&WV+&FILEBLKSIZE) STD FILEBLOCK LB.D &FILESTATUS LSS &NULLSTATUS *RESET FILE STATUS TO NULL ST.D &FILESTATUS *IF IN OUTPUT MODE OUTPUT LAST LINE IF ITS NOT EMPYY LSS.B AND &FILEMODEOUT JZ NOTOUTPUT *NOW SEE IF DYNAMIC BUFFER POINTER = STATIC BP LSS.D (&FILEBUFDR+1) ICP.D (&FILEBUFFER+1) JE NOTOUTPUT *EMPTY BUFFER SLB OUTPUTFILE *SAVE STATUS SLB.L (R'FILEBLOCK+1) *SAVE OUTPUT FILE POINTER STB OUTPUTFILE *MAKE THIS THE CURRENT OUTPUT FILE #HLCALL .OUTPUTNL *RESTORE INFO FROM STACK LSS.T ST OUTPUTFILE LD FILEBLOCK LB.T *STATUS NOTOUTPUT LSS.B ST.T *SAVE FILE STATUS AND &SELDSTATUS JZ TSTASSGN *DO DESELECT LSS.D (&FILECURR+1) LUH.D &FILECURR ST CURR DESELECT CURR TSTASSGN LD FILEBLOCK LSS.T *RESTORE FILE STAUUS AND &ASSDSTATUS JZ NOTASSGD *NOT BEEN ASSIGNED TO WITHIN BASIC DODEASSIGN LSS.D &FILEROUTE ST ROUTE DEASSIGN ROUTE NOTASSGD J.T SETSUBS STARTIO PROC SUBTITLE 3 * ---------------- STARTIO --------------- *MAKE SPECIFIED FILE THE CURRENT INPUT OR OUTPUT FILE *OPENING THE FILE IF NECESSARY PARAMS NUMBER INT OPERATION WORD *INPUT OR OUTPUT BIT LOCAL FILEBLK LWORD *DR TO FILE BLOCK RESPONSE WORD CODE LSS 0 ST RESPONSE LB NFILEBLKS LD D'FILEBLKTAB LSS NUMBER JZB NOTFOUND SRCHBLKS ICP.D *SEE IF THIS NUMBER JE FOUND NEXTBLOCK INCA 8 DEBJ SRCHBLKS NOTFOUND FILEERREXIT *FILE NOT DEFINED FOUND STD.T LDA.D 1 *GET DR TO FILEBLOCK LDTB (&WV+&FILEBLKSIZE) STD FILEBLK LSS OPERATION JZ JUSTPOINT *JUST RETURN POINTER TO FILE BLOCK LSS.D &FILESTATUS *SEE IF NULL STATUS ICP &NULLSTATUS JE NEEDSOPEN *SEE IF OPEN IN RIGHT DIRECTION AND OPERATION JNZ ALREADYOPEN *SPECIAL ACTION FOR FILE 0, IF DIRECTION WRONG *GO BACK AND LOOK IN NEXT FILE BLOCK LD.T *RESTORE DR TO FILEBLOCK TABLE LSS NUMBER JZ NEXTBLOCK FILEERREXIT *FILE IN USE IN WRONG DIRECTION NEEDSOPEN LSS -1 ST RESPONSE #HLCALL .OPENFILE, -CP,(NUMBER,OPERATION,FILEBLK) JZ ALREADYOPEN *OK RESPONSE EXIT *RETURN ERROR RESPONSE ALREADYOPEN LB.L (R'FILEBLK+1) *ADDRESS OF FILE BLOCK LSS OPERATION ICP &FILEMODEDEL JE JUSTPOINT *RETURN POINTER TO FILE BLOCK IN B ICP &FILEMODEIN LSS RESPONSE JE SETDEFIN *APPLIES TO COMPARISON 2 ABOVE STB OUTPUTFILE *CURRENT OUTPUT FILE EXIT SETDEFIN STB INPUTFILE *CURRENT INPUT FILE EXIT *IF OPERATION=0 JUST RETURN IN B POINTER TO FILE BLOCK JUSTPOINT LB.L (R'FILEBLK+1) LSS 0 EXIT SETSUBS TOJOURNAL PROC SUBTITLE 3 *------------- TOJOURNAL ----------------- *SEND RECORDS TO JOURNAL , THIS PROC HAS SAME INTERFACE *AS NORMAL ACCESS CALL PARAMS PPS LWORD *DR TO ARRAY OF PARAMETER PAIRS CODE *SCAN THE PARAMETER PAIRS FOR BUFFER DR, OTHER PARAMETERS IGNORED LSS PPS AND X'FFFF' IDV 3 *NUMBER OF PARAMETER PAIRS ST.B LD PPS JZB NOBUFFER GETBUFFER LSS.D ICP 5 *BUFFER CODE JE GOTBUFFER INCA 3 DEBJ GETBUFFER NOBUFFER LSS 0 EXIT GOTBUFFER *CHECK THE LINE LIMIT STD.T LSS JLINELIMIT JN NOLIMIT *IF NEGATIVE IGNORE JZ LIMITED *WE'VE HIT THE LIMIT ISB 1 ST JLINELIMIT NOLIMIT LD.T *RESTORE DR TO BUFFER PARAM PAIR INCA 4 LDTB (&LWV+1) LD.D MESSAGE LSS 0 EXIT LIMITED FILEERREXIT *LINE LIMIT REACHED SETSUBS UNSAVE PROC SUBTITLE 1 *POINTER TO FILE BLOCK AS PARAM, DELETE IT PARAMS FILEBLOCKP WORD *POINTER TO FILE BLOCK LOCAL ROUTE INT CODE LXN FILEBLOCKP LSS.X &FILEROUTE ST ROUTE LSS.X &FILESTATUS RESTOREXNB AND &FILEMODEDEL *SEE IF BLOCK SET FOR DELETE JZ ERREXIT #HLCALL .DELETEFILE,CP,(ROUTE,0,0,0,0,0,0) JP DELERR *SET STATUS IN FILE BLOCK TO NULL LSS &NULLSTATUS LXN FILEBLOCKP ST.X &FILESTATUS LSS 0 DOEXIT EXIT DELERR LXN FILEBLOCKP *GET FILE NUMBER FOR CLOSEFILE LSS.X &FILENUMBER RESTOREXNB #HLCALL .CLOSEFILE,ACC1 ERREXIT LSS 11 EXIT LOC CHAPTER AREAPROPS AREATYPE=CODE,PUBLIC=0 OPENFILE PROC SUBTITLE 8 * ---------- OPENFILE ------------- *OPEN FILE FOR INPUT OR OUTPUT. *IF NOT JSV NAME THEN * IF ASSIGN FAILE THEN * IF INPUT THEN RETURN ERROR * ELSE CREATE FILE *SELECT ON ROUTE OBTAINED *IF OUTPUT THEN TRUNCATE FILE PARAMS NUMBER INT *FILE NUMBER OPERATION WORD *INPUT OR OUTPUT STATUS BIT FILEBLK LWORD *DR TO FILE BLOCK LOCAL CURR LWORD NAMEDR LWORD *DR TO FILE NAME FILEDESC LWORD *DR TO PARAMETERS PAIRS FOR CREATE FILE USNAMEDR LWORD *DR TO USER NAME IN FILEBLOCK ROUTE WORD CODE *SETUP DR TO FILE NAME LD FILEBLK INCA (&FILENAME*4) *GET DR TO FILE NAME LDTB (&BV+16) *PERM FILE NAME LENGTH 16 STD NAMEDR INCA (&FILEUS-&FILENAME*4) LDB 8 STD USNAMEDR *SEE IF JSV EXISTS LD FILEBLK LSS.D (&FILENAME+2) *IF FILENAME LONGER THAN ICP C' ' *8 CHARS DONT LOOK FOR JSV JNE NOJSV INCA (&FILENAME*4) *GET DR TO FILE NAME LDTB (&BV+8) *JSV NAME LENGTH 8 CYD GETROUTE JNN GOTROUTE *RETURN ROUTE IN ACC CPB X'B03' *OR RESPONSE IN B- JSV NOT DEFND JE NOJSV CPB X'B02' *RESERVED JSV NAME JE NOJSV WORD 0 * STRANGE RESPONSE *********************** NOJSV LSS NUMBER *SEE IF FILE 0 JNZ TRYASSIGN *IF OPERATION IS INPUT THEN ERROR ELSE *SET OUTPUT TO THE JOURNAL LSS OPERATION ICP &FILEMODEOUT JE SETJOURNAL LDRL INPUTERRM *"***INPUT NOT ASSIGNED' MESSAGE FILEERREXIT SETJOURNAL LSD D'.TOJOURNAL ST CURR J DONESELECT INPUTERRM WORD (&BV+21) WORD 8 WORD C'***I' WORD C'NPUT' WORD C' NOT' WORD C' ASS' WORD C'IGNE' WORD C'D ' TRYASSIGN *TRY TO ASSIGN TO THE FILE JLK ASSIGNFILE JNP GETASSIGN *RESPONSE IN ACC OK ICP X'C02' *FILE NOT THERE JE NOFILE *OTHER ERRORS - OUTPUT MESSAGE & RETURN OPERMESS ST.B OPERMESS1 OPENERR NAMEDR #HLCALL .CLOSEFILE,CP,(NUMBER) *TIDY UP FILEERREXIT *FILE DOES NOT EXIST - IF OUTPUT CREATE IT NOFILE LSS OPERATION ICP &FILEMODEOUT JE DOCREATE ERROR FILEERREXIT *IF INPUT MODE RETURN ERROR SUBTITLE 1 *CREATE FILE FOR OUTPUT DOCREATE JLK CREATEFILE JNZ OPERMESS *ERROR RESPONSE GETASSIGN LSS &ASSDSTATUS *ROUTE TO FILE IN LOCAL ROUTE JLK ADDTOSTATUS *SET STATUS TO SAY ASSIGN DONE J SAVEROUTE GOTROUTE ST ROUTE SAVEROUTE LD FILEBLK *SAVE INFO IN FILE BLOCK LSS ROUTE ST.D &FILEROUTE *NOW DO SELECT ON THE ROUTE LSS OPERATION ICP &FILEMODEDEL JE SETDELFLAG ICP &FILEMODEOUT JE SELECTOUT *SELECT INPUT CREATEPPS ,1,(REF,CURR,(&LWV+1)), *RETURNED CURRENCY -12,3 *ACTION SELECT & READ LB ROUTE DOSELECT ASF (-&PPSLEN) *DELETE PARAMETER PAIRS J ENDSELECT SELECTOUT CREATEPPS ,1,(REF,CURR,(&LWV+1)), *RETURNED CURRENCY -12,X'A1' *ACTIONS - TRUNCATE,APPEND & SELECT LB ROUTE DOSELECT ASF (-&PPSLEN) *DELETE PARAMETER PAIRS JNZ OPERMESS *ERROR RESPONSE *DO TRUNCATE ACTION ON FILE CREATEPPS ,12,X'20' LD CURR DOACCESS ASF (-&PPSLEN) *SEE IF GOT ERROR RESPONSE FROM TRUNCATING THE TERMINAL ICP X'10C' JE DONESELECT ENDSELECT JNZ OPERMESS *ERROR RESPONSE DONESELECT LSS &SELDSTATUS *SET SELECT FLAG IAD OPERATION *INPUT OR PUTPUT BIT JLK ADDTOSTATUS SUBTITLE 2 *FILE ASSIGNED AND SELECTED ON *SETUP OTHER INFO IN FILE BLOCK LXN.L (R'FILEBLK+1) LSD CURR ST.X &FILECURR LD FILEBLK *GET DR TO FILE BUFFER INCA (&FILEHDLENG*4) LDTB (&BV+&FILEBUFSIZE) STD.X &FILEBUFFER MVL X'0',C' ' *SPACE FILE BUFFER AREA LD.X &FILEBUFFER *RESTORE BUFFER DR SUBTITLE 5 *SET DEFAULT MARGIN IF VALUE IN FILE BLOCK IS STILL -VE * VALUE IF BUFFER SIZE IF INPUT FILE * DEFAULT MARGIN IF OUTPUT FILE *SET BUFFER DR TO NIL IF INPUT FILE *ELSE SET IT TO THE WHOLE BUFFER SUITABLY MODIFIED BY MARGIN LSS.X &FILEMARGIN JNN MARGINSET LB &FILEDEFMARG *DEFAULT FOE OUTPUT LSS OPERATION ICP &FILEMODEOUT JE OUTFILE1 LB &FILEBUFSIZE *DEFAULT MARGIN FOR INPUT OUTFILE1 STB.X &FILEMARGIN MARGINSET LDB.X &FILEMARGIN *DYNAMIC BUFFER DR BOUND SET FROM MARGIN *SET DYNAMIC BUFFER DR TO FULL OR EMPTY LSS OPERATION ICP &FILEMODEOUT JE SETTOEMPTY LD &NIL *IF INPUT SET TO EMPTY SETTOEMPTY STD.X &FILEBUFDR LSS 0 ST.X &FILERECNUMB RESTOREXNB TOEXIT LSS 0 EXIT SETDELFLAG JLK ADDTOSTATUS *ADD DELETE FLAG INTO STATUS J TOEXIT SUBTITLE 1 *SUBROUTEINE TO CALL ASSIGNFILE ASSIGNFILE *FIRST CREATE PARAMETER PAIRS SPECIFYING USER NAME CREATEPPS FILEDESC,40,(VEC,USNAMEDR) *SEE IF USERS NAME SPECIFIED LSS.I USNAMEDR *FIRST BYTE OF FILE US NAME JNZ NOTDEFAULT LSD &NIL *WANT DEFAULT US NAME ST FILEDESC *SET FILEDESC TO NIL NOTDEFAULT #HLCALL .ASSIGNFILE, -RW,(ROUTE), -CP,(0,NAMEDR,0,0,FILEDESC) ASF (-&PPSLEN) *DELETE PPS FOR FILEDESC ON STACK J.T *RESPONSE IN ACC SUBTITLE 1 *SUBROUTINE TO CALL CREATE FILE CREATEFILE *ERROR IF USER NAME NOT ZERO I.E. ITS BEEN EXPLICITLY SET LSS.I USNAMEDR JNZ ERROR CREATEPPS FILEDESC,104,2 *VARIABLE LENGTH RECORDS -105,132 *MAC RECORD SIZE -118,30720 *MAX FILE SIZE #HLCALL .CREATEFILE,RW,(ROUTE), -CP,(0,NAMEDR,0,0,FILEDESC) ASF (-&PPSLEN) J.T SUBTITLE 2 *'OR' CONTENTS OF ACC INTO FILE STATUS *LEAVE DR TO FILEBLK IN DR ADDTOSTATUS LD FILEBLK OR.D &FILESTATUS ST.D &FILESTATUS J.T SETSUBS ****