TITLE 'APLUTSC-B00,09/20/73,DWG702985' SYSTEM SIG7F SYSTEM BPM * * REF'S: REF @@CONT REF @@LOAD REF ACCTCHK ACCOUNT CHECK ROUTINE 18-00001 REF BCX BRANCH THROUGH ROOT TO CX REF BREAKFLG REF CHKTERM CHECK IF 4013,IF SO SWITCH TO TTY REF CLOSR CLOSE AND RELEASE REF CLOSV CLOSE AND SAVE REF CMDB COMMAND BRANCH VECTOR REF CMDEXIT COMMAND EXIT REF CMNDTYPE COMMZND TYPE REF COPYBASE BASE FOR COPY DB REF COPYHOME HOME FOR COPY DB REF COPYSIZE SIZE OF COPY BLOCK REF CURRCS CURRENT CODESTRING POINTER REF DONTSAVE ERROR -- NOT SAVED, THIS WS IS ... REF DUMPLINE OUTPUT ROUTINE REF ERBADCMD BAD COMMAND EXIT REF ERBADWS BAD WS EXIT REF ERLIBREF BAD LIB REF REF ERRFTF ERROR ROUTINE REF ERRFWS ERROR ROUTINE REF F:TF DCB NAME REF F:WS DCB NAME REF FPARAMS FILE PARAMETER BUFFER ADDRESS 18-00010 REF FPTOPNXT REF FPTOPTF OPEN TEMP-FILE FPT REF FPTOPWS OPEN FPT REF FPTOP1ST REF FPTWR2 FPT TO WRITE CONTROL TO 4013 REF FPTXCOFF RESET EXIT CONTROL REF FQTABL TABLE OF DCB ADDRESSES REF FREETBL FREE SPACE TABLE REF GRAFBUF GRAPHICS BUFFER REF HICOMMON REF HOLDFLG OFF VS HOLD FLAG REF IDBUF ID BUFFER REF INBUF INPUT BUFFER REF IMAGE IMAGE BUFFER REF INTRANS INPUT TRANSLATE TABLE REF J:ACCN ACCOUNT # REF KEY1 KEY VALUE 1 REF LODYN LOW DYNAMIC ADDRESS REF NAMEBUF NAME BUFFER REF NAMEGRN1 GRANULE #,1ST NAME RECORD REF NAMERKEY NAME RECORD COUNT REF NBIO NO. OF BLIND IO CHANNELS REF NCMDS # OF SYSTEM COMMANDS REF NUMFILES NO. OF FIO CHANNELS 18-00004 REF OPWSACTC ACCOUNT CONTROL REF OPWSACT ACCOUNT REF OPWSMODE I/O MODE REF OPWSNAME NAME REF OPWSPASC PASSWORD CONTROL REF OPWSPAS PASSWORD REF OPWSWRTC WRITE CONTROL PARAMETER 18-00012 REF OP1STACC OPEN 1ST ACCOUNT CONTROL REF OP1STACT OPEN 1ST ACCT REF OUTORANG REF PRINTFNM PRINT FILE NAME 18-00014 REF QUIETFLG =0 IF SAVED MSG TO BE DISPLAYED OR * =-1 IF NOT (BUT WS MUST BE OK). REF READWS ROUTINE TO READ WS FROM FILE REF RELCOM RELEASE COMMON REF RELDYN REF RELEASER RELEASS UNUSED CORE REF RETURN14 TEMP REF SAVESIX TEMP SAVE REF SAVE14 TEMP REF TELEXIT EXIT TO TEL REF TERMKEY TERMINAL RECORD KEY REF TERMSIZ TERMINAL RECORD SIZE REF TERMTYPE TERMINAL TYPE REF TOPOSTAK REF WINDOW TEMP AREA REF WRITEWS ROUTINE TO WRITE WS ON FILE REF WSCKDSPL WORKSPACE CHECKER REF WSIDNAME REF WSIDPASS WSID PASSWORD REF WSOFFSET WS OFFSET REF XFF X'FF' * DEF'S: DEF APLUTSC@ MODULE NAME DEF CALOPNXT CAL'S DEF CALOPTF DEF'D DEF CALOPTRM OPEN )TERM FILE DEF CALOPWS1 TO DEF CALOPWS2 ALLOW DEF CALOPWS3 REF DEF CALOPWS4 BY DEF CALOP1ST ERROR DEF CALRDTF ROUTINES DEF CALRDTRM IN DEF CALRDWS MODULE DEF CALRDWSI APLUTSI DEF CALWRTF DEF CALWRWS DEF CLEARWS MESSAGE DEF CLOSTHIS CLOSE FILE DEF COPYDMES ROUTINE TO WRITE SAVED MSG FOR COPY DEF DELAY6 DELAY 6 SECONDS DEF DROPFILE ROUTINE TO DELETE FILE DEF ERRFWS6 ERROR PROCESSOR DEF FNEQWSID SET FNAME TO WSID DEF FPTOPTRM FPT'S DEF FPTRDTRM DEF FPTRDWS DEF GENOPRM GENERATE OPR MESSAGE DEF GETTERM GET TERMINAL TRANSLATE TABLES DEF KONTINUE NAME,'CONTINUE' DEF LIBUTS UTS INT. FOR )LIB COMMAND DEF LOADREAD READ A RECORD FOR LOAD DEF OPENSAVE OPEN F:WS FOR )SAVE DEF RDACTIV READ ACTIVE WS FOR )COPY DEF RDCOPY READ FROM F:WS FOR COPY DEF RDCOPYDR READ COPY DATA RECORD DEF RDNAMER READ NAME RECORD DEF RDWRLOOP READ-WRITE LOOP DEF RESACCT RESET ACCT DEF RESPASS RESET PASSWORD DEF SAVEDMES ISSUE SAVED MESSAGE AND EXIT DEF SAVWRITE WRITE RECORD FOR SAVE DEF SETACCT SET ACCOUNT DEF SETFNAME SET FILE NAME DEF SETPASS SET PASSWORD DEF TESTACCT TEST ACCT # VS USERS DEF TESTOLDF TEST(ON SAVE) IF OLD FILE EXISTS DEF TESTPASS DEF TRYLOAD DEF UTSIOFF OFF DEF UTSIOFFH OFF HOLD DEF WRACTIV WRITE ACTIVE WS FOR )COPY DEF WRCOPYDR WRITE COPY DATA RECORD DEF WRNAMER WRITE NAME RECORD * 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 * * MODULE DESCRIPTION: * * THIS IS THE SECOND OF TWO MONITOR INTERFACE MODULES * APLUTSI-ROOT UTS INTERFACE MODULE * APLUTSC-SPLIT FROM APLUTSI FOR OVERLAY PURPOSES * PART OF PATH 1 OVERLAY-HANDLES COMMAND RELATED * MONITOR INTERFACES * PAGE APLUTSC@ CSECT 1 BOUND 8 APLAPLAP TEXT 'APLAPLAP' MAGIC WORDS FOR )LIB 18-00019 KONTINUE TEXTC 'CONTINUE' BOUND 8 SAYVE TEXT ' SAVED ' BOUND 8 CLEARWS TEXTC 'CLEAR WS' * * FPT'S WHICH CONTAIN NO VARIABLE PARAMETERS EXCEPT VIA INDIRECT * ADDRESSING * * * OPEN F:TF TO READ TERMINAL TRANSATION RECORD * FPTOPTRM GEN,8,7,17 X'14',0,F:TF DCB ADDRESS DATA X'C7400001' P1,2,6,7,8 F12 DATA ERRFTF ERR (P1) DATA ERRFTF ABN (P2) DATA 2 KEYED ORG (P6) DATA 2 RANDOM ACC (P7) DATA 1 INPUT MODE (P8) DATA 2 SAVE (P10) DATA X'01000303' TEXTC 'APLTRMSB' NAME (CHANGED BETWEEN A01 AND B00) DATA X'02000202' TEXT ':SYS ' ACCOUNT= :SYS DATA X'03010202' TEXT 'STRUDEL ' PASSWORD * * READ F:TF FOR KEYED RECORD WITH TERMINAL TYPE TRANSLATION TABLE * FPTRDTRM GEN,8,7,17 X'10',0,F:TF DCB ADDRESS DATA X'3C000010' P3,4,5,6 AND WAIT FLAG DATA TERMBUF BUFFER WORD ADDRESS DATA TERMSIZ BUFFER SIZE IN BYTES DATA TERMKEY ADDRESS OF KEY DATA 0 BYTE DISP. TERMBUF EQU INTRANS TERMINAL DEPENDANT TABLE START AD. * * FPTRDWS-READ A RECORD VIA F:WS FOR )LOAD OR )COPY * FPTRDWS GEN,8,7,17 X'10',0,F:WS DCB ADDRESS DATA X'FC000010' P1 TO P6 AND WAIT DATA ERRFWS ERR (P1) DATA ERRFWS ABN (P2) GEN,1,31 1,R11 BUF (P3) GEN,1,31 1,R10 SIZ (P4) DATA FWSKEY KEY (P5) DATA 0 BTD (P6) * * FPTRDTF-READ SEQUENTIAL RECORD VIA F:TF FOR )COPY * FPTRDTF GEN,8,7,17 X'10',0,F:TF DCB ADDRESS DATA X'F4000010' P1 TO P4,P6 AND WAIT DATA ERRFTF ERR (P1) DATA ERRFTF ABN (P2) GEN,1,31 1,R11 BUF (P3) GEN,1,31 1,R10 SIZ (P4) DATA 0 BTD (P6) * * FPTWRWS-WRITE RECORD VIA F:WS,FOR )SAVE OR )CONTINUE * FPTWRWS GEN,8,7,17 X'11',0,F:WS DCB ADDRESS DATA X'FC000030' P1 TO P6, NEWKEY, AND WAIT DATA ERRFWS ERR (P1) DATA ERRFWS ABN (P2) GEN,1,31 1,R11 BUF (P3) DATA 2048 SIZ (P4) DATA FWSKEY KEY (P5) DATA 0 BTD (P6) FWSKEY EQU RETURN14 TEMP FOR KEY ADDR * * FPTWRTF-WRITE RECORD VIA F:TF FOR )COPY * FPTWRTF GEN,8,7,17 X'11',0,F:TF DCB ADDRESS DATA X'F4000010' P1 TO P4,P6 AND WAIT DATA ERRFTF ERR (P1) DATA ERRFTF ABN (P2) GEN,1,31 1,R11 BUF (P3) GEN,1,31 1,R10 SIZ (P4) DATA 0 BTD (P6) * * FPTREWTF- REWIND(THAT IS, GO TO BOF) TFILE OPEN ON F:TF * FPTREWTF GEN,8,7,17 X'01',0,F:TF * * FPTPREC-BKCK UP ON TFILE FOR )COPY * FPTPREC GEN,8,7,17 X'1D',0,F:TF DATA X'80000010' P1 AND REVERSE SKIP GEN,1,31 1,NAMEGRN1 # OF RECORD TO SKIP IN NAMEGRN1 * * FPTOFF-EXIT VIA M:LDTRC-TO 'LOGON',WHICH LOGS OFF * FPTOFF GEN,8,22,2 X'03',0,2 ACCOUNT SPECIFIED TEXTC 'LOGON' TEXT ':SYS ' ACCOUNT * * FPTMESG-OPERATOR MESSAGE * FPTMESG DATA 0 IDENTIFIES 'MESSAGE' CAL DATA X'80000000' PARAMETER ' DATA IMAGE ADDRESS OF MESSAGE PAGE * * GETTERM-ROUTINE TO LOAD NEW SET OF I/O TRANSLATE TABLES * * ON ENTRY,R7=TERMINAL NO. * GETTERM RES 0 LI,R5 X'1B0F' ESC-SI LI,R6 13 CHECK IF LEAVING CW,R6 TERMTYPE 4013 BNE GETT2 NO GETT1 STH,R5 GRAFBUF YES-SWITCH IT TO TTY MODE CAL13SW CAL1,1 FPTWR2 B GETT3 GETT2 LI,R5 X'1B0E' ESC-SO CI,R7 13 CHECK IF ENTERING 4013 BNE GETT3 NO-PROCEED CALSET37 CAL1,8 FPTSET37 YES,SET TO TTY37 B GETT1 AND SWITCH TO APL MODE FPTSET37 DATA X'06000002' DECLARE TTY 37 TERMINAL GETT3 LI,R6 3 STW,R7 TERMKEY SET KEY STB,R6 TERMKEY AND KEY SIZE CALOPTRM CAL1,1 FPTOPTRM OPEN TERMINAL FILE CALRDTRM CAL1,1 FPTRDTRM READ RECORD XW,R7 TERMTYPE SET TERMTYPE-GET OLD STW,R7 TERMKEY SAVE OLD LI,R5 F:TF BAL,R6 CLOSV CLOSE FILE LW,R7 TERMKEY GET OLD B OUTORANG+1 ISSUE 'WAS' MESSAGE PAGE * * DELAY6-DELAY 6 SECOND3-USED BY @OPR * DELAY6 RES 0 CALWAIT6 CAL1,8 FPTWAIT6 B *R14 FPTWAIT6 DATA X'0F000005' 5*1.2 SECONDS PAGE * * GENOPRM-GENERATE OPERATOR MESSAGE INDICATED IN 'IMAGE' * GENOPRM RES 0 CALMESG CAL1,2 FPTMESG UTS CALL B *R14 PAGE PAGE * * ROUTINES TO SET-UP AND EXECUTE OPS ON F:WS FOR * )SAVE * )LOAD * )COPY OR )PCOPY * )CONTINUE OR AUTOMATIC CONTINUE * * RESACCT- RESET ACCOUNT * * R14=LINK R4-R5 USED * RESACCT LI,R4 2 RESET ACCOUNT CONTROL LI,R5 0 STB,R5 OPWSACTC,R4 LW,R4 J:ACCN LW,R5 J:ACCN+1 STD,R4 OPWSACT SET ACCOUNT TO USERS ACCOUNT B *R14 EXIT * * RESPASS- RESET PASSWORD * * R14=LINK, R4-R5 USED * RESPASS LI,R4 2 RESET PASSWORD CONTROL LI,R5 0 STB,R5 OPWSPASC,R4 STD,R5 OPWSPAS ZERO THE VALUE B *R14 * * SETACCT-SET ACCOUNT CONTROL AND VALUE * * R14= LINK, R4 AND R5 USED * SETACCT LD,R4 NAMEBUF SET ACCOUNT- 8 CHARS-TRAILING BLANKS STD,R4 OPWSACT LI,R4 2 AND ACCOUNT CONTROL STB,R4 OPWSACTC,R4 B *R14 EXIT * * SETFNAME-MOVE FILENAME FROM NAMEBUF TO OPWSNAME & CONVERT TO TEXTC * * * R14=LINK, R4 AND R5 USED * * ON ENTRY, R5=BYTE COUNT * LOCAL SETEXTC SETFNAME CI,R5 11 SET FILE NAME IN OPWSNAME BLE SETEXTC LI,R5 11 MAX 11 CHARS USED SETEXTC STB,R5 OPWSNAME SET BYTE COUNT (TEXTC FORM) LW,R5 MBSNAME SET UP TO MOVE 11 BYTES LI,R4 BA(NAMEBUF) FROM BA(NAMEBUF) TO MBS,R4 0 BA(OPWSNAME)+1 B *R14 EXIT MBSNAME DATA X'0B000001'+BA(OPWSNAME) * * SETPASS-SET PASSWORD CONTROL AND VALUE * * R14=LINK R4,R5 USED * SETPASS LD,R4 NAMEBUF GET PASS WORD STD,R4 OPWSPAS LI,R4 2 SET PASSWORD CONTROL STB,R4 OPWSPASC,R4 B *R14 RETURN * * TESTACCT-TEST IF ACCOUNT NOT USERS-QUIT IF NOT * * * R14=LINK R12,R13 USED * TESTACCT LW,R13 OPWSACTC CI,R13 X'FF00' BAZ *R14 ACCT NOT SPECIFIED-NO SWEAT LW,R12 J:ACCN LW,R13 J:ACCN+1 CHECK USERS ACCT CD,R12 OPWSACT BE *R14 OK B ERLIBREF NO DICE * * TEST IF PASSWORD SET-QUIT IF YES * * R14=LINK R13 USED * * TESTPASS LW,R13 OPWSPASC CHECK IF PASSWORD SET CI,R13 X'FF00' BAZ *R14 NO B ERBADCMD YES-ERROR * * TESTOLDF-CHECKS IF FILE EXISTS WITH INDICATED ID * OK IF NOT * IF SO,CHECKS FURTHER FOR VALIDITY OF SAVE COMMAND * R14=LINK R5,R6,R7 USED. IF ERROR EXIT, R8,R9 ALSO USED * * TESTOLDF LI,R6 1 STW,R6 OPWSMODE SET INPUT MODE CALOPWS1 CAL1,1 FPTOPWS AND OPEN LI,R5 F:WS OLD FILE EXISTS-CHECK COMMAND BAL,R6 CLOSV VALIDITY LD,R6 OPWSNAME CD,R6 WSIDNAME BNE QCONTINU NOT WSID-CHECK CONTINUE LW,R6 OPWSNAME+2 CW,R6 WSIDNAME+2 BE *R14 NAME MATCHES WSID- SAVE OVER-OK B DONTSAVE NO MATCH, DON'T SAVE. SAVEXIT LW,R6 CMNDTYPE CHECK COMMAND AI,R6 NCMDS+CMDB-@@CONT VS CONTINUE(HOLD) BNE QLOAD NO MTW,0 HOLDFLG YES-CHECK HOLD VS OFF BEZ UTSIOFF B UTSIOFFH QCONTINU CD,R6 KONTINUE CHECK '8CONTINU' BNE DONTSAVE NOPE-NO SAVE B *R14 YES-CHANCE IT QLOAD AI,R6 @@CONT-@@LOAD CHECK COMMAND VS LOAD BNE CMDEXIT NO-CAN'T BE AUTOSTART LW,R6 CURRCS CHECK FOR AUTOSTART BEZ CMDEXIT NO BAL,R15 BCX YES-- AND AWAY WE GO --- * * OPENSAVE OPEN F:WS IN OUTPUT MODE FOR SAVE * * R14=LINK R13 USED * OPENSAVE LI,R13 2 SET OUT MODE STW,R13 OPWSMODE CALOPWS2 CAL1,1 FPTOPWS OPEN B *R14 * * SAVWRITE-WRITE A 'SAVE' RECORD VIA F:WS * * R7=LINK R11=BUFFER ADDRESS(WA) R12=KEY * SIZE IS FIXED-512 WORDS (2048 BYTES) * SAVWRITE STW,R12 FWSKEY SAVE KEY (CAN'T BE IN REGISTER) CALWRWS CAL1,1 FPTWRWS WRITE RECORD B 0,R7 RETURN * * CPYWRITE-WRITE A WS RECORD VIA F:TF FOR )COPY * * R7=LINK R11=BUFFER ADDRESS(WA) * SIZE IN R10 (BYTES) * CPYWRITE RES 0 CALWRTF CAL1,1 FPTWRTF WRITE RECORD B 0,R7 RETURN * * SAVEDMES-ISSUE 'SAVED' MESSAGE AND TAKE COMMAND EXIT * COPYDMES LI,R2 0 B COPYEXIT SET OFFSET TO ZERO SAVEDMES LW,R1 LODYN SET R1 FOR SAVE OR LOAD COPYEXIT BAL,R14 WSCKDSPL CHECK OUT THE WORKSPACE B LCI3 OK-CONTINUE LCI16 LCI 0 ERROR RETURN STM,R0 INBUF+40 SAVE REGISTERS LCI3 LCI 3 LM,R3 OPWSNAME GET NAME (+BLANKS) LD,R6 SAYVE AND ' SAVED ' LCI 4 GET TIME-DATE LM,R8 8,R1 LCI 9 STM,R3 IMAGE SET UP IMAGE LI,R9 X'40' STB,R9 IMAGE SET INITIAL BLANK CI,R14 LCI16 IS WS OK... BE SAVEMESS NO, DIS PLAY SAVED MSG. LW,R3 QUIETFLG YES, CK QUIET-FLAG... BNEZ SAVEXIT = -1 -- EXIT NOW. SAVEMESS LI,R3 36 DISPLAY SAVED MSG. BAL,R12 DUMPLINE CI,R14 LCI16 WAS WS OK... BNE SAVEXIT YES -- NORMAL EXIT. LCI 0 NO -- ERROR EXIT AFTER REGS RESET. LM,R0 INBUF+40 B ERBADWS * * FNEQWSID-SET FUNCT NAME WITH WSID * * R14=LINK, R4 TO R10 MAY BE USED * * IF WS IS CLEAR,(IN NAME), TAKES DONTSAVE EXIT * IF WSID HAS NO PASSWORD, EXITS VIA RESPASS * IF WSID HAS PASSWORD, EXITS VIA SETPASS * FNEQWSID LCI 3 LM,R6 WSIDNAME GET WSID STM,R6 OPWSNAME PUT IN FPT CD,R6 CLEARWS CHECK IF 'CLEAR' BE DONTSAVE YES-NO SAVE LD,R4 WSIDPASS GET WSID PASSWORD BEZ RESPASS B SETPASS+1 PAGE * * TRYLOAD-TRY TO OPEN FILE FOR LOAD (OR COPY) * * R14=LINK * * ROUTINE OPENS FILE AND READS ID RECORD. * IF NO SUCCESSFUL OPEN OR ID RECORD DOES NOT * INDICATE A VALID WS, ERROR EXIT IS TAKEN * TRYLOAD LI,R6 1 STW,R6 OPWSMODE SET INPUT MODE AND OPEN LI,R5 F:WS (USED BY CLOSV) LI,R6 ERLIBREF EXIT FROM CLOSV CALOPWS3 CAL1,1 FPTOPWS TRY TO OPEN LW,R10 KEY1 STW,R10 FWSKEY LI,R10 IDRECSIZ SIZE-(DELIBERATELY SML) LI,R11 IDBUF BUFFER ADDRESS CALRDWSI CAL1,1 FPTRDWS READ ID RECORD B CLOSV NOT ABNORMAL-WRONG! IDRECSIZ EQU 64 ID RECORD SIZE-16 WORDS * * LOADREAD-READ A RECORD FOR )LOAD OR )COPY * * R14=LINK,R11=BUFFER ADDRESS,R12=KEY * R10=SIZE IN BYTES * LOADREAD STW,R12 FWSKEY CALRDWS CAL1,1 FPTRDWS READ RECORD B *R14 * * COPYREAD-READ A SEQUENTIAL RECORD FOR )COPY VIA F:TF * * R14=LINK,R11=BUFFER ADDRESS (WA) * R10=SIZE IN BYTES COPYREAD RES 0 CALRDTF CAL1,1 FPTRDTF B *R14 PAGE * * RDCOPY-ROUTINE TO READ RECORDS FROM F:WS FOR )COPY * * R14=LINK FREETBL=BUFFER ADDRESS COPYSIZE=# OF WORDS TO BE READ * * R2 AND R5 THROUGH R12 USED-NOT SAVED * * IF,AS IS PROBABLY THE CASE, A 'SHORT' RECORD IS READ, ERRFWS6 WILL * BE REACHED FROM ERRFWS * * MOST OF WORK IS DONE BY RDWRCOPY-COMMON TO RDCOPYDR,WRCOPYDR,RDCOPY * RDCOPY LW,R11 FREETBL BUFFER ADDRESS LW,R12 KEY1 FIRST KEY LI,R2 LOADREAD READ VIA F:WS B RDWRCOPY * * WRACTIV-WRITE ACTIVE WS ON TEMP FILE FOR )COPY * * R14=LINK * * REGISTERS R2 THROUGH R14 USED-NOT SAVED * * WRITES SEQUENTIAL RECORDS: * STARTS WITH RECORD # 1 * * SAVES FIRST 6 PARAMETERS FOR ACTIVE WS * AND SETS NAMEGRN1=0 TO INDICATE NO NAME RECORDS IN FILE * WRACTIV STW,R14 SAVE14 SAVE R14 CALOPTF CAL1,1 FPTOPTF OPEN TFILE-OUTIN MODE-SEQUENTIAL BAL,R11 RELEASER RELEASE UNUSED CORE LI,R2 CPYWRITE-SAVWRITE SET TO CALL CPYWRITE BAL,R14 WRITEWS WRITE ACTIVE WS LCI 6 LM,R6 *LODYN STM,R6 SAVESIX SAVE FIRST 6 WS PARAMETERS RESNAMRC LI,R12 0 STW,R12 NAMEGRN1 INDICATE NO NAME RECORDS PRESENT B *SAVE14 RETURN * * RDACTIV-READ ACTIVE WS FROM TFILE FOR )COPY * * R14=LINK * * REGISTERS R1 TO R14 USED-NOT SAVED * RDACTIV STW,R14 SAVE14 SAVE R14 CALREWTF CAL1,1 FPTREWTF POSITION TO BEGINNING OF FILE LI,R2 COPYREAD-LOADREAD SET UP FOR COPY-READ LI,R4 0 STW,R4 WSOFFSET RESET WS OFFSET LI,R4 SAVESIX ADDRESS OF WS PARAMETERS BAL,R14 READWS READ WS B RESNAMRC SET FLAG NOT TO BACK-FILE ON NAMERS * * RDNAMER- * WRNAMER- * SHARED ROUTINE * FOR RDNAMER, READS NAME RECORD-512 WORDS-VIA WINDOW * FOR WRNAMER,WRITES NAME RECORD-512 WORDS-VIA WINDOW * * R14=LINK R2,R7,R10,R11,R12 USED-NOT SAVED * NAMERKEY=NAME RECORD # 0-K INCREMENTED BY RDNAMER-WRNAMER * NAMEGRAN1=GRANULE # FOR 1ST NAME RECORD * WRNAMER LW,R7 R14 SET EXIT FROM CPYWRITE LI,R2 CPYWRITE SET I/O FUNCTION B NAMER1 RDNAMER LI,R2 COPYREAD SET I/O FUNCTION NAMER1 LW,R11 NAMERKEY CHECK IF FIRST NAME RECORD OF SET BNEZ NAMER2 NO LW,R10 NAMEGRN1 YES-CHECK IF PRIOR NAME RECORDS BEZ NAMER2 NO-FILE POSITIONING NOT NEEDED CALPREC CAL1,1 FPTPREC BACK UP 'NAMEGRN1' RECORDS STW,R11 NAMEGRN1 RESET 'NAMEGRN1' TO ZERO NAMER2 LI,R11 WINDOW SET BUF LI,R10 2048 SET SIZ MTW,1 NAMEGRN1 INCREMENT UTSC NAME RECORD COUNT MTW,1 NAMERKEY INCREMENT NAME RECORD COUNT B 0,R2 DO I/O AND RETURN * * RDCOPYDR-READ COPY DATA 'RECORD' (ACTUALLY MAY BE SEVERAL RECORDS * * R14=LINK COPYSIZE=# OF WORDS COPYHOME=1ST ADDRESS * * CLOSE F:TF AFTER READ * * MOST REGISTERS USED, NONE SAVED * * ROUTINE RDWRCOPY DOES MOST OF WORK * RDCOPYDR LW,R11 COPYHOME ADDRESS LI,R2 COPYREAD TYPE OF OPERATION B RDWRCOPY * * WRCOPYDR-WRITE COPY 'DATA RECORD' (ACTUALLY MAY BE SEVERAL RECORDS) * * R14=LINK COPYSIZE=# OF WORDS COPYBASE=1ST ADDRESS * * MOST REGISTERS USED,NONE SAVED * * WRCOPYDR LW,R11 COPYBASE ADDRESS LI,R2 CPYWRITE TYPE OF OPERATION LI,R7 RDWRLOOP EXIT FROM CPYWRITE RDWRCOPY STW,R14 SAVE14 SAVE R14 LI,R14 RDWRLOOP EXIT FROM LOADREAD OR COPYREAD LW,R9 COPYSIZE SIZE (WORDS) LI,R10 2048 PHYSICAL RECORD SIZE RDWRCHSZ CI,R9 512 CHECK SIZE BGE 0,R2 FULL RECORD-READ OR WRITE AI,R9 0 BLEZ RDWREXIT DONE-EXIT LW,R10 R9 SLS,R10 2 SHORT RECORD B 0,R2 READ OR WRITE RDWRLOOP AI,R11 512 KICK ADDRESS AI,R9 -512 REDUCE SIZE AI,R12 1 INCREMENT GRANULE # OR KEY B RDWRCHSZ CONTINUE RDWREXIT CI,R2 CPYWRITE CHECK IF COPY WRITE BE *SAVE14 YES-EXIT ERRFWS6 LI,R5 F:WS (REACHED BY RDWREXIT OR FROM ERRFWS) LW,R6 SAVE14 CI,R2 LOADREAD CHECK IF READ OF F:WS FOR COPY BE CLOSV YES-CLOSE AND SAVE AND EXIT LI,R5 F:TF NO-READ OF F:TF FOR COPY B CLOSR CLOSE AND RELEASE AND EXIT PAGE * * DROPFILE-DELETE INDICATED FILE * * R14=LINK R5,R6,R7 VOLATILE * * IF FILE NOT FOUND-ERROR EXIT * DROPFILE LI,R6 1 STW,R6 OPWSMODE CALOPWS4 CAL1,1 FPTOPWS LI,R5 F:WS BAL,R6 CLOSR B *R14 PAGE * * LIBUTS-UTS INTERFACE FOR )LIB COMMAND-WHICH IS ESSENTALLY ALL A * UTS INTERFACE OPERATION * MUCH OF WORK IS DONE BY ERRFTF1 AND PRINTFMN,IN APLUTSI * ERROR HANDLERS,SINCE )LIB OUTPUT IS GENERATED BY * DELIBERATE 'ABNORMAL' OPENS AND READS * * EXIT IS FROM ERROP1ST TO CMDEXIT * LIBUTS RES 0 LI,R5 0 PRESET 'NO' ACCOUNT CI,R2 X'15' CHECK CR BE S1STACC YES BAL,R14 ACCTCHK GET ACCOUNT 18-00006 LD,R4 NAMEBUF YES STD,R4 OP1STACT SET ACCOUNT LI,R5 2 SET ACCOUNT CONTROL S1STACC LI,R4 2 STB,R5 OP1STACC,R4 CALOP1ST CAL1,1 FPTOP1ST OPEN 1ST FILE IN ACCOUNT. B CHKWRACT 18-00021 CLOSTHIS LI,R5 F:TF CLOSE DCB (IF OPEN) BAL,R6 CLOSV LW,R6 BREAKFLG CHECK BREAK BNEZ CMDEXIT YES-EXIT CALOPNXT CAL1,1 FPTOPNXT OPEN-'NEXT' FILE CHKWRACT LI,R5 FPARAMS SET TO SEARCH FPARAMS 18-00023 CHKWR1 LW,R6 0,R5 GET KEYWORD 18-00024 CW,R6 WRTCHKNE CHECK FOR WRITE ACCT-4 WORDS BE CHKWRAPL (NOT LAST FILE PARAM) CW,R6 OPWSWRTC CHECK FOR WRITE ACCT-4 WORDS 18-00025 BNE CHKWR2 NO 18-00026 CHKWRAPL LW,R7 4,R5 YES-GET 3RD AND 4TH WORDS LW,R6 3,R5 18-00028 CD,R6 APLAPLAP CHECK IF APLAPLAP 18-00029 BNE CLOSTHIS NO-NOT WS 18-00030 B PRINTFNM YES-ASSUME WS 18-00031 WRTCHKNE DATA X'06000404' 4-WORD WRITE ACCTS-NOT LAST PARAM CHKWR2 CI,R6 X'10000' CHECK IF LAST KEYWORD 18-00032 BANZ CLOSTHIS YES-GO TO NEXT FILE 18-00033 AND,R6 XFF NO-GET WORD COUNT 18-00034 AW,R5 R6 MOVE POINTER 18-00035 AI,R5 1 18-00036 B CHKWR1 AND LOOP 18-00037 PAGE * * UTSIOFF AND UTSIOFFH EXITS * UTSIOFFH RES 0 OFF-HOLD BAL,R14 CLOSFILS CLOSE BLIND I/O FILES B TELEXIT RETURN TO TEL UTSIOFF RES 0 BAL,R14 CLOSFILS CLOSE BLIND I/O FILES LW,R12 LODYN BAL,R14 RELDYN RELEASE ALL 'DYNAMIC' LW,R14 HICOMMON AI,R14 1 STW,R14 TOPOSTAK RELEASE ALL 'COMMON' BAL,R14 RELCOM CALXCRES CAL1,8 FPTXCOFF RESET EXIT CONTROL BAL,R15 CHKTERM CHECK IF 4013,IF SO,SWITCH CALOFF CAL1,8 FPTOFF EXIT-ALL THE WA-A-A-Y! * * CLOSFILS-CLOSE BLIND I/O DCB'S WITH SAVE,PRIOR TO EXIT FROM APL * CLOSFILS LI,R4 NBIO+NUMFILES SET LOOP FOR TABLE SEARCH LW,R5 FQTABL-2,R4 GET DCB ADDRESS BAL,R6 CLOSV CLOSE AND SAVE (IF OPEN) BDR,R4 CLOSFILS+1 LOOP B *R14 END