IMD 1.16: 2/09/2008 17:59:30 84-93530-02 e810 f53002 os4/rtx4 eII maintenance diskette  ž ªªž @0‚|†ø)®wÂwЀЀÎtQº®q¦l) ˆ " ž}‚gÿA ¢`œžúž½žä×_l M@’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’IOS4 €MÁÚF182020315233304820204151720 820204151720CF53002 VOLOS4/RTX4 EII MAINTENANCE DISKETTE 84-93530-02 (E810)   ’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’Ižúž½žä×_l M@†i¾øG€ÿìÆy†y ¾õG€ÿæG‚ÿñ‚ÿðGÿÜ`HÂZ@ †b G€ÿÚ`ú^žƒ¾ÿž©ÒY¾ü žáe‡ †IÂQ¾¤¾æ ¾ïÀˆÆBÆBp@€„†;€…†:€††9€ƒ †:Â7P@ G€ÿµÆ:à‰æÙ¾‹N¾Ò ¾ìžùž8‚!¢0ŸÐÆ.ž¶ *•¦ÿ C¦'¾¿Ÿx¢«„C# b# ž}€BŸÒ)í @0DAJ÷LÆ ¢w+™ЀЀΖQA1¹" ¦ † †¦†¤¾¥i€„Žœ žŸ} šŸ}ˆªªžö @¬E°E¨F¤F)¤D¾‘ÄE‚Û„Fž8 æÑŸ} ¦ÔŸ} ÆÌŸ} ž* `jUBˆB¾Œ I,Ÿv ¾‡°¾…€B¾ƒ I,žº ž# @ G€ÿ9Æáæ¬HÿÆàÆà@pÆܾ³ŸrâèCHùC €ˆC ˜GãTºà€q` †Lg€ÿ"žgÿò‘æEX¾C P¢Žâ‰+ì„s=è„胾Pž¿ÞžÂ+âc fžQ¾žN ‚¦p ž‹¾$R†¡ŸxÆn†j‚Ê ž¢žû Þž‚ÞÞ”žniæâZæ‚Œ¾ ތ⊞ì ¦Ÿ} ¦Ÿ}ÿÿŠHŠG¾Âž†§¾¬žÄ¾ë ¦¡ÂŸ@AúœLèSÃ)"$ C ž‰žkžëª2žâŠ0žjŠ.žžh†( ’ªÂ+¢$`îƒæ%ê‚œ€\ÿö1 !¦Mž' ²y‚ žˆò%€À'+ò²oŸsæ…¾âƒ)žsžY ‡eÞdŸ|Ÿ{ @ž8 ož½ Ož¶ mž´ Jž² Kž° iž¿ gž½†N ž)V% tž¹ž%ì„sLè„n`" E¾  F.¹¾  F„ Dž>)žÿ ¾=`¾;nrgŸy ¾w"¾GÞ,ž{žK¾q1 ¾AÞ&ž}žE¾*`¾(t¾ž@¾% ²;¾c ¾ Þ7Þ6Þ5žy¦3ž4¾ž2¾ü¾(ž.OS:: SYSž¦ž"ªªiüþŒþ‹Âwþ‹þŠÂvc Bc A@6<# þIc B# ÞgIþjHÀc r‡Ÿ TITL EXTENDED I/O INTERFACE - NEWEII.MAC - 93530-10 E810 TITL MACROS AND DEFINITIONS REVNOTE MACRO OBJNOTE '*** EII.LIB - REV E810 ***' ENDM * * E Q U A T E S * * EQUATES FOR EII MACROS OLDK EQU 0 OLDY EQU 1 * STREAM CONTROL BLOCK (SCB) EQUATES SCB:CHN EQU 0 SCB CHAIN WORD SCB:FLW EQU SCB:CHN+1 FLAGWORD SCB:USR EQU SCB:FLW+1 USER ID SCB:LUN EQU SCB:USR+1 CURRENT LUN SCB:CHB EQU SCB:LUN+1 CHARACTER BUFFER SCB:CFI EQU SCB:CHB+1 CFI ADDRESS SCB:CG1 EQU SCB:CFI+1 CGI WORD 1 SCB:CBP EQU SCB:CG1+2 CHAR BUFFER PTR SCB:CC EQU SCB:CBP+1 CHARACTER COUNT SCB:IOM EQU SCB:CC+1 I/O MODE SCB:ELT EQU SCB:IOM+1 END LINE TERMINATOR SCB:DTP EQU SCB:ELT+1 I/O DATA TYPE SCB:UID EQU SCB:DTP+1 UID BLOCK ADDRESS (COPY) SCB:LEN EQU SCB:UID+1 LENGTH OF SCB (IN WORDS) * SCB FLAGWORD EQUATES - DO NOT CHANGE THE NUMBERS! UNUSED: EQU 0 UNUSED SCB ENTRY CHDEV: EQU 1 CHARACTER DEVICE (=> BUFFERED) DISKU: EQU 2 DISK, UNBUFFERED DISKB: EQU 3 DISK, BUFFERED * SCB I/O MODE EQUATES CREAD: EQU 4 CWRITE: EQU 5 * SCB DATA TYPE EQUATES UFM: EQU 0 UNFORMATTED I2A: EQU 1 ISO TO ASCII I2I: EQU 2 ISO TO ISO A2A: EQU 3 ASCII TO ASCII A2I: EQU 4 ASCII TO ISO * FREE SPACE BLOCK EQUATES FSB:CHN EQU 0 FREESPACE BLOCK CHAIN FSB:LEN EQU FSB:CHN+1 FREESPACE BLOCK LENGTH FSB:USR EQU FSB:LEN+1 USER ID  FSB:BLK EQU FSB:USR+1 THE USER'S INFO STARTS HERE * DIB CHAIN EQUATES DBC:CHN EQU 0 DIB CHAIN WORD DBC:DIB EQU DBC:CHN+1 DIB ADDRESS DBC:NAM1 EQU DBC:DIB+1 DIB NAME WORD 1 DBC:NAM2 EQU DBC:NAM1+1 DIB NAME WORD 2 * EQUATES FOR UID BLOCKS BCPARTA EQU 0 BYTE COUNT / PARTA BYTE # PARTBC EQU BCPARTA+1 PART A / PART C BYTE #S UIDDATA EQU PARTBC+1 UID DATA BYTES START HERE UIDBYTS EQU UIDDATA*2 BYTE POSITION OF DATA IN UID TITL * RTX EQUATE R:ACT EQU :21 * GENERAL EQUATES CHBUFLEN EQU 139 CHARACTER DEVICE BUFFER LENGTH * * ENTRY MACRO * ENT:EII XMACRO MACLAB EXTR C:ENTER #(-1) JSK C:ENTER WORD #(1)+2 ENDM * * RETURN MACRO * RET:EII XMACRO MACLAB EXTR C:RETURN #(-1) JMP C:RETURN ENDM * LOCK XMACRO MACLAB EXTR C:LOCK #(-1) JSK C:LOCK MUTUALLY EXCLUDE ENDM * UNLOCK XMACRO MACLAB EXTR C:UNLOCK #(-1) JSK C:UNLOCK DE-MUTUALLY EXCLUDE ENDM TITL * * TITLE MACROS * ETITL1 XMACRO 1 ETITL2 MACENT 2 ETITL3 MACENT 3 ETITL4 MACENT 4 ETITL5 MACENT 5 ETITL6 MACENT 6 ETITL7 MACENT 7 ETITL8 MACENT 8 TITL EXTENDED I/O INTERFACE - NEWEII#(0).ASM - 93530-1#(0) E810 TITL -- #(1) -- EII: REL SHARABLE EII: ROMMABLE EII: ENDM ETITL XMACRO  TITL -- #(1) -- ENDM SAVE ************************************************************************ *  * * NOTE: THE PROGRAM BELOW WAS WRITTEN BY AN ENGLISHMAN * * THE SPELLINGS HAVE BEEN CHANGED TO PROTECT THE IGNORANT. * *  * * RGB 2-NOV-1980 * *  * ************************************************************************ END LOCKS BCPARTA EQU 0 BY ETITL1 C:RENAM0 * * EQUATES FOR C:RENAM0 * UID1X EQU 0 OLD UID ADDRESS UID2X EQU UID1X+1 NEW UID ADDRESS REPLYX EQU UID2X+1 ADDRESS TO STORE REPLY * REPLY EQU 2 ADDRESS TO STORE REPLY UID1 EQU REPLY+1 UID1 ADDRESS (OLD UID) SID1 EQU UID1+1 SID1 ADDRESS ACTRPY1 EQU SID1+1 ACTUAL REPLY #1 SCB1 EQU ACTRPY1+1 SCB #1 ADDRESS UID2 EQU SCB1+1 UID2 ADDRESS (NEW UID) SID2 EQU UID2+1 SID2 ADDRESS ACTRPY2 EQU SID2+1 ACTUAL REPLY #2 SCB2 EQU ACTRPY2+1 SCB #2 ADDRESS ACTSID1 EQU SCB2+1 ACTUAL SID #1 ACTSID2 EQU ACTSID1+2 ACTUAL SID #2 REPVECT1 EQU ACTSID2+2 REPLY VECTOR #1 CONNBK1 EQU REPVECT1+1 CONNECT BLOCK #1 LIES HERE NAME1 EQU CONNBK1+NAMPT: ADDRESS OF NAME1 ACTNAME1 EQU CONNBK1+RLN:+1 ACTUAL LOCATION OF NAME1 REPVECT2 EQU ACTNAME1+7 REPLY VECTOR #2 CONNBK2 EQU REPVECT2+1 CONNECT BLOCK #2 LIES HERE NAME2 EQU CONNBK2+NAMPT: ADDRESS OF NAME2 ACTNAME2 EQU CONNBK2+RLN:+1 ACTUAL LOCATION OF NAME2 SAVSCB EQU ACTNAME2+7 SCB SAVED HERE ... VTC EQU SAVSCB ... LATER HOLDS VTOC SEMAPHORE RCFI EQU VTC+1 REMEMBERED CF1 LUN EQU RCFI+2 LUN FOR I:IO CUNAME EQU LUN+IO:ST+1 CURRENT NAME LIES HERE ENDSTK EQU CUNAME+7 CURRENT NAME (DIRECTORY) FUOPER EQU FU:%4+OP: FUNCTION, OPEN RENT EQU RE:%4+UF: WRENT EQU WR:%4+DS: ETITL C:RENAM0 ************************************************************************ * * * E I I S E R V I C E --- C : R E N A M 0 --- * * * ****************** ****************************************************** NAM C:RENAM0 EXTR C:PTOPEN,C:RD0,C:WR0,C:LKDIB,C:ULDIB,C:CLOSE0 C:RENAM0 ENT:EII ENDSTK COPY UID1X(X),A FETCH AND SAVE ... COPY A,UID1(Y) COPY UID2X(X),A COPY A,UID2(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * * NOW DO INITIALISATION * COPY Y,X ADD =ACTSID1,X ADDRESS OF ACTUAL SID 1 COPY X,SID1(Y) SET UP SID1 COPY =0,A COPY A,*SID1(Y) AND ZERO IT ADD =ACTSID2-ACTSID1,X ADDRESS OF ACTUAL SID 2 COPY X,SID2(Y) SET UP SID2 COPY A,*SID2(Y) AND ZERO IT ADD =REPVECT1-ACTSID2,X ADDRESS OF REPLY VECTOR #1 COPY X,ACTRPY1(Y) SET UP REPLY ADDRESS #1 ADD =REPVECT2-REPVECT1,X ADDRESS OF REPLY VECTOR #2 COPY X,ACTRPY2(Y) SET UP REPLY ADDRESS #2 * * NOW OPEN THE DIRECTORY OF UID #1 * ADD =UID1-REPVECT2,X ADDRESS OF PARAM LIST JSK C:PTOPEN PERFORM PARTIAL OPEN JNE A,ERRXT1 ERROR EXIT IF BAD REPLY COPY Q,SCB1(Y) STORE SCB 1 ADDRESS COPY Y,X ADD =CONNBK1,X ADDRESS OF CONNECT BLOCK #1 JSK OPNFIL OPEN FILE AND UNLOCK JNE A,ERRXT1 ERROR EXIT IF BAD REPLY * * DROP THROUGH TO ... * TITL * * PARTIALLY OPEN THE DIRECTORY OF UID #2 * COPY Y,X ADD =UID2,X ADDRESS OF PARAM LIST #2 JSK C:PTOPEN PERFORM PARTIAL OPEN JNE A,ERRXT2 ERROR EXIT IF BAD REPLY COPY Q,SCB2(Y) STORE SCB 2 ADDRESS * * NOW CHECK FOR IDENTICAL DEVICES * COPY CONNBK1+PUN:(Y),A PUN OF CONNECTED DIRECTORY #1 SUB CONNBK2+PUN:(Y),A SUBTRACT THAT OF DIRECTORY #2 JEQ A,SAMDEV HERE THE SAME DEVICE IF A=0 UNLOCK COPY =-24,A -24 => PUNS DIFFERENT ON A RENAME JMP ERRXT2 CLOSE DIRECTORY #1 AND EXIT * * NOW CHECK FOR TWO IDENTICAL DIRECTORIES * SAMDEV COPY CONNBK1+FNO:(Y),A F-NUMBER OF CONNECTED DIRECTORY #1 SUB CONNBK2+FNO:(Y),A SUBTRACT THAT OF DIRECTORY #2 JEQ A,SAMDIR HERE THE SAME DIRECTORY IF A=0 * * HERE WE HAVE A RENAME ACROSS DIRECTORIES, SO ... * ... OPEN THE DIRECTORY OF UID #2 * JSK OPNFIL OPEN FILE AND UNLOCK COPY Y,X ADD =CONNBK2,X ADDRESS OF CONNECT BLOCK IN X FOR OPNFIL CALL JNE A,ERRXT2 ERROR EXIT IF BAD REPLY JMP NSDIR HERE WE HAVE TWO DIRECTORIES OPEN TITL * * HERE WE DEAL WITH ERRORS * * HERE WE HAVE AN ERROR, WITH TWO FILES (SID1 AND SID2) OPEN. * ERRXT3 COPY A,*REPLY(Y) STORE REPLY FOR USER COPY VTC(Y),X VTOC SEMAPHORE ADDRESS JSK C:ULDIB UNLOCK THE DIB COPY Y,X NOW WE CLOSE DIRECTORY #2  ADD =SID2,X PARAMETER LIST IN X FOR CLOSE JSK C:CLOSE0 CLOSE THE FILE JMP ERRXT2A AND NOW AS FOR ERROR EXIT #2 * * HERE WE HAVE AN ERROR, WITH ONE FILE (SID1) OPEN. * ERRXT2 COPY A,*REPLY(Y) STORE BAD REPLY ERRXT2A COPY Y,X NOW WE MUST CLOSE DIRECTORY #1 ADD =SID1,X PARAMETER LIST IN X FOR CLOSE JSK C:CLOSE0 CLOSE THE FILE COPY *REPLY(Y),A GET REPLY BACK IN A FOR EXIT RET:EII * * HERE WE HAVE AN ERROR, BUT NO FILES OPEN. * ERRXT1 COPY A,*REPLY(Y) STORE REPLY FOR USER RET:EII LPOOL TITL * * HERE WE EITHER HAVE A RENAME OF A FILE TO A DEFFERENT NAME IN THE * SAME DIRECTORY (CASE 1), OR A RENAME OF A FILE ACROSS DIRECTORIES * (CASE 2). IN BOTH CASES THE FILE MAY BE A DIRECTORY. * WITH CASE 1 WE HAVE A SINGLE DIRECTORY OPEN ON SID1. WITH CASE 2 * WE HAVE A SECOND DIRECTORY OPEN ON SID2. * * WE WILL SET SID2 TO ZERO TO INDICATE CASE 1. * * CASE 1 CODE (ONLY) * SAMDIR UNLOCK COPY =0,A UNLOCK (COS WE DIDN'T OPEN SID2) ... COPY A,SID2(Y) ... AND ZERO SID2 TO INDICATE CASE 1 * * CASE 1 AND CASE 2  COMMON CODE - SEARCH DIRECTORY #1 * NSDIR COPY CONNBK1+PUN:(Y),X PUN OF CONNECTED DEVICE ADD =DI:VTS-2,X SEMAPHORE ADDRESS COPY X,VTC(Y) SAVE VTOC SEMAPHORE ADDRESS JSK C:LKDIB LOCK DIB * * SET UP IOB FOR READING DIRECTORY #1 * COPY *SID1(Y),A SID1 COPY A,LUN(Y) SET UP LUN COPY SCB1(Y),X SCB OF DIRECTORY #1 COPY SCB:CFI(X),X CFI ADDRESS IN X COPY X,IO:CRI+LUN(Y) STORE IN IOB COPY =0,A COPY A,RCFI(Y) ZERO REMEMBERED CFI ... COPY A,RCFI+1(Y) ... TO INDICATE NOTHING REMEMBERED COPY A,0(X) ZERO FIRST WORD OF CURRENT CFI COPY =16,A 16 BYTES PER ENTRY COPY A,1(X) CFI STARTS AT SECOND ENTRY COPY A,IO:BCT+LUN(Y) AND 16 IS REQUESTED COUNT COPY =RENT,A READ ENTRY FUNCTION COPY A,IO:FC+LUN(Y) SET UP FUNCTION IN IOB COPY Y,A ADD =CUNAME,A ADDRESS OF CURRENT NAME COPY A,IO:BUF+LUN(Y) SET UP AS BUFFER ADDRESS * * DROP THROUGH TO ... * TITL * * NOW IOB IS SET UP FOR READING ENTRIES, ENTER READ LOOP * RENTLP I:IO LUN(Y) READ AN ENTRY JMP ENDDIR1 ERROR READING AN ENTRY OR EOF COPY IO:ACT+LUN(Y),A ACTUAL COUNT TRANSFERRED CLSN A,=16 WAS IT 16 BYTES ? JMP $+2 YES: SUCCESS JMP FNFERR NO: TREAT AS FILE-NOT-FOUND ERROR COPY CUNAME(Y),Q GET F-NUMBER OF ENTRY JNE Q,ETHERE HERE AN ENTRY IS THERE - CHECK IT! COPY CUNAME+1(Y),A GET NEXT WORD JEQ A,ENDDIR1 IF 0 ITS LOGICAL END OF DIRECTORY JMP RENTLP ELSE LOOP * * NOW CHECK THE CURRENT ENTRY AGAINST NAME1 * ETHERE COPY =6,X COUNT FOR CHECKING ENTRIES CNAME COPY ACTNAME1(X,Y),A NTH WORD OF NAME SUB CUNAME+1(X,Y),A SUBTRACT NTH WORD OF READ NAME JNE A,CFLN2 HERE NOT FOUND - CHECK FILENAME #2? JNED X,CNAME LOOP, CHECKING ALL WORDS * * HERE WE HAVE FOUND THE ENTRY WE REQUIRE (F-NO IS STILL IN Q) * COPY Q,ACTNAME2-1(Y) SAVE FNO IN ACTUAL NAME2-1 COPY SID2(Y),A GET SID2 JNE A,CASE2 JUMP IF CROSS-DIRECTORY RENAME COPY IO:CRI+LUN(Y),X CFI ADDRESS IN X COPY 0(X),A REMEMBER CFI FOR LATER USE COPY A,RCFI(Y) COPY 1(X),A COPY A,RCFI+1(Y) JMP RENTLP AND LOOP * * HERE WE MUST CHECK FOR NAME #2 * CFLN2 COPY SID2(Y),A GET SID2 JNE A,RENTLP IF NONZERO, DON'T LOOK FOR DUPLICATES HERE COPY =6,X COUNT FOR CHECKING ENTRIES CNAME2 COPY ACTNAME2(X,Y),A NTH WORD OF NAME2 SUB CUNAME+1(X,Y),A SUBTRACT NTH WORD OF READ NAME JNE A,RENTLP HERE NOT FOUND - LOOP JNED X,CNAME2 LOOP, CHECKING ALL WORDS * * HERE THE NAME WOULD BE A DUPLICATE * ISDUP COPY =-11,A -11 => FILE ALREADY EXISTS JMP ERRXT3 HERE ERROR, CLOSE BOTH FILES AND EXIT TITL * * HERE WE HAVE END OF DIRECTORY #1 OR AN ERROR * ENDDIR1 COPY IO:ST+LUN(Y),A GET I/O STATUS JGE A,$+2 SKIP IF NOT AN ERROR JMP ERRXT3 IF -VE ITS AN ERROR COPY RCFI+1(Y),A GET CFI WORD 2 JNE A,FNDFIL1 JUMP IF FOUND FILE COPY RCFI(Y),A GET CFI WORD 1 JEQ A,FNFERR IF BOTH 0, FILE NOT FOUND * * NOW WE MOD THE IOB TO WRITE THE ENTRY * FNDFIL1 COPY Y,A ADD =ACTNAME2-1,A ADDRESS OF F-NO+NEW NAME COPY A,IO:BUF+LUN(Y) SET UP AS BUFFER ADDRESS COPY =WRENT,A WRITE ENTRY FUNCTION CODE COPY A,IO:FC+LUN(Y) SET UP FUNCTION CODE COPY Y,X ADD =RCFI,X X POINTS TO SAVED CFI COPY X,IO:CRI+LUN(Y) STORE IN IOB JSK SUB16CFI SUBTRACT 16 FROM CFI (ADDRESS IN X) I:IO LUN(Y) WRITE THE ENTRY JMP ERRWENT HERE ERROR WRITING ENTRY * * HERE EVERYTING IS ALL OK, WE MUST CLOSE FILES AND EXIT * NORMEX COPY VTC(Y),X VTOC SEM ADDRESS JSK C:ULDIB UNLOCK THE DIB COPY SID2(Y),A GET SID2 JEQ A,NCSID2 NO  CLOSE OF SID2 IF NEVER OPENED COPY Y,X ADD =SID2,X X SET UP FOR CLOSE CALL JSK C:CLOSE0 CLOSE FILE, REPLY IN A JEQ A,$+2 SKIP IF NO ERROR DETECTED JMP ERRXT2 ERROR SO RETURN THIS AS REPLY NCSID2 COPY Y,X ADD =SID1,X X SET UP FOR CLOSE CALL JSK C:CLOSE0 CLOSE FILE, REPLY IN A JMP ERRXT1 RETURN THIS AS THE REPLY * * ERRORS READING OR WRITING * ERRWENT EQU $ ERRRENT COPY IO:ST+LUN(Y),A GET ERROR REPLY JLT A,$+2 IF -VE REAL ERROR FNFERR COPY =-22,A -22 => FILE-NOT-FOUND ERROR JMP ERRXT3 HERE ERROR - CLOSE BOTH FILES AND EXIT LPOOL TITL * * CASE 2 (ONLY) CODE * * HERE WE HAVE SEARCHED THE FIRST DIRECTORY AND HAVE FOUND THE FILE. * THE NEW ENTRY TO WRITE IS CONTAINED AT ACTNAME2-1 ONWARDS. WE MUST * NOW SEARCH THE SECOND DIRECTORY FOR A BLANK ENTRY OVER WHICH WE CAN * WRITE. * * SET UP IOB FOR READING DIRECTORY #2 * CASE2 COPY *SID2(Y),A SID2 COPY A,LUN(Y) IS NEW LUN COPY SCB2(Y),X SCB IN X COPY SCB:CFI(X),X CFI ADDRESS IN X COPY =0,A COPY A,0(X) ZERO WORD 1 COPY =16,A COPY A,1(X) WORD 2 =16 (SKIP THE FIRST ENTRY) COPY X,IO:CRI+LUN(Y) PUT CFI IN IOB * * EVERYTHING ELSE IS ALREADY SET UP FROM READING DIRECTORY #1, * SO ENTER LOOP TO FIND BLANK ENTRY AND SEARCH FOR DUPLICATES. * RENTLP2 I:IO LUN(Y) READ AN ENTRY JMP ENDDIR2 ERROR READING AN ENTRY OR EOF COPY IO:ACT+LUN(Y),A ACTUAL COUNT TRANSFERRED CLSN A,=16 WAS IT 16 BYTES ? JMP $+2 YES: SUCCESS JMP FNFERR NO: TREAT AS FILE-NOT-FOUND ERROR COPY CUNAME(Y),Q GET CURRENT F-NUMBER JNE Q,MBDUP IF NOT 0 MAY BE DUPLICATE * * HERE WE HAVE FOUND A BLANK ENTRY, WE'LL JUST REMEMBER THE CFI * COPY IO:CRI+LUN(Y),X CFI ADDRESS IN X COPY 0(X),A REMEMBER CFI FOR LATER USE COPY A,RCFI(Y) COPY 1(X),A COPY A,RCFI+1(Y) COPY CUNAME+1(Y),A GET NAME+1 JEQ A,FNDBLNK IF ZERO ITS A BLANK ENTRY (AND EOF) JMP RENTLP2 AND LOOP * * HERE WE MUST CHECK FOR A DUPLICATE DEFINITION OF NAME2 * MBDUP COPY =6,X COUNT FOR CHECKING ENTRIES CNAME3 COPY ACTNAME2(X,Y),A NTH WORD OF NAME2 SUB CUNAME+1(X,Y),A SUBTRACT NTH WORD OF READ NAME JNE A,RENTLP2 HERE NOT FOUND - LOOP JNED X,CNAME3 LOOP, CHECKING ALL WORDS JMP ISDUP HERE WE HAVE A DUPLICATE NAME TITL * * NOW WE HAVE A BLANK ENTRY, LET'S WRITE THE NEW ENTRY * ENDDIR2 COPY IO:ST+LUN(Y),A GET I/O STATUS JGE A,$+2 SKIP IF NO ERROR JMP ERRXT3 IF -VE ITS AN ERROR COPY RCFI+1(Y),A GET CFI WORD 2 JNE A,FNDBLNK JUMP IF FOUND BLANK ENTRY COPY RCFI(Y),A GET CFI WORD 1 JEQ A,FNFERR IF BOTH 0, FILE NOT FOUND FNDBLNK COPY Y,X ADD =RCFI,X X POINTS TO REMEMBERED CFI COPY X,IO:CRI+LUN(Y) STORE CFI IN IOB JSK SUB16CFI PUT CFI BACK TO OVERWRITE THE ENTRY COPY Y,A ADD =ACTNAME2-1,A A POINTS TO BUFFER TO WRITE COPY A,IO:BUF+LUN(Y) SET UP BUFFER ADDRESS COPY =WRENT,A WRITE ENTRY FUNCTION CODE COPY A,IO:FC+LUN(Y) FUNCTION CODE SET UP I:IO LUN(Y) WRITE THE ENTRY JMP ERRWENT HERE ERROR WRITING THE ENTRY * * NOW WE MUST ERASE THE OLD FILE - FIRST MOD THE IOB. * COPY *SID1(Y),A COPY A,LUN(Y) CHANGE LUN COPY SCB1(Y),X SCB #1 COPY SCB:CFI(X),X CFI OF FILE #1 COPY X,IO:CRI+LUN(Y) PUT IN LUN JSK SUB16CFI MOD THE CFI FOR WRITING THE ENTRY COPY =0,A 0 => ENTRY DELETED COPY A,ACTNAME2-1(Y) F-NO IS NOW 0 => DELETED I:IO LUN(Y) WRITE THE ENTRY JMP ERRWENT HERE ERROR WRITING THE ENTRY JMP NORMEX NOW DO THE NORMAL EXIT CODE ETITL OPNFIL * * OPNFIL -- AN INTERNAL ROUT INE TO OPEN A FILE, (SCB ADDRESS IN Q). * THE FILE IS CONNECTED TO THE LUN SPECIFIED IN THE SCB, UNLESS * THE F-NUMBER IS ZERO, IN WHICH CASE WE MUST CONNECT TO THE ROOT * DIRECTORY. RETURNS ERROR STATUS IN A (0 => ALL OK). * OPNFIL COPY Q,SAVSCB(Y) SAVE SCB ADDRESS COPY FNO:(X),A F-NUMBER OF FILE JNE A,NOTROOT HERE NOT THE ROOT DIRECTORY COPY =1,A COPY A,NAMPT:(X) NAME POINTER SET UP EXCH Q,X SCB ADDRESS IN X NOW COPY SCB:LUN(X),A GET LUN COPY Q,X CONNECT BLOCK ADDRESS IN X COPY A,LUN:(X) STORE LUN IN CONNECT BLOCK F:CFNO 0(X) CONNECT TO ROOT DIRECTORY CLSN A,=2 IS REPLY OK? JMP NOTROOT YES: SKIP THE ERROR COPY =-3,A NO: -3 => CONNECT FAILED JMP EXT EXIT WITH ERROR NOTROOT COPY SAVSCB(Y),X SCB ADDRESS IN X COPY SCB:CFI(X),A CFI ADDRESS COPY A,IO:CRI+LUN(Y) STORE IN IOB COPY SCB:LUN(X),A LUN (SID) COPY A,LUN(Y) SET UP LUN IN IOB COPY =0,A COPY A,LUN+1(Y) ZERO IOB RESERVED WORD COPY =FUOPER,A FUNCTION, OPEN COPY A,IO:FC+LUN(Y) STORE IN IOB I:IO LUN(Y) OPEN IT JMP ERFOP ERROR ON FILE OPEN COPY SAVSCB(Y),X RESTORE SCB ADDRESS COPY =DISKU:,A DISKU: => DISK FILE COPY A,SCB:FLW(X) SET UP SCB FLAG WORD COPY R:ACT,A USER ID COPY A,SCB:USR(X) SET UP USER ID IN SCB COPY =0,A SAYS ALL OK EXT UNLOCK RSK RETURN TO CALLER ERFOP COPY IO:ST+LUN(Y),A GET STATUS FOR ERROR RETURN JMP EXT EXIT WITH STATUS ETITL SUB16CFI * * SUB16CFI - SUBTRACTS 16 FROM THE CFI WHOSE ADDRESS IS IN X. * IT ASSUMES THAT A LEGAL CFI CAN NEVER BE ZERO. * SUB16CFI COPY 1(X),A 1(X) IS CFI WORD 2 JEQ A,DECW0 HERE MUST DEC WORD 1 SUB =16,A SUBTRACT 16 COPY A,1(X) STORE BACK IN WORD 2 RSK AND EXIT TO CALLER DECW0 COPY =-16,A 0-16 = NEW WORD 2 COPY A,1(X) STORE AWAY COPY 0(X),A WORD 1 SUB =1,A NOW DECREMENTED COPY A,0(X) STORE BACK IN WORD 1 RSK AND EXIT TO CALLER END ADDRESS COPY FNO:(X),A F-NUMBER OF FILE JNE A,NOTROOT HERE NOT THE ROOT DIRECTORY COPY =1,A COPY A,NAMPT:(X) NAME POINTER SET UP EXCH Q,X SCB ADDRESS IN X NOW COPY SCB:LUN(X),A GET LUN COPY Q,X CONNECT BLOCK ADDRESS IN X COPY A,LUN:(X) STORE LUN IN CONNECT BLOCK F:CFNO 0(X) CONNECT TO ROOT DIRECTORY CLSN A,=2 IS REPLY OK? JMP NOTROOT YES: SKIP THE ERROR COPY =-3,A NO: -3 => CONNECT FAILED JMP EXT EXIT WITH ERROR NOTROOT COPY SAVSCB(Y),X SCB ADDRESS IN X COPY SCB:CFI(X),A  ETITL2 C:WRUID0 SIDX EQU 0 UIDX EQU 1 REPLYX EQU 2 SID EQU 2 UID EQU SID+1 NBYTES EQU SID+2 ABYTEST EQU SID+3 REPLY EQU SID+4 BYTEST EQU REPLY+1 ENDSTK EQU BYTEST ETITL C:WRUID0 ************************************************************************ *  * * E I I S E R V I C E --- C : W R U I D 0 --- * * * ************************************************************************ NAM C:WRUID0 EXTR C:WR0 C:WRUID0 ENT:EII ENDSTK COPY SIDX(X),A FETCH AND SAVE ... COPY A,SID(Y) COPY UIDX(X),A COPY A,UID(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS COPY Y,A NOW SET UP ADDRESSES ADD =BYTEST,A COPY A,ABYTEST(Y) ADDRESS TO RETURN BYTES TRANSFERRED COPY *UID(Y),A FIRST WORD OF UID SHIFT A,RO,8 # CHARS TO O/P SUB =3,A MINUS THREE COUNT BYTES JLE A,NULLUID HERE NULL UID COPY A,NBYTES(Y) STORE BYTE COUNT COPY UID(Y),A UID ADDRESS ADD  =UIDDATA,A UID DATA BYTE ADDRESS COPY A,UID(Y) SAVE IT COPY Y,X ADD =SID,X X SET UP FOR C:WR0 JSK C:WR0 OUTPUT THE STRING NULLUID COPY A,*REPLY(Y) STORE REPLY RET:EII END ETITL2 C:OPUID0 MADRX EQU 0 MEMORY ADDRESS SBYTEX EQU MADRX+1 BYTE # TO START MAXLENX EQU SBYTEX+1 MAXIMUM LENGTH UIDX EQU MAXLENX+1 UID ADDRESS ALASTBX EQU UIDX+1 ADDRESS TO STORE LAST BYTE # REPLYX EQU ALASTBX+1 ADDRESS TO STORE REPLY COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) ADROUT EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) CUBYTE EQU ADROUT+1 CURRENT BYTE ADLASTB EQU CUBYTE+1 ADDRESS TO STORE LAST BYTE # REPLY EQU ADLASTB+1 ADDRESS TO STORE REPLY UID EQU ADRIN UID ADDRESS (IS ADDRESS IN) ENDSTK EQU REPLY END STACK MARKER ETITL C:OPUID0 ************************************************************************ * * * E I I S E R V I C E --- C : O P U I D 0 --- * * * ************************************************************************ NAM C:OPUID0 EXTR C:MOVBTS C:OPUID0 ENT:EII ENDSTK COPY MADRX(X),A FETCH AND SAVE... COPY A,ADROUT(Y) (MEM ADDRESS IS OUTPUT ADDRESS) COPY SBYTEX(X),A COPY A,CUBYTE(Y) COPY MAXLENX(X),Q COPY Q,COUNT(Y) RETAIN MAX COUNT IN Q (AND COUNT) COPY UIDX(X),A COPY A,UID(Y) (THIS IS ALSO ADRIN!) COPY ALASTBX(X),A COPY A,ADLASTB(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS COPY *UID(Y),A CALCULATE LENGTH SHIFT A,RO,8 GET COUNT OF BYTES IN UID CSK A,Q LESS THAN OR EQUAL TO MAX COUNT? JMP $+2 YES: LESS THAN MAX JMP TOOLONG NO: TOO LONG JNE A,MOVBYTS JUMP IF NOT NULL UID COPY CUBYTE(Y),A CURRENT BYTE SUB =1,A -1 COPY A,*ADLASTB(Y) IS LAST BYTE STORED NORMEX COPY =0,A GOOD REPLY BADEX COPY A,*REPLY(Y) STORE FOR USER RET:EII MOVBYTS ADD CUBYTE(Y),A CURRENT BYTE +COUNT=LASTBYTE COPY A,*ADLASTB(Y) WILL BE THE LAST BYTE STORED COPY =UIDBYTS,X INITIAL BYTE INDEX INTO UID COPY CUBYTE(Y),Q OUTPUT BYTE INDEX IN Q JSK C:MOVBTS MOVE THE BYTES JMP NORMEX NOW NORMAL EXIT TOOLONG COPY =-25,A =>UID TOO LONG FOR AVAILABLE MEMORY JMP BADEX END ETITL2 C:SPUID0 UIDX EQU 0 UID ADDRESS PARTAX EQU UIDX+1 ADDRESS TO STORE PARTA PARTBX EQU PARTAX+1 ADDRESS TO STORE PARTB PARTCX EQU PARTBX+1 ADDRESS TO STORE PARTC REPLYX EQU PARTCX+1 REPLY ADDRESS COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) ADROUT EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) UID EQU ADROUT+1 UID ADDRESS PARTA EQU UID+1 ADDRESS TO STORE PARTA PARTB EQU PARTA+1 ADDRESS TO STORE PARTB PARTC EQU PARTB+1 ADDRESS TO STORE PARTC REPLY EQU PARTC+1 ADDRESS TO STORE REPLY ENDSTK EQU REPLY END STACK MARKER ETITL C:SPUID0 ************************************************************************ * * * E I I S E R V I C E --- C : S P U I D 0 --- * * * ************************************************************************ NAM C:SPUID0 EXTR C:MOVBTS C:SPUID0 ENT:EII ENDSTK COPY UIDX(X), A FETCH AND SAVE... COPY A,UID(Y) COPY PARTAX(X),A COPY A,PARTA(Y) COPY PARTBX(X),A COPY A,PARTB(Y) COPY PARTCX(X),A COPY A,PARTC(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * MOVE PART A COPY *UID(Y),A SHIFT A,LO,8 COUNT IN TOP BYTE COPY A,*PARTA(Y) STORE IN BLOCK SHIFT A,RO,8 COUNT NOW IN A (LSB) COPY =UIDBYTS,X INPUT INDEX IN X COPY UID(Y),Q COPY Q,ADRIN(Y) UID IS INPUT ADDRESS COPY PARTA(Y),Q COPY Q,ADROUT(Y) PARTA IS OUTPUT ADDRESS COPY =1,Q OUTPUT INDEX IN Q JSK C:MOVBTS MOVE THE BYTES * MOVE PART B (ADRIN AND X ALREADY SET UP FROM ABOVE CODE!) IMS UID(Y) INC UID ADDRESS COPY *UID(Y),A COUNT B/ COUNT C COPY A,*PARTB(Y) STORE COUNT IN PARTB SHIFT A,RO,8 COUNT B IN A COPY PARTB(Y),Q COPY Q,ADROUT(Y) PARTB IS NEW OUTPUT ADDRESS COPY =1,Q OUTPUT INDEX IN Q JSK C:MOVBTS MOVE THE BYTES * MOVE PART C (ADRIN AND X ALREADY SET UP FROM ABOVE CODE!) COPY *UID(Y),A COUNT B/ COUNT C SHIFT A,LO,8 COUNTC / 0 COPY A,*PARTC(Y) STORE COUNT IN PARTC SHIFT A,RO,8 COUNT C IN A COPY PARTC(Y),Q COPY Q,ADROUT(Y) PARTC IS NEW OUTPUT ADDRESS COPY =1,Q OUTPUT INDEX IN Q JSK C:MOVBTS MOVE THE BYTES COPY =0,A REPLY (ALWAYS GOOD!) COPY A,*REPLY(Y) STORE FOR USER RET:EII END ETITL2 C:MGUID0 PARTAX EQU 0 ADDRESS TO STORE PARTA PARTBX EQU PARTAX+1 ADDRESS TO STORE PARTB PARTCX EQU PARTBX+1 ADDRESS TO STORE PARTC UIDX EQU PARTCX+1 UID ADDRESS REPLYX EQU UIDX+1 REPLY ADDRESS COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) ADROUT EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) UID EQU ADROUT UID ADDRESS (IS ADROUT!) PARTA EQU UID+1 ADDRESS TO STORE PARTA PARTB EQU PARTA+1 ADDRESS TO STORE PARTB PARTC EQU PARTB+1 ADDRESS TO STORE PARTC REPLY EQU PARTC+1 ADDRESS TO STORE REPLY ENDSTK EQU REPLY END STACK MARKER ETITL C:MGUID0 ************************************************************************ * * * E I I S E R V I C E  --- C : M G U I D 0 --- * * * ************************************************************************ NAM C:MGUID0 EXTR C:MOVBTS C:MGUID0 ENT:EII ENDSTK COPY UIDX(X),A FETCH AND SAVE... COPY A,UID(Y) COPY PARTAX(X),A COPY A,PARTA(Y) COPY PARTBX(X),A COPY A,PARTB(Y) COPY PARTCX(X),A COPY A,PARTC(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * * FIRST CHECK IF IT WILL FIT AND INSERT COUNTS * COPY *PARTA(Y),A SHIFT A,RO,8 COUNT FOR PARTA IN A COPY A,*UID(Y) STORE IN UID COPY *PARTB(Y),Q SHIFT Q,RO,8 COUNT FOR PARTB IN Q ADD Q,A COUNT(A)+COUNT(B) NOW IN A COPY *PARTC(Y),X SHIFT X,RO,8 COUNT FOR PARTC IN X SHIFT Q,LO,8 OR X,Q COUNTB / COUNTC NOW IN Q ADD X,A SUM OF ALL COUNTS IN A ADD =3,A ADD THE COUNT BYTES CSK A,=255 IS IT <= 255 CHARS? JMP $+2 YES: JMP TOOBIG NO: FLAG AN ERROR SHIFT A,LO,8 YES: GET COUNT IN TOP BYTE OR *UID(Y),A OR IN PARTA COUNT COPY A,*UID(Y) AND STORE IN UID COPY UID(Y),X UID ADDRESS IN X COPY Q,PARTBC(X) STORE COUNTB / COUNTC IN UID * * NOW WE MOVE THE DATA * COPY =UIDBYTS,Q OUTPUT BYTE INDEX IN Q COPY PARTA(Y),A COPY A,ADRIN(Y) PARTA IS ADDRESS IN COPY =1,X BYTE INDEX IS 1 COPY *PARTA(Y),A SHIFT A,RO,8 BYTE C OUNT (PARTA) JSK C:MOVBTS MOVE THE BYTES COPY PARTB(Y),A COPY A,ADRIN(Y) PARTB IS ADDRESS IN COPY =1,X BYTE INDEX IS 1 COPY *PARTB(Y),A SHIFT A,RO,8 BYTE COUNT (PARTB) JSK C:MOVBTS MOVE THE BYTES COPY PARTC(Y),A COPY A,ADRIN(Y) PARTC IS ADDRESS IN COPY =1,X BYTE INDEX IS 1 COPY *PARTC(Y),A SHIFT A,RO,8 BYTE COUNT (PARTC) JSK C:MOVBTS MOVE THE BYTES COPY =0,A 0 => ALL OK BADEX COPY A,*REPLY(Y) STORE REPLY RET:EII TOOBIG COPY =-21,A -21 => FILE NAME TOO BIG FOR UID JMP BADEX ERROR RETURN END  ETITL2 C:RDUID0 SIDX EQU 0 INPUT ... UIDX EQU SIDX+1 ATERMX EQU UIDX+1 REPLYX EQU ATERMX+1 ... PARAMETERS RCH EQU 2 C:GETUID ... RCHX EQU RCH+1 UID EQU RCH+2 ATERM EQU RCH+3 REPLY EQU RCH+4 ... PARAMETER BLOCK SID EQU REPLY+1 C:RD0 ... ABYTE EQU SID+1 BCOUNT EQU SID+2 ARBCOUNT EQU SID+3 REPLY2 EQU SID+4 ... PARAMETER BLOCK RBCOUNT EQU REPLY2+1 REPLY BYTE COUNT ENDSTK EQU RBCOUNT END OF STACK MARKER ETITL C:RDUID0 NAM C:RDUID0 EXTR C:RD0,C:GETUID * ************************************************************************ * * * E I I S E R V I C E ---  C : R D U I D 0 --- * * * ************************************************************************ * * C:RDUID0 - READS A UID FROM A STREAM. CALLS C:GETUID (WITH C:RD0 AS * A PARAMETER) TO GET THE CHARS FROM THE INPUT STREAM. * C:RDUID0 ENT:EII ENDSTK COPY SIDX(X),A FETCH AND SAVE ... COPY A,SID(Y) COPY UIDX(X),A COPY A,UID(Y) COPY ATERMX(X),A COPY A,ATERM(Y) COPY REPLYX(X),A COPY A,REPLY(Y) COPY A,REPLY2(Y) ... ALL PARAMETERS * * NOW INITIALISE BLOCKS * COPY =1,A COPY A,BCOUNT(Y) C:RD0 TO TRANSFER 1 CHAR COPY Y,X ADD =RBCOUNT,X COPY X,ARBCOUNT(Y) ADDRESS OF RETURNED BYTE COUNT SET UP COPY =C:RD0,Q COPY Q,RCH(Y) C:RD0 IS THE CHARACTER GETTER ADD =SID-RBCOUNT,X ADDRESS OF SID COPY X,RCHX(Y) STORE AS X-REG FOR CALL * * NOW CALL C:GETUID * ADD =RCH-SID,X X POINTS TO C:GETUID PARAMETER BLOCK JSK C:GETUID GET THE UID RET:EII END ETITL2 C:IPUID0 MADRX EQU 0 INPUT ... SBYTEX EQU MADRX+1 LENGTHX EQU SBYTEX+1 UIDX EQU LENGTHX+1 ATERMX EQU UIDX+1 REPLYX EQU ATERMX+1 ... PARAMETERS RCH EQU 2 C:GETUID ... RCHX EQU RCH+1 UID EQU RCH+2 ATERM EQU RCH+3 REPLY EQU RCH+4 ... PARAMETER BLOCK MADR EQU REPLY+1 C:GCFM ... ABYTE EQU MADR+1 CUBYTE EQU MADR+2 LENGTH EQU MADR+3 ... PARAMETER BLOCK ENDSTK EQU LENGTH END OF STACK MARKER ETITL C:IPUID0 NAM C:IPUID0 EXTR C:GCFM,C:GETUID * ************************************************************************ *  * * E I I S E R V I C E --- C : I P U I D 0 --- * *  * ************************************************************************ * * C:IPUID0 - READS A UID FROM MEMORY. CALLS C:GETUID (WITH C:GCFM AS * A PARAMETER) TO GET THE CHARS FROM MEMORY. * C:IPUID0 ENT:EII ENDSTK COPY MADRX(X),A FETCH AND SAVE ... COPY A,MADR(Y) COPY SBYTEX(X),A COPY A,CUBYTE(Y) COPY LENGTHX(X),A COPY A,LENGTH(Y) COPY UIDX(X),A  COPY A,UID(Y) COPY ATERMX(X),A COPY A,ATERM(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * * SET UP THE X-REGIST  ER FOR CHAR-GETTER AND CHAR-GETTER ADDRESS * COPY Y,A ADD =MADR,A COPY A,RCHX(Y) X REGISTER FOR C:GCFM COPY =C:GCFM,A COPY A,RCH(Y) SET UP ADDRESS OF CHAR-GETTER * * NOW INPUT UID VIA C:GETUID * COPY Y,X ADD =RCH,X X SET UP FOR C:GETUID JSK C:GETUID INPUT THE UID RET:EII END ETITL2 C:CGFM MADRX EQU 0 MEMORY ADDRESS ABYTEX EQU MADRX+1 ADDRESS TO STORE BYTE CUBYTEX EQU MADRX+2 CURRENT BYTE NUMBER LENGTHX EQU MADRX+3 LENGTH OF ITEM IN BYTES MADR EQU 2 MEMORY ADDRESS ABYTE EQU MADR+1 ADDRESS TO STORE BYTE ENDSTK EQU ABYTE END OF STACK MARKER ETITL C:GCFM NAM C:GCFM * * C:GCFM - GETS A CHARACTER FROM MEMORY. DECREMENTS LENGTH AND STORES * IT BACK. RETURNS -1 IF LENGTH IS 0. * INCREMENTS BYTE NUMBER. * C:GCFM ENT:EII ENDSTK COPY MADRX(X),A COPY A,MADR(Y) SAVE MEMORY ADDRESS COPY ABYTEX(X),A COPY A,ABYTE(Y) AND ADDRESS TO STORE BYTE COPY LENGTHX(X),A LENGTH IN A JEQ A,EOSTRING HERE MUST RETURN -1 SUB =1,A LENGTH-1 COPY A,LENGTHX(X) STORE DECREMENTED X COPY CUBYTEX(X),Q CURRENT BYTE NUMBER IN Q IMS CUBYTEX(X) INCREMENT BYTE COUNT COPY Q,X BYTE INDEX IN X COPY MADR(Y),Q MEMORY ADDRESS IN Q EXCH Q,Y Y=MEM ADDRESS, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB 0(Y,X),A GET BYTE RBIT 2,S WORD MODE COPY Q,Y RESTORE Y SHIFT A,LO,8 GET CHAR IN TOP BYTE EXWB COPY A,*ABYTE(Y) STORE BYTE WHERE REQUIRED COPY =0,A 0 => GOOD REPLY (NEVER BAD!!) RET:EII EOSTRING COPY =-1,A -1 MEANS END OF BYTES JMP EXWB EXIT WITH BYTE (WORD) END ETITL2 C:GETUID GCRX EQU 0 CHAR-GETTER FUNCTION ADDRESS XRX EQU GCRX+1 X-REG ON CALL TO GCRX UIDX EQU XRX+1 UID ADDRESS ATERMX EQU UIDX+1 ADDRESS TO STORE TERMINATOR REPLYX EQU ATERMX+1 ADDRESS TO STORE REPLY COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) ADROUT EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) UID EQU ADROUT UID ADDRESS (IS ADDRESS OUT) MAXCHS EQU ADROUT+1 PARAMETERS FOR C:RDSTR ... ASTRING EQU MAXCHS+1 STRING ADDRESS RCH EQU MAXCHS+2 CHARACTER-GETTER XRCH EQU MAXCHS+3 X-REG FOR RCH AACTLEN EQU MAXCHS+4 ADDRESS OF ACTUAL STRING LENGTH ATERM EQU MAXCHS+5 ADDRESS TO STORE TERMINATOR REPLY EQU MAXCHS+6 ... END OF PARAMETERS ACTLEN EQU REPLY+1 ACTUAL STRING LENGTH UIDL EQU ACTLEN+1 UID LENGTH (BYTES) PALEN EQU UIDL+1 PART A LENGTH (BYTES) PBLEN EQU PALEN+1 PART B LENGTH (BYTES) PCLEN EQU PBLEN+1 PART C LENGTH (BYTES) STRING EQU PCLEN+1 STRING (11 CHARS, 6 WORDS) ENDSTK EQU STRING+6 END OF STACK MARKER ETITL C:GETUID * * C:GETUID - GENERAL UID GETTER, CALLED BY C:RDUID0 AND C:IPUID0 TO * PRODUCE A UID FROM A CHARACTER GETTER FUNCTION. * CALLS C:RDSTR TO READ STRINGS. * CALLS C:MOVBTS TO MOVE BYTES INTO THE UID. * NAM C:GETUID EXTR C:RDSTR,C:DIBCH,C:MOVBTS C:GETUID ENT:EII ENDSTK COPY GCRX(X),A FETCH AND SAVE ... COPY A,RCH(Y) COPY XRX(X),A COPY A,XRCH(Y) COPY UIDX(X),A COPY A,UID(Y) (ITS ADDRESS OUT) COPY ATERMX(X),A COPY A,ATERM(Y)  COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * * NOW SET UP ADDRESSES * COPY Y,A ADD =ACTLEN,A COPY A,AACTLEN(Y) ADDRESS TO STORE ACTUAL LENGTH ADD =STRING-ACTLEN,A COPY A,ASTRING(Y) ADDRESS OF STRING COPY A,ADRIN(Y) IS ALSO ADDRESS IN FOR FOR C:MOVBTS * * NOW ZERO THE LENGTHS AND SET UP UID LENGTH * COPY =4,A COPY A,UIDL(Y) SET UID LENGTH TO 4 COPY =0,A AND ZER  O ... COPY A,PALEN(Y) COPY A,PBLEN(Y) COPY A,PCLEN(Y) ... THE LENGTHS OF PARTS A,B AND C * * NOW WE READ THE UID. * COPY =11,A 11 CHARS MAXIMUM COPY A,MAXCHS(Y) STORE FOR CALL COPY Y,X ADD =MAXCHS,X X SET UP FOR CALL JSK C:RDSTR READ THE STRING JNE A,ERROR HERE BAD REPLY - ABORT! COPY ACTLEN(Y),A JNE A,NZLEN JUMP IF NOT NULL STRING COPY *ATERM(Y),A GET TERMINATOR CLSN A,='/' IS IT A LEADING SLASH? JMP RDPARTB HERE LEADING SLASH * * HERE WE SIMPLY EXIT WITH THE TERMINATOR TO THE CALLER * EXWT COPY UIDL(Y),A UID LENGTH(INDEX) SUB =1,A -1 FOR LENGTH BYTE SHIFT A,LO,8 IN TOP HALF OR PALEN(Y),A OR IN THE LENGTH OF PART A COPY UID(Y),X UID ADDRESS IN X COPY A,BCPARTA(X) STORE IN THE UID COPY PBLEN(Y),A LENGTH OF PART B SHIFT A,LO,8 IN TOP HALF OR PCLEN(Y),A OR IN THE LENGTH OF PART C COPY A,PARTBC(X) STORE IN THE UID COPY =0,A 0 => ALL OK ERROR COPY A,*REPLY(Y) STORE REPLY FOR CALLER RET:EII * LPOOL * * HERE NOT A ZERO LENGTH STRING * NZLEN CLSN A,=2 IS LENGTH 2 BYTES? JMP MBLUN YES: THEN MAY BE A LUN CLSN A,=3 IS LENGTH 3 (MAY BE A DEVICE) JMP LEN3 YES: CHECK FOR DEVICE CLSN A,=4 IS LENGTH 4 (MAY ALSO BE A DEVICE) JMP LEN4 YES: CHECK FOR DEVICE * * HERE WILL GO THE CODE TO CHECK FOR VOLUME NAMES * MBVOL JMP ISPARTB ELSE ASSUME IT IS PART B (FILE-NAME) * * HERE MUST CHECK FOR LUN * MBLUN E:SLU STRING(Y) CHECK FOR LUN JNE A,MBDEV NOT FOUND? - MAY BE A DEVICE * * HERE IT IS PART OF PART A (DEVICE, LUN OR VOL NAME) * ISPARTA COPY ACTLEN(Y),A ACTUAL LENGTH IN A COPY =0,X INDEX IN (TO STRING) IS 0 COPY UIDL(Y),Q INDEX OUT (TO UID) IS UID LENGTH JSK C:MOVBTS MOVE IN THE STRING COPY UIDL(Y),A UID LENGTH ADD ACTLEN(Y),A COPY A,UIDL(Y) UPDATE UID LENGTH (INDEX) COPY PALEN(Y),A ADD ACTLEN(Y),A COPY A,PALEN(Y) UPDATE PART A LENGTH * * IS TERMINATOR . OR / ? - IF NOT EXIT. * COPY *ATERM(Y),A GET TERMINATOR CLSN A,='.' IS IT '.' ? JMP RDPARTB YES: READ PART B NOW CLSN A,='/' IS IT '/' ? JMP RDPARTB YES: READ PART B NOW JMP EXWT NO: JUST EXIT WITH TERMINATOR * * HERE CHECK FOR DEVICE NAME (IN THE DIB CHAIN) * * FIRST THE TWO CHARACTER NAME * MBDEV COPY ='00',A DEVICE '00' JMP ELEN3 NOW ENTER LENGTH 3 CODE * * NEXT THE THREE CHARACTER NAME * LEN3 COPY STRING+1(Y),A GET WORD 1 OF STRING SHIFT A,RO,8 TOP BYTE TO BOTTOM OR =:3000,A OR IN A '0' IN THE TOP BYTE ELEN3 COPY A,STRING+1(Y) STORE IN STRING WORD 1 * * DROP THROUGH TO ... * * LAST, AND LEAST, THE FOUR CHARACTER NAME * LEN4 COPY =C:DIBCH,X GET DIB CHAIN ADDRESS LP COPY DBC:CHN(X),X TO NEXT ELEMENT IN THE CHAIN JEQ X,ENDSRCH HERE NOT A DEVICE COPY DBC:NAM1(X),A GET FIRST DIB WORD CSK A,STRING(Y) EQUAL TO THE FIRST WORD OF THIS ENTRY? JMP LP NO: LOOP JMP LP NO: LOOP COPY DBC:NAM2(X),A GET SECOND DIB WORD CSK A,STRING+1(Y) EQUAL TO THE SECOND WORD OF THIS ENTRY? JMP LP NO: LOOP JMP LP NO: LOOP * * HERE X WILL BE 0 IF THE DEVICE IS FOUND, ELSE NOT =0 * WE MUST RE-CONSTITUTE A THREE-CHARACTER NAME FIRST!. * ENDSRCH COPY ACTLEN(Y),A ACTUAL LENGTH CLSN A,=3 IS IT LENGTH 3? JMP ISTHREE YES: RECONSTITUTE THE NAME NAMBAK JEQ X,MBVOL NOT A DEVICE - IT MAY BE A VOLUME? JMP ISPARTA HERE IS A DEVICE (PART A) ISTHREE COPY STRING+1(Y),A GET WORD 1 OF THE STRING SHIFT A,LO,8 REPLACE THE SHIFTED CHARACTER ... COPY A,STRING+1(Y) IN STRING WORD 1 JMP NAMBAK NOW CHECK FOR DEVICE   STATUS * * HERE WE MUST INCREMENT THE PART A LENGTH * RDPARTB IMS PALEN(Y) INCREMENT PART A LENGTH (FOR TERMINATOR) * * NOW WE MUST INCREMENT THE UID LENGTH (INDEX), INSERT THE TERMINATOR, * AND READ PART B. * NXTPARTB COPY UIDL(Y),X UID INDEX IN X COPY *ATERM(Y),A GET THE TERMINATOR IN A COPY UID(Y),Q GET UID ADDRESS IN Q EXCH Q,Y UID ADDRESS IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB A,0(Y,X) STORE BYTE IN THE UID RBIT 2,S WORD MODE COPY Q,Y RESTORE Y IMS UIDL(Y) INC UID LENGTH (INDEX) COPY Y,X ADD =MAXCHS,X X SET UP FOR CALL JSK C:RDSTR READ THE STRING JEQ A,$+2 SKIP IF NO ERROR JMP ERROR HERE BAD REPLY - ABORT!  COPY ACTLEN(Y),A JNE A,$+2 SKIP IF NOT NULL STRING JMP EXWT IF NULL STRING, EXIT WITH TERMINATOR ADD UIDL(Y),A THIS WILL BE UID LENGTH CSK A,=254 WILL IT FIT IN WITH TERMINATOR? JMP ISPARTB YES: SKIP ERROR CODE NOP NO: WON'T FIT! TOOBIG COPY =-21,A -21 ->NAME WILL NOT FIT IN UID JMP ERROR TAKE ERROR EXIT * * HERE WE MUST INSERT THE STRING IN PART B * ISPARTB COPY ACTLEN(Y),A ACTUAL LENGTH IN A COPY =0,X INDEX IN (TO STRING) IS 0 COPY UIDL(Y),Q INDEX OUT (TO UID) IS UID LENGTH JSK C:MOVBTS MOVE IN THE STRING COPY UIDL(Y),A UID LENGTH ADD ACTLEN(Y),A COPY A,UIDL(Y) UPDATE UID LENGTH (INDEX) COPY PBLEN(Y),A ADD ACTLEN(Y),A COPY A,PBLEN(Y) UPDATE PART B LENGTH * * NOW WE MUST CHECK THE TERMINATOR, IF ITS '/' ITS STILL PART B * COPY *ATERM(Y),A GET TERMINATOR CLSN A,='/' IS IT A '/' ? JMP STILLPB HERE IS SLASH, STILL PART B CLSN A,='.' IS IT A '.' (EXTENSION FOLLOWS)? JMP ISEXTN YES: DEAL WITH EXTENSION JMP EXWT NO: JUST EXIT WITH THE TERMINATOR STILLPB IMS PBLEN(Y) INC PART B LENGTH JMP NXTPARTB AND INSERT TERMINATOR, READ NEXT FILENAME * * HERE ENTER WITH '.', MUST STORE IT AWAY AND READ THE EXTENSION * ISEXTN IMS PCLEN(Y) INCREMENT PART C LENGTH COPY UIDL(Y),X UID INDEX IN X COPY UID(Y),Q GET UID ADDRESS IN Q EXCH Q,Y UID ADDRESS IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB A,0(Y,X) STORE '.' IN THE UID RBIT 2,S WORD MODE COPY Q,Y RESTORE Y IMS UIDL(Y) INCREMENT UID LENGTH * * NOW MUST READ THE THREE-BYTE EXTENSION * COPY =3,A MAX LENGTH IS 3 BYTES COPY A,MAXCHS(Y) STORE FOR CALL COPY Y,X ADD =MAXCHS,X X SET UP FOR C:RDSTR CALL JSK C:RDSTR READ THE STRING JEQ A,$+2 SKIP IF NO ERROR JMP ERROR HERE BAD REPLY - ABORT! COPY ACTLEN(Y),A GET ACTUAL LENGTH JNE A,$+2 SKIP IF NOT NULL STRING JMP EXWT IF NULL, EXIT WITH TERMINATOR ADD UIDL(Y),A THIS WILL BE UID LENGTH CSK A,=254 WILL STRING FIT IN? JMP $+2 YES: SKIP THE ERROR JUMP JMP TOOBIG NO: TOO BIG FOR UID BLOCK COPY ACTLEN(Y),A ACTUAL LENGTH COPY =0,X INDEX IN (TO STRING) IS 0 COPY UIDL(Y),Q INDEX OUT (TO UID) IS UID LENGTH JSK C:MOVBTS MOVE THE BYTES COPY UIDL(Y),A ADD ACTLEN(Y),A COPY A,UIDL(Y) UPDATE THE UID LENGTH COPY PCLEN(Y),A ADD ACTLEN(Y),A COPY A,PCLEN(Y) UPDATE LENGTH OF PART C JMP EXWT AND EXIT WITH TERMINATOR END ETITL2 C:RDSTR MAXCHSX EQU 0 MAX NUMBER OF CHARS IN THE STRING ASTRNGX EQU MAXCHSX+1 ADDRESS TO STORE THE STRING GCRX EQU ASTRNGX+1 ROUTINE TO GET A CHARACTER XRX EQU GCRX+1 X-REG FOR THE ABOVE AACTLENX EQU XRX+1 ADDRESS TO STORE ACTUAL LENGTH ATERMX EQU AACTLENX+1 ADDRESS TO STORE TERMINATOR REPLYX EQU ATERMX+1 ADDRESS TO STORE REPLY MAXCHS EQU 2 MAX NUMBER OF CHARS IN THE STRING STRING EQU MAXCHS+1 ADDRESS TO STO  RE THE STRING RCH EQU STRING+1 ROUTINE TO GET A CHARACTER XRCH EQU RCH+1 X-REG FOR THE ABOVE AACTLEN EQU XRCH+1 ADDRESS TO STORE ACTUAL LENGTH ATERM EQU AACTLEN+1 ADDRESS TO STORE TERMINATOR REPLY EQU ATERM+1 ADDRESS TO STORE REPLY NXTBYT EQU REPLY+1 CURRENT BYTE NUMBER CUBYTE EQU NXTBYT+1 CURRENT BYTE ENDSTK EQU CUBYTE END STACK MARKER ETITL C:RDSTR * * C:RDSTR - READS A STRING OF MAXIMUM LENGTH N BYTES INTO A VECTOR. * ON ENTRY X POINTS TO A PARAMETER BLOCK OF FORM: * WORD 0 MAX NUMBER OF CHARACTERS (N) * WORD 1 ADDRESS TO STORE STRING * WORD 2 ADDRESS OF ROUTINE TO CALL TO GET CHARACTERS * WORD 3 X-REGISTER VALUE ON CALL OF ABOVE ROUTINE * WORD 4 ADDRESS TO RETURN THE ACTUAL LENGTH OF THE STRING * WORD 5 ADDRESS TO RETURN THE TERMINATING CHARACTER * WORD 6 ADDRESS TO RETURN REPLY * * NOTE * ==== * IT IS THE RESPONSIBILITY OF THE CALLING ROUTINE TO SET WORD 1 OF * THE VECTOR WHICH IS PASSED ON TO THE 'GET CHARACTER' ROUTINE TO THE * ADDRESS AT WHICH THE CHARACTER SHOULD BE RETURNED. THE GET CHARACTER * WILL NORMALLY RETURN THE CHARACTER IN THE UPPER BYTE OF THE GIVEN * ADDRESS. IF END OF FILE IS FOUND THEN THE WORD WILL BE -VE (IE THE * BYTE WILL BE SET TO -1). * NAM C:RDSTR C:RDSTR ENT:EII ENDSTK COPY MAXCHSX(X),A FETCH AND SAVE ... COPY A,MAXCHS(Y) COPY ASTRNGX(X),A COPY A,STRING(Y) COPY GCRX(X),A COPY A,RCH(Y) COPY AACTLENX(X),A COPY A,AACTLEN(Y) COPY ATERMX(X),A COPY A,ATERM(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS EXCEPT XRX COPY Y,A ADD =CUBYTE,A ADDRESS TO STORE CHARACTER READ COPY XRX(X),X X REGISTER FOR CHAR GETTER COPY A,1(X) STORE ADDRESS TO RETURN CHARS COPY X,XRCH(Y) SAVE FOR RCH CALL COPY =0,A COPY A,NXTBYT(Y) BYTE ZERO NOW * * NOW WE READ THE STRING * STRLP COPY XRCH(Y),X X-REGISTER FOR CALL JSK *RCH(Y) CALL GET CHARACTER ROUTINE JNE A,BADEX JUMP IF ERROR COPY CUBYTE(Y),A GET CURRENT BYTE SHIFT A,RA,8 IN LOWER BYTE (UNLESS -VE) CSK A,='z' IN RANGE 'a'-'z' ? CSK A,='a'-1 JMP $+2 NO ACTION IF NOT 'a'-'z' ADD ='A'-'a',A MAKE 'A'-'Z' CSK A,='Z' UPPER CASE LETTER? CSK A,='A'-1 JMP $+2 JMP LEGALCH HERE CHARACTER IS LEGAL COPY NXTBYT(Y),Q BYTE # IN Q JEQ A,NOTLEGAL ONLY 'A'-'Z' LEGAL FOR BYTE 0 CSK A,='9' IS IT '0'-'9' ? CSK A,='0'-1 JMP $+2 JMP LEGALCH HERE IT IS LEGAL CLSN A,=':' IS IT A COLON? JMP LEGALCH YES: LEGAL CLSN A,='_' IS IT UNDERSCORED BLANK JMP LEGALCH YES: LEGAL * * HERE CHARACTER IS NOT LEGAL, SO MUST TERMINATE. * NOTLEGAL COPY A,*ATERM(Y) STORE TERMINATOR FOR CALLER COPY NXTBYT(Y),A COPY A,*AACTLEN(Y) RETURN NUMBER OF CHARS INPUT COPY =0,A 0 => GOOD REPLY BADEX COPY A,*REPLY(Y) STORE REPLY FOR USER RET:EII * * HERE CHARACTER IS LEGAL, BUT DO WE INSERT IT? * LEGALCH COPY NXTBYT(Y),Q BYTE NUMBER IN Q COPY Q,X AND X ADD =1,Q BYTE+1 IN Q CSK Q,MAXCHS(Y) IS IT = MAXCHS? JMP INSERTIT Q ERROR! * * DROP THROUGH TO ... * * HERE MUST INSERT CHARACTER AT BYTE POSITION X AND SAVE Q IN NXTBYT * INSERTIT COPY Q,NXTBYT(Y) UPDATE BYTE NUMBER COPY STRING(Y),Q GET STRING ADDRESS IN Q EXCH Q,Y Y=STRING ADDRESS, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB A,0(Y,X) STORE BYTE IN STRING RBIT 2,S WORD MODE COPY Q,Y RESTORE Y JMP STRLP AND CONTINUE TILL TERMINATOR FOUND END ETITL2 C:CVUID0 SIDX EQU 0 SID ADDRESS UIDX EQU SIDX+1 UID AD  DRESS REPLYX EQU UIDX+1 ADDRESS TO STORE REPLY UID EQU 2 UID ADDRESS REPLY EQU UID+1 ADDRESS TO STORE REPLY ENDSTK EQU REPLY END OF STACK MARKER ETITL C:CVUID0 ************************************************************************ *  * * E I I S E R V I C E --- C : C V U I D 0 --- * *  * ************************************************************************ NAM C:CVUID0 C:CVUID0 ENT:EII ENDSTK EXTR C:CKOPEN COPY UIDX(X),A FETCH AND SAVE ... COPY A,UID(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS EXCEPT SID COPY SIDX(X),X WHICH WE NEED IN X NOW JSK C:CKOPEN CHECK OPEN SID ETC JNE A,ERRCV0 JUMP IF AN ERROR COPY Q,X GET SCB ADDRESS IN X COPY SCB:UID(X),X REPLACE X BY ADDRESS OF UID COPY JNE X,MXFER HERE SPECIFIED, MUST TRANSFER * * HERE THE UID IS ZERO - IT MAY HAVE BEEN AUTOMATICALLY OPENED * COPY A,*UID(Y) ZERO FIRST ... IMS UID(Y) COPY A,*UID(Y) ... AND SECOND WORDS OF UID ERRCV0 COPY A,*REPLY(Y) GIVE REPLY TO USER RET:EII * * HERE WE HAVE THE SAVED UID ADDRESS IN X, MUST TRANSFER TO UID * MXFER COPY BCPARTA(X),Q BYTE COUNT / PART A SHIFT Q,RO,9 BYTE COUNT / 2 ADD =1,Q WORD COUNT IN Q LOOP COPY 0(X),A WORD N COPY A,*UID(Y) STORE IN THE UID ADD =1,X INC INDEX INTO SAVED UID IMS UID(Y) AND INTO THE NEW UID JNED Q,LOOP DECREMENT COUNT, LOOP TILL DONE COPY =0,A 0 => GOOD REPLY JMP ERRCV0 STORE REPLY AND EXIT END ADDRESS REPLYX EQU UIDX+1 ADDRESS TO STORE REPLY UID EQU 2 UID ADDRESS REPLY EQU UID+1 ADDRESS TO STORE REPLY ENDSTK EQU REPLY END OF STACK MARKER ETITL C:CVUID0 ************************************************************************ *  ETITL3 C:RDFST0 UIDX EQU 0 ALOPSX EQU 1 AFTYPX EQU 2 ARHFBAX EQU 3 REPLYX EQU 4 UID EQU 2 SID EQU UID+1 REPLY EQU UID+2 RSID EQU 5 ARHFBA EQU RSID+1 RREPLY EQU RSID+2 ALOPS EQU 8 AFTYP EQU 9 ACTSID0 EQU :A ACTSID1 EQU :B COUNT EQU :C CUUAT EQU :D AFDD EQU :1FFF FACD EQU :10C0 FRCD EQU :100 FWCD EQU :200 FPCD EQU :400 NWP EQU :FFFD EXUAT EQU 1 ETITL C:RDFST0 ************************************************************************ * * *  E I I S E R V I C E --- C : R D F S T 0 --- * *  * ************************************************************************ NAM C:RDFST0 EXTR C:OPEN0,C:CLOSE0,C:REOF0 C:RDFST0 ENT:EII :D COPY UIDX(X),A FETCH AND SAVE ... COPY A,UID(Y) COPY ALOPSX(X),A COPY A,ALOPS(Y) COPY AFTYPX(X),A COPY A,AFTYP(Y) COPY ARHFBAX(X),A COPY A,ARHFBA(Y) COPY REPLYX(X),A COPY A,REPLY(Y) COPY A,RREPLY(Y) ... ALL PARAMETERS COPY Y,A NOW SET UP SID ADDRESSES ADD =ACTSID0,A ADDRESS OF ACTUAL SID COPY A,SID(Y) STORE AS SID ADDRESS COPY A,RSID(Y) AND SAME FOR REOF0 CALL COPY =0,A NOW WE ZERO THE SID COPY A,ACTSID0(Y) FIRST AND ... COPY A,ACTSID1(Y) ... SECOND WORDS COPY Y,X ADD =UID,X X SET UP FOR C:OPEN0 CALL JSK C:OPEN0 OPEN THE FILE/DEVICE JNE A,ERRRST0 HERE ERROR ON OPEN COPY SID(Y),X ADDRESS LUN IN X E:SLU 0(X) SEARCH FOR LOG UNIT JEQ A,FNDENT JUMP IF FOUND ENTRY COPY =-99,A -99 => EII SYSTEM ERROR (IMPOSSIBLE!?)  JMP CLEXIT NOW ERROR, MUST CLOSE AND EXIT TITL * * HERE HAVE FOUND THE UAT ENTRY FNDENT COPY 1(X),X GET DIB/FCB ADDRESS IN X COPY DI:FLG(X),A GET DIB/FCB FLAGWORD JLT A,GOTFCB JUMP IF HAVE AN FCB COPY =FACD,Q FUNCTIONS ON ALL CHARACTER DEVICES COPY DI:DSW(X),A GET READ SPECIFICATION WORD JEQ A,$+2 SKIP IF CAN'T READ OR =FRCD,Q OR IN READ FUNCTIONS COPY DI:DSW+1(X),A GET WRITE SPECIFICATION WORD AND =NWP,A GET RID OF WRITE PROMPT JEQ A,$+2 SKIP IF CAN'T WRITE OR =FWCD,Q OR IN WRITE FUNCTIONS COPY DI:DSW+2(X),A GET POSITION SPECIFICATION WORD JEQ A,$+2 SKIP IF CAN'T POSITION OR =FPCD,Q OR IN POSITION FUNCTIONS COPY Q,*ALOPS(Y) STORE LEGAL OPS AT REQ'D PLACE COPY =3,A 3 => THIS IS A DEVICE COPY A,*AFTYP(Y) STORE FILE TYPE AT REQ'D PLACE COPY =0,A NOW TO ZERO HIGH FBA COPY A,*ARHFBA(Y) ZERO FIRST WORD OF HIGH FBA IMS ARHFBA(Y) COPY A,*ARHFBA(Y) AND SECOND WORD OF HIGH FBA NMLCLEX COPY Y,X HERE NORMAL CLOSE AND EXIT ADD =SID,X X NOW SET UP FOR C:CLOSE0 JSK C:CLOSE0 NOW CLOSE THE FILE/DEVICE ERRRST0 RET:EII * LPOOL TITL * * HERE WE HAVE AN OPEN FILE GOTFCB COPY =AFDD,A ALL FUNCTIONS FOR DISK DEVICES COPY A,*ALOPS(Y) STORE LEGAL OPS AT REQ'D PLACE COPY UID(Y),X UID ADDRESS IN X COPY =-18,A 18 FILENAMES POSSIBLE COPY A,COUNT(Y) SAVE IN COUNT FOR IMS LOOP LOOP COPY 2(X),A GET FIRST CHARACTER ... SHIFT A,RO,8 ... OF FILENAME JEQ A,ENDFN HERE END OF PATHNAME ADD =7,X MOVE X ON TO NEXT FILENAME (-2 WORDS) IMS COUNT(Y) INC COUNT, AM I PAST END OF UID? JMP LOOP NO: LOOP TILL END PATHNAME ENDFN COPY 0(X),A GET FIRST WORD OF EXTENSION AND =:FF,A BOTTOM BYTE ONLY CLSN A,='D' IS IT 'D' (OF 'DIR')? JMP $+2 SKIP IF MAY BE DIRECTORY JMP NOTDIR HERE A DATAFILE COPY 1(X),A SECOND WORD OF EXTENSION CSK A,='IR' IS IT 'IR' (OF 'DIR')? JMP NOTDIR HERE NOT DIRECTORY JMP NOTDIR SAME HERE COPY =1,A 1 => DIRECTORY FILE JMP $+2 NOW STORE IT AND EXIT NOTDIR COPY =2,A 2 => DATA FILE COPY A,*AFTYP(Y) STORE FILE TYPE AT REQ'D PLACE COPY Y,X ADD =RSID,X X SET UP FOR C:REOF0 CALL JSK C:REOF0 READ EOF TO USER'S ADDRESS JEQ A,NMLCLEX IF ZERO, NORMAL CLOSE AND EXIT CLEXIT COPY A,COUNT(Y) SAVE ERROR CODE IN COUNT COPY Y,X ADD =SID,X X SET UP FOR C:CLOSE0 CALL JSK C:CLOSE0 CLOSE FILE COPY COUNT(Y),A RETRIEVE SAVED ERROR CODE COPY A,*REPLY(Y) STORE SAVED REPLY FOR USER JMP ERRRST0 HERE NORMAL EXIT END ETITL3 C:DTTIM0 * * EQUATES FOR C:DTTIM0 * BADRX EQU 0 REPLYX EQU 1 BADR EQU 2 REPLY EQU 3 SWB EQU 4 ETITL C:DTTIM0 ************************************************************************ *  * * E I I S E R V I C E --- C : D T T I M 0 ---  * * * ************************************************************************ NAM C:DTTIM0 C:DTTIM0 ENT:EII :A COPY BADRX(X),A FETCH AND SAVE ... COPY A,BADR(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS R:GATD SWB(Y) GET TIME AND DATE IN 7-WORD BLOCK COPY SWB(Y),Q GET YEAR JSK CONVT CONVERT TO A NUMBER COPY Q,*BADR(Y) STORE IN BLOCK IMS BADR(Y) NOW POINT TO NEXT ENTRY COPY SWB+1(Y),Q GET MONTH JSK CONVT CONVERT TO A NUMBER COPY Q,*BADR(Y) STORE IN BLOCK IMS BADR(Y) NOW POINT TO NEXT ENTRY COPY SWB+2(Y),Q GET DAY JSK CONVT CONVERT  TO A NUMBER COPY Q,*BADR(Y) STORE IN BLOCK IMS BADR(Y) NOW POINT TO NEXT ENTRY COPY SWB+3(Y),Q GET HOUR JSK CONVT CONVERT TO A NUMBER COPY Q,*BADR(Y) STORE IN BLOCK IMS BADR(Y) NOW POINT TO NEXT ENTRY COPY SWB+4(Y),Q GET MINUTE JSK CONVT CONVERT TO A NUMBER COPY Q,*BADR(Y) STORE IN BLOCK IMS BADR(Y) NOW POINT TO NEXT ENTRY COPY SWB+5(Y),Q GET SECOND JSK CONVT CONVERT TO A NUMBER COPY Q,*BADR(Y) STORE IN BLOCK COPY =0,A COPY A,REPLY(Y) RETURN 0 => SUCCESS (ALWAYS) RET:EII * * LOCAL SUBROUTINE CONVT, CONVERTS 2 CHARS TO AN INTEGER * CONVT COPY Q,A COPY IN A SHIFT Q,RO,8 Q=UPPER BYTE SUB ='0',Q Q=NUMBER AND =:FF,A A=LOWER BYTE SUB ='0',A A=NUMBER MUL =10,AQ Q=RESULT RSK END ETITL3 C:LOAD0 ************************************************************************ * * * E I I S E R V I C E --- C : L O A D 0 --- * * * ************************************************************************ * PARAMETER LIST EQUATES UFN EQU 0 BASE EQU 1 LIMIT EQU 2 START EQU 3 HIGH EQU 4 REPLY EQU 6 * I:LOAD PARAMETER LIST LD EQU 2 * NAM C:LOAD0 C:LOAD0 ENT:EII 10 EXCH X,Y COPY:M *UFN(Y),A,LD+LD:LUN(X) LOGICAL UNIT COPY:M BASE(Y),A,LD+LD:OFF(X) RELOCATION OFFSET COPY A,LD+LD:LLL(X) LOW LOAD LIMIT COPY:M LIMIT(Y),A,LD+LD:HLL(X) HIGH LOAD LIMIT COPY:M =0,A,LD+LD:BUF(X) ALLOCATE BUFFER FROM STACK COPY:M =10,A,LD+LD:SIZE(X) BLOCK SIZE * I:LOAD LD(X) DO THE LOAD NOP ABNORMAL RETURN COPY:M LD+LD:XAD(X),A,*START(Y) EXECUTION ADDRESS COPY LD+LD:HAD(X),A HIGH LOAD ADDRESS SUB =1,A HIGHEST WORD LOADED COPY A,*HIGH(Y) STORE ADDRESS HIGHEST WORD LOADED COPY LD+LD:FLG(X),A STATUS AND =:7FFF,A TURN OFF ERROR BIT COPY A,*REPLY(Y) RETURN STATUS EXCH X,Y RET:EII END ETITL3 C:EXIT0 USERID EQU 2 CUSID EQU 3 ZERO EQU 4 REPLY EQU 5 SIDAD EQU 6 REPLAD EQU 7 SCB EQU 8 ENDSTK EQU SCB ETITL C:EXIT0 ************************************************************************ * * * E I I S E R V I C E ---  C : E X I T 0 --- * * * ************************************************************************ NAM C:EXIT0 NAM C:EXIT0A EXTR C:CLOSE0,C:SCBCH,C:TERM,E:CIFP,E:SLFP C:EXIT0 EQU $ JSK C:EXIT0A COPY C:TERM,X EXIT FROM OS4 OR RTX4 JMP 0(X) C:EXIT0A ENT:EII ENDSTK COPY R:ACT,X GET USERID IN X COPY X,USERID(Y) SAVE USERID FOR CLOSE LOOP COPY Y,A ADD =CUSID,A POINTS TO CURRENT SID COPY A,SIDAD(Y) SID ADDRESS SET UP ADD =REPLY-CUSID,A POINTS TO REPLY COPY A,REPLAD(Y) REPLY ADDRESS SET UP COPY =0,A COPY A,ZERO(Y) SECOND WORD SID =0 COPY C:SCBCH,X SCB ADDRESS IN X JMP ILP JUMP INTO LOOP LP COPY SCB(Y),X GET SCB IN X COPY SCB:CHN(X),X NEXT SCB ILP JEQ X,ENDEXIT HERE DONE COPY X,SCB(Y) SAVE CURRENT SCB COPY SCB:USR(X),A GET USERID IN SCB CSK A,USERID(Y) IS IT OWNED BY THIS USER? JMP LP NO: LOOP JMP LP NO: LOOP COPY SCB:FLW(X),A YES: GET FLAG FROM SCB CLSN A,=UNUSED: SKIP IF USED JMP LP LOOP IF NOT USED COPY SCB:LUN(X),A LUN/SID COPY A,CUSID(Y) SID SET UP FOR CLOSE COPY Y,X ADD =SIDAD,X ADDRESS SET UP FOR C:CLOSE0 JSK C:CLOSE0 CLOSE FI LE JMP LP AND LOOP TILL END OF SCB CHAIN ENDEXIT EQU $ RET:EII END ETITL3 C:WRLOG0 * * EQUATES FOR C:WRLOG0 * MADRX EQU 0 MEMORY ADDRESS LENGTHX EQU MADRX+1 LENGTH OF MESSAGE REPLYX EQU LENGTHX+1 ADDRESS TO STORE REPLY * SID EQU 2 SID FOR C:WR0 CALL BADR EQU SID+1 BUFFER ADDRESS NBYTES EQU SID+2 BYTES TO XFER RBCNT EQU SID+3 ACTUAL BYTES XFERRED REPLY EQU SID+4 ADDRESS TO STORE REPLY ACTSID EQU REPLY+1 ACTUAL SID ARBCNT EQU ACTSID+2 ADDRESS AT WHICH TO RETURN BYTE COUNT ENDSTK EQU ARBCNT END OF STACK MARKER ETITL C:WRLOG0 ************************************************************************ *  * * E I I S E R V I C E --- C : W R L O G 0 --- * *  * ************************************************************************ NAM C:WRLOG0 EXTR C:WR0 C:WRLOG0 ENT:EII ENDSTK COPY MADRX(X),A FETCH AND SAVE ... COPY A,BADR(Y) COPY LENGTHX(X),A COPY A,NBYTES(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * * NOW DO INITIALISATION * COPY Y,X ADD =ACTSID,X ADDRESS OF ACTUAL SID COPY X,SID(Y) STORE FOR C:WR0 CALL ADD =ARBCNT-ACTSID,X ADDRESS TO RETURN BYTE COUNT COPY X,RBCNT(Y) STORE FOR C:WR0 CALL COPY =0,A COPY A,ACTSID+1(Y) INSERT SID TERMINATOR COPY ='OC',A COPY A,ACTSID(Y) FIRST OUTPUT IS TO 'OC' ADD =SID-ARBCNT,X X SET UP FOR C:WR0 CALL JSK C:WR0 WRITE OUT THE DATA JNE A,EXIT IF ERROR, EXIT E:SLU ='OC' SEARCH LUT FOR 'OC' COPY 1(X),A COPY A,ACTSID(Y) SAVE DIB ADDRESS IN ACTSID E:SLU ='SL' SEARCH LUT FOR 'SL' COPY 1(X),A SUB ACTSID(Y),A SUBTRACT 'OC' DIB ADDRESS JEQ A,EXIT IF IT'S THE SAME DEVICE, THAT'S ALL! COPY ='SL',A COPY A,ACTSID(Y) SID SET UP FOR SECOND WRITE COPY Y,X ADD =SID,X X SET UP FOR C:WR0 CALL JSK C:WR0 WRITE DATA TO 'SL' * * EXIT, REPLY IN A (AND *REPLY(Y) ) * EXIT RET:EII END ETITL3 C:UNMAP0 ************************************************************************ *  * * E I I S E R V I C E --- C : U N M A P 0 --- * *  * ************************************************************************ * REPLY EQU 5 ADDRESS TO STORE REPLY (OFF X) * NAM C:UNMAP0 EXTR C:XXMAP0,C:WR0 * * CALLS COMMON CODE (BY JUMP) AT C:XXMAP0 * C:UNMAP0 COPY =C:WR0,A ADDRESS IN A OF FN TO CALL EXCH X,Y PARAM LIST IN Y, SAVE Y IN X COPY A,*REPLY(Y) SAVE FN ADDRESS TEMP AT ADDRESS OF REPLY EXCH Y,X RESTORE X AND Y JMP C:XXMAP0 ENTER COMMON CODE END ETITL3 C:MAP0 ************************************************************************ * * *  E I I S E R V I C E --- C : M A P 0 --- * *  * ************************************************************************ * REPLY EQU 5 ADDRESS TO STORE REPLY (OFF X) * NAM C:MAP0 EXTR C:XXMAP0,C:RD0 * * CALLS COMMON CODE (BY JUMP) AT C:XXMAP0 * C:MAP0 COPY =C:RD0,A ADDRESS IN A OF FN TO CALL EXCH X,Y PARAM LIST IN Y, SAVE Y IN X COPY A,*REPLY(Y) SAVE FN ADDRESS TEMP AT ADDRESS OF REPLY EXCH Y,X RESTORE X AND Y  JMP C:XXMAP0 ENTER COMMON CODE END ETITL3 C:XXMAP0 * * EQUATES FOR C:MAP0 AND C:UNMAP0 (THIS IS COMMON CODE) * SIDX EQU 0 ADDRESS OF SID MADRX EQU SIDX+1 MEMORY ADDRESS LENGTHX EQU MADRX+1 LENGTH OF TRANSFER CFI1X EQU LENGTHX+1 CFI WORD 1 CFI2X EQU CFI1X+1 CFI WORD 2 REPLYX EQU CFI2X+1 ADDRESS TO STORE REPLY * SID EQU 2 SID FOR C:WR0 OR C:RD0 CALL BADR EQU SID+1 BUFFER ADDRESS FOR C:WR0 OR C:RD0 CALL NBYTES EQU SID+2 BYTES TO XFER FOR C:WR0 OR C:RD0 CALL RBCNT EQU SID+3 ACTUAL BYTES XFERRED FOR C:WR0 OR C:RD0 CALL REPLY EQU SID+4 ADDRESS TO STORE REPLY FOR C:WR0 OR C:RD0 CALL SID2 EQU REPLY+1 SID FOR C:POS0 CFI1 EQU SID2+1 CFI FOR ... CFI2 EQU SID2+2 ... C:POS0 RCFI EQU SID2+3 RETURNED CFI GOES HERE REPLY2 EQU SID2+4 ADDRESS TO STORE REPLY FOR C:POS0 ADFN EQU REPLY2+1 ADDRESS OF FN TO CALL ACTCFI EQU ADFN+1 ACTUAL CFI RETURNED HERE ENDSTK EQU ACTCFI+1 END OF STACK MARKER ETITL C:XXMAP0 ************************************************************************ *  * * E I I S E R V I C E --- C : X X M A P 0 --- * *  * ************************************************************************ * NAM C:XXMAP0 EXTR C:POS0 C:XXMAP0 ENT:EII ENDSTK COPY SIDX(X),A FETCH AND SAVE ... COPY A,SID(Y) COPY A,SID2(Y) COPY MADRX(X),A COPY A,BADR(Y) COPY LENGTHX(X),A COPY A,NBYTES(Y) COPY CFI1X(X),A COPY A,CFI1(Y) COPY CFI2X(X),A COPY A,CFI2(Y) COPY REPLYX(X),A COPY A,REPLY(Y) COPY A,REPLY2(Y) COPY *REPLY(Y),A COPY A,ADFN(Y) ... ALL PARAMETERS * * NOW DO INITIALISATION * COPY Y,X ADD =ACTCFI,X ADDRESS OF ACTUAL CFI COPY X,RCFI(Y) STORE AS ADDRESS TO RETURN CFI COPY X,RBCNT(Y) AND AS ADDRESS TO RETURN BYTE COUNT * * FIRST POSITION THE SID * ADD =SID2-ACTCFI,X X NOW SET UP FOR POSITION CALL JSK C:POS0 POSITION THE FILE JNE A,EXIT JUMP IF AN ERROR * * NOW WE READ OR WRITE (AS NECESSARY) * COPY Y,X ADD =SID,X X NOW SET UP FOR C:WR0 OR C:RD0 CALL  JSK *ADFN(Y) CALL THE APPROPRIATE ROUTINE EXIT RET:EII END OR C:RD0 CALL SID2 EQU REPLY+1 SID FOR C:POS0 CFI1 EQU SID2+1 CFI FOR ... CFI2 EQU SID2+2 ... C:POS0 RCFI EQU SID2+3 RETURNED CFI GOES HERE REPLY2 EQU SID2+4 ADDRESS TO STORE REPLY FOR C:POS0 ADF ETITL4 C:DEL0 * * EQUATES FOR C:DEL0 * UIDX EQU 0 UID ADDRESS REPLYX EQU UIDX+1 ADDRESS TO STORE REPLY REPLY EQU 2 ADDRESS TO STORE REPLY UID EQU REPLY+1 UID ADDRESS SID EQU UID+1 ACTREPLY EQU SID+1 ADDRESS OF REPLY VECTOR ACTSID EQU ACTREPLY+1 ACTUAL SID (TWO WORDS) REPVECT EQU ACTSID+2 ADDRESS TO STORE REPLY DELBK EQU REPVECT+1 DELETE BLOCK STARTS HERE NAME EQU DELBK+NAMPT: VOL EQU DELBK+VOLPT: PUN EQU DELBK+PUN: FNO EQU DELBK+FNO: ACTNAME EQU DELBK+RLN:+1 ACTUAL LOCATION OF RETURNED NAME ENDSTK EQU ACTNAME+6 END OF STACK MARKER ETITL C:DEL0 ************************************************************************ *  * * E I I S E R V I C E --- C : D E L 0 ---  * * * ************************************************************************ NAM C:DEL0 EXTR C:PTOPEN C:DEL0 ENT:EII ENDSTK COPY UIDX(X),A FETCH AND SAVE ... COPY A,UID(Y) COPY R EPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS COPY =0,A COPY A,ACTSID(Y) ZERO FIRST AND ... COPY A,ACTSID+1(Y) ... SECOND WORDS OF SID COPY Y,X ADD =ACTSID,X ADD ADDRESS OF ACTUAL SID COPY X,SID(Y) SET UP FOR PARTIAL OPEN ADD =REPVECT-ACTSID,X NOW X= ADDRESS REPLY VECTOR COPY X,ACTREPLY(Y) SET UP FOR PARTIAL OPEN ADD =UID-REPVECT,X ADDRESS IN X FOR PARTIAL OPEN JSK C:PTOPEN DO PARTIAL OPEN JNE A,ERRDL0 JUMP IF PARTIAL OPEN FAILS UNLOCK F:DELE DELBK(Y) DELETE FILE JNE A,DELOK IF NOT 0 DELETE SUCCEEDS COPY =-13,A -13 => DELETE FAILURE JMP ERRDL0 ERROR EXIT DELOK COPY =0,A 0 => SUCCESS! ERRDL0 COPY A,*REPLY(Y) RETURN REPLY RET:EII * * END OF D E L 0 EII FUNCTION * END ETITL4 C:CREAT0 * * EQUATES FOR C:CREAT0 * UIDX EQU 0 UID ADDRESS FLTYPEX EQU UIDX+1 FILE TYPE REPLYX EQU FLTYPEX+1 ADDRESS TO STORE REPLY REPLY EQU 2 ADDRESS TO STORE REPLY FLTYPE EQU REPLY+1 FILE TYPE UID EQU FLTYPE+1 UID ADDRESS SID EQU UID+1 ADDRESS OF SID ACTREPLY EQU UID+2 ADDRESS OF REPLY VECTOR ACTSID EQU ACTREPLY+1 ACTUAL SID (TWO WORDS) CRFNO EQU ACTSID+2 F-NUMBER OF CREATED FILE REPVECT EQU CRFNO+1 ADDRESS TO STORE REPLY CREATBK EQU REPVECT+1 CREATE (CREA:A BLOCK) STARTS HERE NAME EQU CREATBK+NAMPT: VOL EQU CREATBK+VOLPT: PUN EQU CREATBK+PUN: FNO EQU CREATBK+FNO: INXT EQU CREATBK+INXT: SEXT EQU CREATBK+SEXT: RLN EQU CREATBK+RLN: ACTNAME EQU RLN+1 HOLDS FILENAME RETURNED BY PARTIAL OPEN WBK EQU ACTNAME+7 WR0 BLOCK STARTS HERE WSID EQU WBK+0 WBUF EQU WBK+1 WNBYTS EQU WBK+2 WRBYTS EQU WBK+3 WREPLY EQU WBK+4 ENDSTK EQU WREPLY END OF STACK MARKER ETITL C:CREAT0 ************************************************************************ *  * * E I I S E R V I C E --- C : C R E A T 0 ---  * * * ************************************************************************ NAM C:CREAT0 EXTR C:PTOPEN,C:OPEN0,C:CLOSE0,C:WR0,C:EXTSIZ,C:DRENTS C:CREAT0 ENT:EII ENDSTK COPY UIDX(X),A FETCH AND SAVE ... COPY A,UID(Y) COPY REPLYX(X),A COPY A,REPLY(Y) COPY FLTYPEX(X),A COPY A,FLTYPE(Y) ... ALL PARAMETERS  CLSN A,=1 FILE TYPE = DIRECTORY? JMP FTOK YES: OK CLSN A,=2 NO: IS IT A DATAFILE? JMP FTOK YES: OK COPY =-10,A -10 => ILLEGAL FILE TYPE (FOR OS4/RTX4) ERRCR0 COPY A,*REPLY(Y) STORE REPLY RET:EII TITL * * HERE THE FILE TYPE IS EITHER DIRECTORY OR DATAFILE * FTOK COPY =0,A COPY A,ACTSID(Y) ZERO FIRST AND ... COPY A,ACTSID+1(Y) ... SECOND WORDS OF SID COPY A,RLN(Y) AND RECORD LENGTH COPY Y,X ADD =ACTSID,X ADD ADDRESS OF ACTUAL SID COPY X,SID(Y) SET UP FOR PARTIAL OPEN ADD =REPVECT-ACTSID,X NOW X= ADDRESS REPLY VECTOR COPY X,ACTREPLY(Y) SET UP FOR PARTIAL OPEN ADD =UID-REPVECT,X ADDRESS IN X FOR PARTIAL OPEN JSK C:PTOPEN DO PARTIAL OPEN JNE A,ERRCR0 JUMP IF PARTIAL OPEN FAILS UNLOCK COPY C:EXTSIZ,A EXTENT SIZE COPY A,INXT(Y) SET INITIAL EXTENT COPY A,SEXT(Y) AND SECONDARY EXTENT F:CREA CREATBK(Y) ATTEMPT TO CREATE FILE JNE A,$+3 OK IF NONZERO COPY =-11,A -11 => FILE ALREADY EXISTS JMP ERRCR0 ERROR EXIT COPY A,CRFNO(Y) SAVE CREATED F-NUMBER (FOR DIRECTORY) COPY FLTYPE(Y),A GET FILE TYPE CLSN A,=1 SKIP IF NOT DIRECTORY JMP ISDIRECT HERE IS DIRECTORY COPY =0,A 0 => ALL OK (DATAFILE NORMAL EXIT) JMP ERRCR0 SUC CESSFUL RETURN * LPOOL TITL * * NOW WE HAVE CREATED A BLANK DIRECTORY FILE AND HAVE * TO WRITE THE ENTRIES FOR THE PARENT DIRECTORY AND THIS * DIRECTORY (.. AND . RESPECTIVELY) IN THE FILE * ISDIRECT COPY Y,X ADD =UID,X ADDRESS OPEN BLOCK IN X JSK C:OPEN0 OPEN THE CREATED FILE JNE A,ERRCR0 REPLY WITH CODE IF ERROR COPY SID(Y),A COPY A,WSID(Y) SID SET UP FOR WRITE COPY FNO(Y),A GET PARENT F-NUMBER JNE A,$+2 JUMP IF NONZERO F-NUMBER IMS FNO(Y) IF WAS 0, MAKE A 1 COPY Y,X ADD =FNO,X ADDRESS PARENT F-NUMBER COPY X,WBUF(Y) NEED TO WRITE THOSE TWO BYTES COPY =2,A COPY A,WNBYTS(Y) # BYTES =2 ADD =REPVECT-FNO,X COPY X,WRBYTS(Y) ADDRESS SET FOR REPLY # BYTES ADD =ACTREPLY-REPVECT,X COPY X,WREPLY(Y) ADDRESS SET FOR REPLY ADD =WBK-ACTREPLY,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE PARENT F-NUMBER JNE A,WRFAIL JUMP IF WRITE FAILS COPY NAME(Y),A ADDRESS OF FILENAME COPY A,WBUF(Y) BUFFER ADDRESS SET COPY =14,A COPY A,WNBYTS(Y) # BYTES =14 COPY Y,X ADD =WBK,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE PARENT NAME JNE A,WRFAIL JUMP IF WRITE FAILS COPY Y,X ADD =FNO,X ADDRESS OF THIS F-NUMBER COPY X,WBUF(Y) NEED TO WRITE THESE 2 BYTES COPY =2,A COPY A,WNBYTS(Y) # BYTES =2 ADD =WBK-FNO,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE THIS FILES F-NUMBER JNE A,WRFAIL JUMP IF WRITE FAILS COPY PARENT,A COPY A,WBUF(Y) BUFFER ADDRESS SET COPY =14,A COPY A,WNBYTS(Y) # BYTES =14 COPY Y,X ADD =WBK,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE PARENT NAME JNE A,WRFAIL JUMP IF WRITE FAILS COPY Y,X ADD =CRFNO,X ADDRESS OF THIS F-NUMBER COPY X,WBUF(Y) NEED TO WRITE THESE 2 BYTES COPY =2,A COPY A,WNBYTS(Y) # BYTES =2 ADD =WBK-CRFNO,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE THIS FILES F-NUMBER JNE A,WRFAIL JUMP IF WRITE FAILS COPY THISDIR,A COPY A,WBUF(Y) BUFFER ADDRESS SET COPY =14,A COPY A,WNBYTS(Y) # BYTES =14 COPY Y,X ADD =WBK,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE THIS DIRECTORY'S NAME JNE A,WRFAIL JUMP IF WRITE FAILS * * NOW WE WILL WRITE SOME BLANK ENTRIES IN DIRED * COPY =C:DRENTS,A C:DRENTS BLANK ENTRIES NEG A,A NOW -VE ADD =3,A THERE ARE 3 ALREADY USED UP COPY A,FNO(Y) FNO IS COUNT (OF ENTRIES) COPY BLANK,A COPY A,WBUF(Y) ADDRESS OF BLANK ENTRY COPY =16,A COPY A,WNBYTS(Y) # BYTES =16 ENTLP COPY Y,X ADD =WBK,X ADDRESS FOR WR0 IN X JSK C:WR0 WRITE BLANK ENTRY JNE A,WRFAIL JUMP IF WRITE FAILS IMS FNO(Y) INC COUNT (FNO IS COUNT) JMP ENTLP LOOP TILL WRITTEN 40 * * HERE WE HAVE COMPLETED WRITING OR HAVE GOT AN ERROR * WE MUST NOW CLOSE THE FILE AND GIVE THE APPROPRIATE REPLY. * CLSFL COPY Y,X ADD =SID,X ADDRESS SID FOR CLOSE JSK C:CLOSE0 CLOSE FILE COPY =0,A 0 => ALL OK (DIRECTORY EXIT) JMP ERRCR0 SUCCESSFUL EXIT WRFAIL COPY Y,X ADD =SID,X ADDRESS SID FOR CLOSE JSK C:CLOSE0 CLOSE FILE COPY =-12,A -12 => WRITE FAILURE ON DIRECTORY CREATE JMP ERRCR0 * LPOOL * * DATA FOR PARENT AND 'THIS DIRECTORY' ENTRIES * PARENT WORD $+1 BYTE '.. ' * THISDIR WORD $+1 BYTE '. ' * BLANK WORD $+1 RES 8,0 END ETITL4 C:DRENTS NAM C:DRENTS SHARABLE TABLE: TABLE: REL C:DRENTS WORD 64 END ETITL4 C:POS0 * * EQUATES FOR C:POS0 * SIDX EQU 0 FBAX EQU 1 RETFBAX EQU 3 REPLYX EQU 4 SID EQU 2 FBA EQU 3 RETFBA EQU 5 REPLY EQU 6 SCB EQU 7 NL EQU :A NEWLINE ETITL C:POS0 ******************************************************************** **** * * * E I I S E R V I C E --- C : P O S 0 --- * * * ************************************************************************ NAM C:POS0 EXTR C:CKOPEN C:POS0 ENT:EII :6 COPY FBAX(X),A FETCH AND SAVE COPY A,FBA(Y) COPY FBAX+1(X),A COPY A,FBA+1(Y) COPY RETFBAX(X),A COPY A,RETFBA(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS EXCEPT SID ... COPY SIDX(X),X ... WHICH WE NEED IN X NOW. JSK C:CKOPEN CHECK OPEN SID ETC COPY Q,SCB(Y) SAVE RETURNED SCB JNE A,ERRPS0 IF REPLY NOT 0, AN ERROR COPY Q,X GET SCB ADDRESS IN X COPY =NL,A NEWLINE COPY A,SCB:ELT(X) MAKE LINE TERMINATOR COPY SCB:FLW(X),A GET SCB FLAGWORD CLSN A,=DISKU: SKIP IF NOT AN UNBUFFERED DISK JMP POSDISK HERE A DISK DEVICE CLSN A,=DISKB: SKIP IF NOT A BUFFERED DISK JMP POSDISK HERE A DISK DEVICE COPY =0,A COPY A,*RETFBA(Y) IMS RETFBA(Y) COPY A,*RETFBA(Y) RETURN POSITION OF ZERO COPY =-14,A -14 => POSITION NOT LEGAL FOR THIS DEVICE ERRPS0 COPY A,*REPLY(Y) RETURN REPLY RET:EII POSDISK COPY FBA(Y),A FBA WORD 1 COPY SCB:CFI(X),X CFI ADDRESS IN X COPY A,0(X) STORE CFI WORD 1 COPY A,*RETFBA(Y) AND RETURN IT IMS RETFBA(Y) COPY FBA+1(Y),A FBA WORD 2 COPY A,1(X) PUT IN CFI WORD 2 COPY A,*RETFBA(Y) AND RETURN IT COPY =0,A 0 => SUCCESS JMP ERRPS0 SUCCESSFUL RETURN END ETITL4 C:RDPOS0 * * EQUATES FOR C:RDPOS0 * SIDX EQU 0 RETFBAX EQU 1 REPLYX EQU 2 SID EQU 2 RETFBA EQU 3 REPLY EQU 4 SCB EQU 5 ETITL C:RDPOS0 ************************************************************************ * * * E I I S E R V I C E --- C : R D P O S 0  --- * * * ************************************************************************ NAM C:RDPOS0 EXTR C:CKOPEN C:RDPOS0 ENT:EII :4 COPY RETFBAX(X),A FETCH AND SAVE COPY A,RETFBA(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS EXCEPT SID ... COPY SIDX(X),X ... WHICH WE NEED IN X NOW. JSK C:CKOPEN CHECK OPEN SID ETC COPY Q,SCB(Y) SAVE RETURNED SCB JNE A,ERRRP0 IF REPLY NOT 0, AN ERROR COPY Q,X GET SCB ADDRESS IN X COPY SCB:FLW(X),A GET SCB FLAGWORD CLSN A,=DISKU: SKIP IF AN UNBUFFERED DISK JMP RPOSDISK HERE A DISK DEVICE CLSN A,=DISKB: SKIP IF A BUFFERED DISK JMP RPOSDISK HERE A DISK DEVICE COPY =0,A COPY A,*RETFBA(Y) IMS RETFBA(Y) COPY A,*RETFBA(Y) RETURN POSITION OF ZERO COPY =-14,A -14 => POSITION NOT LEGAL FOR THIS DEVICE ERRRP0 COPY A,*REPLY(Y) RETURN REPLY RET:EII RPOSDISK COPY SCB:CFI(X),X CFI ADDRESS IN X COPY 0(X),A CFI WORD 1 COPY A,*RETFBA(Y) AND RETURN IMS RETFBA(Y) COPY 1(X),A CFI WORD 2 COPY A,*RETFBA(Y) AND RETURN COPY =0,A 0 => SUCCESS JMP ERRRP0 SUCCESSFUL RETURN END (Y) AND RETURN IT COPY =0,A 0 => SUCCESS JMP ERRPS0 SUCCESSFUL RETURN END ETITL4 C:RDPOS0 * * EQUATES FOR C:RDPOS0 * SIDX EQU 0 RETFBAX EQU 1 REPLYX EQU 2 SID EQ1PAGE 0001 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII.MAC - 93530-10 E810 1982/02/02 14:26:27.75 MACROS AND DEFINITIONS SI = DH01.NEWEII.MAC LO = DH01.NEWEII.LST 0003 REVNOTE MACRO 0004 OBJNOTE '***   EII.LIB - REV E810 ***' 0005 ENDM 0006 * 0007 * E Q U A T E S  0008 * 0009 * EQUATES FOR EII MACROS 00000000 0010 OLDK EQU 0 00000001 0011 OLDY EQU 1 0012 * STREAM CONTROL BLOCK (SCB) EQUATES 00000000 0013 SCB:CHN EQU 0 SCB CHAIN WORD 00000001 0014 SCB:FLW EQU SCB:CHN+1 FLAGWORD 00000002 0015 SCB:USR EQU SCB:FLW+1 USER ID 00000003 0016 SCB:LUN EQU SCB:USR+1 CURRENT LUN 00000004 0017 SCB:CHB EQU SCB:LUN+1 CHARACTER BUFFER 00000005 0018 SCB:CFI EQU SCB:CHB+1 CFI ADDRESS 00000006  0019 SCB:CG1 EQU SCB:CFI+1 CGI WORD 1 00000008 0020 SCB:CBP EQU SCB:CG1+2 CHAR BUFFER PTR 00000009 0021 SCB:CC EQU SCB:CBP+1 CHARACTER COUNT 0000000A 0022 SCB:IOM EQU SCB:CC+1 I/O MODE  0000000B 0023 SCB:ELT EQU SCB:IOM+1 END LINE TERMINATOR 0000000C 0024 SCB:DTP EQU SCB:ELT+1  I/O DATA TYPE 0000000D 0025 SCB:UID EQU SCB:DTP+1 UID BLOCK ADDRESS (COPY) 0000000E 0026 SCB:LEN EQU SCB:UID+1 LENGTH OF SCB (IN WORDS) 0027 * SCB FLAGWORD EQUATES - DO NOT CHANGE THE NUMBERS!  00000000 0028 UNUSED: EQU 0 UNUSED SCB ENTRY 00000001 0029 CHDEV: EQU 1 CHARACTER DEVICE (=> BUFFERED) 00000002 0030 DISKU: EQU 2 DISK, UNBUFFERED 00000003 0031 DISKB:  EQU 3 DISK, BUFFERED 0032 * SCB I/O MODE EQUATES 00000004 0033 CREAD: EQU 4 00000005 0034 CWRITE: EQU 5 0035 * SCB DATA TYPE EQUATES 00000000 0036 UFM: EQU 0 UNFORMATTED 00000001 0037 I2A: EQU 1 ISO TO ASCII 00000002 0038 I2I:  EQU 2 ISO TO ISO 00000003 0039 A2A: EQU 3 ASCII TO ASCII 00000004 0040 A2I: EQU 4 ASCII TO ISO 0041 * FREE SPACE BLOCK EQUATES 00000000 0042 FSB:CHN EQU 0 FREESPACE BLOCK CHAIN 00000001 0043 FSB:LEN EQU FSB:CHN+1 FREESPACE BLOCK LENGTH  00000002 0044 FSB:USR EQU FSB:LEN+1 USER ID 00000003 0045 FSB:BLK EQU FSB:USR+1 THE USER'S INFO STARTS HERE 0046 * DIB CHAIN EQUATES 00000000 0047 DBC:CHN EQU 0 DIB CHAIN WORD 00000001 0048 DBC:DIB EQU DBC:CHN+1 DIB ADDRESS 00000002 0049 DBC:NAM1 EQU DBC:DIB+1 DIB NAME WORD 1 00000003 0050 DBC:NAM2 EQU DBC:NAM1+1 DIB NAME WORD 2 0051 * EQUATES FOR UID BLOCKS 00000000 0052 BCPARTA EQU 0 BYTE COUNT / PARTA BYTE # 00000001 0053 PARTBC EQU BCPARTA+1 PART A / PART C BYTE #S 00000002 0054 UIDDATA EQU PARTBC+1 UID DATA BYTES START HERE 00000004 0055 UIDBYTS EQU UIDDATA*2 BYTE POSITION OF DATA IN UID 1PAGE 0002 MACRO (F300) EXTENDED I/O INTERFACE - NEWE II.MAC - 93530-10 E810 1982/02/02 14:26:29.00 MACROS AND DEFINITIONS 0057 * RTX EQUATE 00000021 0058 R:ACT EQU :21 0059 * GENERAL EQUATES 0000008B 0060 CHBUFLEN EQU 139 CHARACTER DEVICE BUFFER LENGTH 0061 * 0062 * ENTRY MACRO 0063 *  0064 ENT:EII XMACRO 0065 MACLAB 0066 EXTR C:ENTER  0067 #(-1) JSK C:ENTER 0068 WORD #(1)+2 0069 ENDM  0070 * 0071 * RETURN MACRO 0072 * 0073 RET:EII XMACRO  0074 MACLAB 0075 EXTR C:RETURN 0076 #(-1) JMP C:RETURN 0077 ENDM 0078 * 0079 LOCK XMACRO 0080  MACLAB 0081 EXTR C:LOCK 0082 #(-1) JSK C:LOCK MUTUALLY EXCLUDE 0083 ENDM 0084 * 0085 UNLOCK XMACRO 0086 MACLAB 0087 EXTR C:UNLOCK 0088 #(-1) JSK C:UNLOCK DE-MUTUALLY EXCLUDE 0089 ENDM 1PAGE 0003 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII.MAC - 93530-10 E810 1982/02/02 14:26:29.75 MACROS AND DEFINITIONS 0091 * 0092 * TITLE MACROS  0093 * 0094 ETITL1 XMACRO 1 0095 ETITL2 MACENT 2 0096 ETITL3 MACENT 3 0097 ETITL4 MACENT 4 0098 ETITL5 MACENT 5 0099 ETITL6 MACENT 6 0100 ETITL7 MACENT 7 0101 ETITL8 MACENT 8 0102  TITL EXTENDED I/O INTERFACE - NEWEII#(0).ASM - 93530-1#(0) E810 0103 TITL --  #(1) -- 0104 EII: REL 0105 SHARABLE EII: 0106  ROMMABLE EII: 0107 ENDM 0108 ETITL XMACRO 0109 TITL  -- #(1) -- 0110 ENDM 0111 SAVE 0112 ************************************************************************ 0113 *  * 0114 * NOTE: THE PROGRAM BELOW WAS WRITTEN BY AN ENGLISHMAN  * 0115 * THE SPELLINGS HAVE BEEN CHANGED TO PROTECT THE IGNORANT. * 0116 *  * 0117 *  RGB 2-NOV-1980 * 0118 *  * 0119 ************************************************************************ 0120   END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0001 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:39.00 -- C:RENAM0 -- SI = DH01.NEWEII1.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0001 EII: REL 0001+ SHARABLE EII: 0001+ ROMMABLE EII: 0002 * 0003 * EQUATES FOR C:RENAM0 0004 * 00000000 0005 UID1X  EQU 0 OLD UID ADDRESS 00000001 0006 UID2X EQU UID1X+1 NEW UID ADDRESS 00000002  0007 REPLYX EQU UID2X+1 ADDRESS TO STORE REPLY 0008 * 00000002 0009 REPLY EQU 2 ADDRESS TO STORE REPLY 00000003 0010 UID1 EQU REPLY+1 UID1 ADDRESS (OLD UID) 00000004 0011 SID1 EQU UID1+1 SID1 ADDRESS 00000005 0012 ACTRPY1 EQU SID1+1 ACTUAL REPLY #1  00000006 0013 SCB1 EQU ACTRPY1+1 SCB #1 ADDRESS 00000007 0014 UID2 EQU SCB1+1 UID2 ADDRESS (NEW UID) 00000008 0015 SID2 EQU UID2+1 SID2 ADDRESS 00000009 0016 ACTRPY2 EQU SID2+1 ACTUAL REPLY #2 0000000A 0017 SCB2 EQU ACTRPY2+1 SCB #2 ADDRESS 0000000B 0018 ACTSID1 EQU SCB2+1 ACTUAL SID #1 0000000D 0019 ACTSID2 EQU ACTSID1+2 ACTUAL SID #2 0000000F 0020 REPVECT1 EQU ACTSID2+2 REPLY VECTOR #1 00000010 0021 CONNBK1 EQU REPVECT1+1 CONNECT BLOCK #1 LIES HERE 00000010 0022 NAME1 EQU CONNBK1+NAMPT: ADDRESS OF NAME1 00000017 0023 ACTNAME1 EQU CONNBK1+RLN:+1 ACTUAL LOCATION OF NAME1 0000001E 0024 REPVECT2 EQU ACTNAME1+7 REPLY VECTOR #2 0000001F 0025 CONNBK2 EQU REPVECT2+1 CONNECT BLOCK #2 LIES HERE 0000001F 0026 NAME2 EQU CONNBK2+NAMPT: ADDRESS OF NAME2 00000026 0027 ACTNAME2 EQU CONNBK2+RLN:+1 ACTUAL LOCATION OF NAME2 0000002D 0028 SAVSCB EQU ACTNAME2+7 SCB SAVED HERE ... 0000002D 0029 VTC EQU SAVSCB ... LATER HOLDS VTOC SEMAPHORE 0000002E 0030 RCFI EQU VTC+1 REMEMBERED CF1 00000030 0031 LUN EQU RCFI+2 LUN FOR I:IO  00000038 0032 CUNAME EQU LUN+IO:ST+1 CURRENT NAME LIES HERE 0000003F 0033 ENDSTK EQU CUNAME+7  CURRENT NAME (DIRECTORY) 00000030 0034 FUOPER EQU FU:%4+OP: FUNCTION, OPEN 00000000 0035 RENT  EQU RE:%4+UF: 0000001C 0036 WRENT EQU WR:%4+DS: 1PAGE 0002 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:40.00 -- C:RENAM0 -- 0038 ************************************************************************ 0039 * * 0040 * E I I S E R V I C E --- C : R E N A M 0 --- * 0041 *  * 0042 **************************************** ******************************** 0000 0043 NAM C:RENAM0 0044 EXTR C:PTOPEN,C:RD0,C:WR0,C:LKDIB,C:ULDIB,C:CLOSE0 0045 EXTR C:ENTER 0000 FFC0 0041 0045+ C:RENAM0 JSK  C:ENTER 0001 0041 0045+ WORD ENDSTK+2 0002 8080 0000 0046 COPY UID1X(X),A FETCH AND SAVE ... 0003 8443 0003 0047 COPY A,UID1(Y) 0004 8081 0001 0048 COPY UID2X(X),A 0005 8447 0007 0049 COPY A,UID2(Y) 0006 8082 0002 0050 COPY REPLYX(X),A 0007 8442 0002 0051 COPY A,REPLY(Y) ... ALL PARAMETERS 0052 * 0053 * NOW DO INITIALISATION 0054  * 0008 2060 0055 COPY Y,X 0009 2B0B 0056 ADD =ACTSID1,X ADDRESS OF ACTUAL SID 1 000A A444 0004 0057 COPY X,SID1(Y) SET UP SID1 000B 0900 0058 COPY =0,A 000C 8544 0004  0059 COPY A,*SID1(Y) AND ZERO IT 000D 2B02 0060 ADD =ACTSID2-ACTSID1,X ADDRESS OF ACTUAL SID 2 000E A448 0008 0061 COPY X,SID2(Y) SET UP SID2 000F 8548 0008 0062 COPY A,*SID2(Y)  AND ZERO IT 0010 2B02 0063 ADD =REPVECT1-ACTSID2,X ADDRESS OF REPLY VECTOR #1 0011 A445 0005 0064  COPY X,ACTRPY1(Y) SET UP REPLY ADDRESS #1 0012 2B0F 0065 ADD =REPVECT2-REPVECT1,X ADDRESS OF REPLY VECTOR #2 0013 A449 0009 0066 COPY X,ACTRPY2(Y) SET UP REPLY ADDRESS #2 0067 *  0068 * NOW OPEN THE DIRECTORY OF UID #1 0069 * 0014 2AE5 0070 ADD =UID1-REPVECT2,X ADDRESS OF PARAM LIST 0015 FFAC 0042 0071 JSK C:PTOPEN PERFORM PARTIAL OPEN 0016 11E5 003C 0072  JNE A,ERRXT1 ERROR EXIT IF BAD REPLY 0017 C446 0006 0073 COPY Q,SCB1(Y) STORE SCB 1 ADDRESS 0018 2060 0074 COPY Y,X 0019 2B10 0075 ADD =CONNBK1,X ADDRESS OF CONNECT BLOCK #1 001A FFA8 0043 0076 JSK OPNFIL OPEN FILE AND UNLOCK 001B 11E0 003C 0077 JNE A,ERRXT1  ERROR EXIT IF BAD REPLY 0078 * 0079 * DROP THROUGH TO ... 0080 * 1PAGE  0003 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:41.00 -- C:RENAM0 --  0082 * 0083 * PARTIALLY OPEN THE DIRECTORY OF UID #2 0084 * 001C 2060 0085  COPY Y,X 001D 2B07 0086 ADD =UID2,X ADDRESS OF PARAM LIST #2 001E FFA3 0042 0087  JSK C:PTOPEN PERFORM PARTIAL OPEN 001F 11D6 0036 0088 JNE A,ERRXT2 ERROR EXIT IF BAD REPLY 0020 C44A 000A 0089 COPY Q,SCB2(Y) STORE SCB 2 ADDRESS 0090 * 0091 * NOW CHECK FOR IDENTICAL DEVICES 0092 * 0021 8052 0012 0093 COPY CONNBK1+PUN:(Y),A PUN OF CONNECTED DIRECTORY #1 0022 8C61 0021 0094 SUB CONNBK2+PUN:(Y),A SUBTRACT THAT OF DIRECTORY #2 0023 1143 0027 0095   JEQ A,SAMDEV HERE THE SAME DEVICE IF A=0 0096 EXTR C:UNLOCK 0024 FF99 003E 0096+ JSK C:UNLOCK DE-MUTUALLY EXCLUDE 0025 08E8 0097 COPY =-24,A -24 => PUNS DIFFERENT ON A RENAME 0026 9E8F 0036 0098 JMP ERRXT2 CLOSE DIRECTORY #1 AND EXIT 0099 *  0100 * NOW CHECK FOR TWO IDENTICAL DIRECTORIES 0101 * 0027 8053 0013 0102 SAMDEV COPY  CONNBK1+FNO:(Y),A F-NUMBER OF CONNECTED DIRECTORY #1 0028 8C62 0022 0103 SUB CONNBK2+FNO:(Y),A SUBTRACT THAT OF DIRECTORY #2 0029 115C 0046 0104 JEQ A,SAMDIR HERE THE SAME DIRECTORY IF A=0 0105 *  0106 * HERE WE HAVE A RENAME ACROSS DIRECTORIES, SO ... 0107 * ... OPEN THE DIRECTORY OF UID #2 0108 * 002A FF98 0043 0109 JSK OPNFIL OPEN FILE AND UNLOCK 002B 2060 0110  COPY Y,X 002C 2B1F 0111 ADD =CONNBK2,X ADDRESS OF CONNECT BLOCK IN X FOR OPNFIL CALL 002D 11C8 0036 0112 JNE A,ERRXT2 ERROR EXIT IF BAD REPLY 002E 9E9A 0049 0113 JMP NSDIR  HERE WE HAVE TWO DIRECTORIES OPEN 1PAGE 0004 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:41.75 -- C:RENAM0 -- 0115 * 0116 * HERE WE DEAL WITH ERRORS 0117 * 0118 * HERE WE HAVE AN ERROR, WITH TWO FILES (SID1 AND SID2) OPEN. 0119 * 002F 8542 0002 0120 ERRXT3 COPY A,*REPLY(Y) STORE REPLY FOR USER 0030 A06D 002D 0121 COPY VTC(Y),X VTOC SEMAPHORE ADDRESS 0031 FF8D 003F 0122 JSK C:ULDIB UNLOCK THE DIB 0032 2060 0123 COPY Y,X  NOW WE CLOSE DIRECTORY #2 0033 2B08 0124 ADD =SID2,X PARAMETER LIST IN X FOR CLOSE 0034 FF8B 0040 0125 JSK C:CLOSE0 CLOSE THE FILE 0035 9E81 0037 0126 JMP ERRXT2A AND NOW AS FOR ERROR EXIT #2 0127 * 0128 * HERE WE HAVE AN ERROR, WITH ONE FILE (SID1) OPEN.  0129 * 0036 8542 0002 0130 ERRXT2 COPY A,*REPLY(Y) STORE BAD REPLY 0037 2060 0131 ERRXT2A COPY Y,X NOW WE MUST CLOSE DIRECTORY #1 0038 2B04 0132 ADD =SID1,X PARAMETER LIST IN X FOR CLOSE 0039 FF86 0040 0133 JSK C:CLOSE0 CLOSE THE FILE 003A 8142 0002 0134 COPY *REPLY(Y),A GET REPLY BACK IN A FOR EXIT 0135 EXTR C:RETURN 003B 9F88 0044 0135+ JMP C:RETURN  0136 * 0137 * HERE WE HAVE AN ERROR, BUT NO FILES OPEN. 0138 * 003C 8542 0002 0139 ERRXT1 COPY A,*REPLY(Y) STORE REPLY FOR USER 0140 EXTR C:RETURN 003D 9F86 0044 0140+ JMP C:RETURN 0008 0141 LPOOL 003E 0003 C:UNLOCK 003F 0006 C:ULDIB 0040 0005 C:CLOSE0 0041 0004 C:ENTER 0042 0008 C:PTOPEN 0043 00E6 OPNFIL 0044 0002 C:RETURN 0045 1PAGE 0005 MACRO (F300) EXTENDED I/O  INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:42.50 -- C:RENAM0 -- 0143 * 0144 * HERE WE EITHER HAVE A RENAME OF A FILE TO A DEFFERENT NAME IN THE 0145 * SAME DIRECTORY (CASE 1), OR A RENAME OF A FILE ACROSS DIRECTORIES 0146 * (CASE 2). IN BOTH CASES THE FILE MAY BE A DIRECTORY.  0147 * WITH CASE 1 WE HAVE A SINGLE DIRECTORY OPEN ON SID1. WITH CASE 2 0148 * WE HAVE A SECOND DIRECTORY OPEN ON SID2. 0149 * 0150 * WE WILL SET SID2 TO ZERO TO INDICATE CASE 1.  0151 * 0152 * CASE 1 CODE (ONLY) 0153 * 0154 EXTR C:UNLOCK 0046 FF77 003E 0154+ SAMDIR JSK C:UNLOCK DE-MUTUALLY EXCLUDE 0047 0900 0155 COPY =0,A  UNLOCK (COS WE DIDN'T OPEN SID2) ... 0048 8448 0008 0156 COPY A,SID2(Y) ... AND ZERO SID2 TO INDICATE CASE 1 0157 * 0158 * CASE 1 AND CASE 2 COMMON CODE - SEARCH DIRECTORY #1 0159 * 0049 A052 0012 0160 NSDIR COPY CONNBK1+PUN:(Y),X PUN OF CONNECTED DEVICE 004A 2B15 0161 ADD  =DI:VTS-2,X SEMAPHORE ADDRESS 004B A46D 002D 0162 COPY X,VTC(Y) SAVE VTOC SEMAPHORE ADDRESS 004C FFD9 00A6 0163 JSK C:LKDIB LOCK DIB 0164 * 0165 * SET UP IOB FOR READING DIRECTORY #1 0166 * 004D 8144 0004 0167 COPY *SID1(Y),A SID1 004E 8470 0030 0168 COPY A,LUN(Y) SET UP LUN 004F A046 0006 0169 COPY SCB1(Y),X SCB OF DIRECTORY #1 0050 A085 0005 0170 COPY SCB:CFI(X),X CFI ADDRESS IN X 0051 A472 0032 0171 COPY X,IO:CRI+LUN(Y) STORE IN IOB 0052 0900 0172 COPY =0,A 0053 846E 002E 0173 COPY A,RCFI(Y) ZERO REMEMBERED CFI ... 0054 846F 002F 0174 COPY A,RCFI+1(Y) ... TO INDICATE NOTHING REMEMBERED 0055 8480 0000 0175 COPY A,0(X) ZERO FIRST WORD OF CURRENT CFI 0056 0910 0176 COPY =16,A 16 BYTES PER ENTRY 0057 8481 0001 0177 COPY A,1(X) CFI STARTS AT SECOND ENTRY 0058 8474 0034 0178 COPY A,IO:BCT+LUN(Y) AND 16 IS REQUESTED COUNT 0059 0900 0179 COPY =RENT,A READ ENTRY FUNCTION 005A 8473 0033 0180  COPY A,IO:FC+LUN(Y) SET UP FUNCTION IN IOB 005B 0060 0181 COPY Y,A 005C 0B38 0182 ADD =CUNAME,A ADDRESS OF CURRENT NAME 005D 8475 0035 0183 COPY A,IO:BUF+LUN(Y) SET UP AS BUFFER ADDRESS  0184 * 0185 * DROP THROUGH TO ... 0186 * 1PAGE 0006 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:43.50 -- C:RENAM0 -- 0188 *  0189 * NOW IOB IS SET UP FOR READING ENTRIES, ENTER READ LOOP 0190 * 005E 1A07 0191 RENTLP I:IO LUN(Y) READ AN ENTRY 005F 1030 0030 0191+ 0060 9EA0 0081 0192 JMP ENDDIR1 ERROR READING AN  ENTRY OR EOF 0061 8076 0036 0193 COPY IO:ACT+LUN(Y),A ACTUAL COUNT TRANSFERRED 0062 0C10 0194 CLSN A,=16 WAS IT 16 BYTES ? 0063 9E81 0065 0195 JMP $+2 YES: SUCCESS 0064 9EBE 00A3 0196 JMP FNFERR NO: TREAT AS FILE-NOT-FOUND ERROR 0065 C078 0038 0197 COPY CUNAME(Y),Q GET F-NUMBER OF ENTRY 0066 51C3 006A 0198 JNE Q,ETHERE HERE AN ENTRY IS THERE - CHECK IT! 0067 8079 0039 0199 COPY CUNAME+1(Y),A GET NEXT WORD 0068 1158 0081 0200 JEQ A,ENDDIR1 IF 0 ITS LOGICAL END OF DIRECTORY 0069 9E74 005E 0201 JMP RENTLP ELSE LOOP 0202 * 0203 * NOW CHECK THE CURRENT ENTRY AGAINST NAME1 0204 * 006A 2906 0205 ETHERE COPY =6,X COUNT FOR CHECKING ENTRIES 006B 80D7 0017 0206 CNAME COPY ACTNAME1(X,Y),A NTH WORD OF NAME 006C 8CF9 0039 0207 SUB CUNAME+1(X,Y),A SUBTRACT NTH WORD OF READ NAME 006D 11CA 0078 0208 JNE A,CFLN2 HERE NOT FOUND - CHECK FILENAME #2? 006E 35BC 006B 0209 JNED X,CNAME LOOP, CHECKING ALL WORDS 0210 *  0211 * HERE WE HAVE FOUND THE ENTRY WE REQUIRE (F-NO IS STILL IN Q) 0212 * 006F C465 0025 0213  COPY Q,ACTNAME2-1(Y) SAVE FNO IN ACTUAL NAME2-1 0070 8048 0008 0214 COPY SID2(Y),A GET SID2 0071 11F5 00A7 0215 JNE A,CASE2 JUMP IF CROSS-DIRECTORY RENAME 0072 A072 0032 0216 COPY IO:CRI+LUN(Y),X CFI ADDRESS IN X 0073 8080 0000 0217 COPY 0(X),A REMEMBER CFI FOR LATER USE 0074 846E 002E 0218 COPY A,RCFI(Y) 0075 8081 0001 0219 COPY 1(X),A 0076 846F 002F 0220 COPY A,RCFI+1(Y) 0077 9E66 005E 0221 JMP RENTLP AND LOOP 0222 * 0223 * HERE WE MUST CHECK FOR NAME #2 0224 * 0078 8048 0008 0225 CFLN2 COPY SID2(Y),A GET SID2 0079 11A4 005E 0226 JNE A,RENTLP IF NONZERO, DON'T LOOK FOR DUPLICATES HERE 007A 2906 0227 COPY =6,X COUNT FOR CHECKING ENTRIES 007B 80E6 0026 0228 CNAME2 COPY ACTNAME2(X,Y),A NTH WORD OF NAME2 007C 8CF9 0039 0229 SUB CUNAME+1(X,Y),A SUBTRACT NTH WORD OF READ NAME 007D 11A0 005E 0230 JNE A,RENTLP HERE NOT FOUND - LOOP 007E 35BC 007B 0231 JNED X,CNAME2 LOOP, CHECKING ALL WORDS 0232 *  0233 * HERE THE NAME WOULD BE A DUPLICATE 0234 * 007F 08F5 0235 ISDUP COPY =-11,A -11 => FILE ALREADY EXISTS 0080 9E2E 002F 0236 JMP ERRXT3 HERE ERROR, CLOSE BOTH FILES AND EXIT 1PAGE 0007 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:45.00 -- C:RENAM0 --  0238 * 0239 * HERE WE HAVE END OF DIRECTORY #1 OR AN ERROR 0240 * 0081 8077 0037 0241 ENDDIR1 COPY IO:ST+LUN(Y),A GET I/O STATUS 0082 1341 0084 0242 JGE A,$+2 SKIP IF NOT  AN ERROR 0083 9E2B 002F 0243 JMP ERRXT3 IF -VE ITS AN ERROR 0084 806F 002F 0244 COPY RCFI+1(Y),A GET CFI WORD 2 0085 11C2 0088 0245 JNE A,FNDFIL1 JUMP IF FOUND FILE 0086 806E 002E 0246  COPY RCFI(Y),A GET CFI WORD 1 0087 115B 00A3 0247 JEQ A,FNFERR IF BOTH 0, FILE NOT FOUND  0248 * 0249 * NOW WE MOD THE IOB TO WRITE THE ENTRY 0250 * 0088 0060 0251 FNDFIL1 COPY Y,A 0089 0B25 0252 ADD =ACTNAME2-1,A ADDRESS OF F-NO+NEW NAME 008A 8475 0035 0253 COPY A,IO:BUF+LUN(Y) SET UP AS BUFFER ADDRESS 008B 091C 0254 COPY =WRENT,A WRITE ENTRY FUNCTION CODE 008C 8473 0033 0255 COPY A,IO:FC+LUN(Y) SET UP FUNCTION CODE 008D 2060 0256 COPY  Y,X 008E 2B2E 0257 ADD =RCFI,X X POINTS TO SAVED CFI 008F A472 0032 0258 COPY X,IO:CRI+LUN(Y) STORE IN IOB 0090 FEFA 010B 0259 JSK SUB16CFI SUBTRACT 16 FROM CFI (ADDRESS IN X) 0091 1A07 0260 I:IO LUN(Y) WRITE THE ENTRY 0092 1030 0030 0260+ 0093 9E8D 00A1 0261 JMP ERRWENT HERE ERROR WRITING ENTRY 0262 * 0263 * HERE EVERYTING IS ALL OK, WE MUST CLOSE FILES AND EXIT 0264 * 0094 A06D 002D 0265 NORMEX COPY VTC(Y),X VTOC SEM ADDRESS 0095 FF29 003F 0266 JSK C:ULDIB UNLOCK THE DIB 0096 8048 0008 0267 COPY SID2(Y),A GET SID2 0097 1145 009D 0268 JEQ A,NCSID2 NO CLOSE OF SID2 IF NEVER OPENED 0098 2060 0269 COPY Y,X 0099 2B08 0270 ADD =SID2,X X SET UP FOR CLOSE CALL 009A FF25 0040 0271 JSK C:CLOSE0 CLOSE FILE, REPLY IN A 009B 1141 009D 0272 JEQ A,$+2 SKIP IF NO ERROR DETECTED 009C 9E19 0036 0273  JMP ERRXT2 ERROR SO RETURN THIS AS REPLY 009D 2060 0274 NCSID2 COPY Y,X 009E 2B04 0275  ADD =SID1,X X SET UP FOR CLOSE CALL 009F FF20 0040 0276 JSK C:CLOSE0 CLOSE FILE, REPLY IN A 00A0 9E1B 003C 0277 JMP ERRXT1 RETURN THIS AS THE REPLY 0278 *  0279 * ERRORS READING OR WRITING 0280 * 000000A1 0281 ERRWENT EQU $ 00A1 8077 0037 0282 ERRRENT COPY IO:ST+LUN(Y),A GET ERROR REPLY 00A2 13C1 00A4 0283 JLT A,$+2 IF -VE REAL ERROR 00A3 08EA 0284 FNFERR COPY =-22,A -22 => FILE-NOT-FOUND ERROR 00A4 9E0A 002F 0285 JMP ERRXT3  HERE ERROR - CLOSE BOTH FILES AND EXIT 0002 0286 LPOOL 00A5 010B SUB16CFI 00A6 0007 C:LKDIB 1PAGE 0008 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:46.50 -- C:RENAM0 --  0288 * 0289 * CASE 2 (ONLY) CODE 0290 * 0291 * HERE WE HAVE SEARCHED THE FIRST DIRECTORY AND HAVE FOUND THE FILE. 0292 * THE NEW ENTRY TO WRITE IS CONTAINED AT ACTNAME2-1 ONWARDS . WE MUST 0293 * NOW SEARCH THE SECOND DIRECTORY FOR A BLANK ENTRY OVER WHICH WE CAN 0294 * WRITE. 0295 * 0296 * SET UP IOB FOR READING DIRECTORY #2 0297 * 00A7 8148 0008 0298 CASE2 COPY *SID2(Y),A SID2 00A8 8470 0030 0299 COPY A,LUN(Y) IS NEW LUN 00A9 A04A 000A 0300 COPY SCB2(Y),X SCB IN X 00AA A085 0005 0301 COPY SCB:CFI(X),X CFI ADDRESS IN X 00AB 0900 0302 COPY =0,A 00AC 8480 0000 0303 COPY A,0(X) ZERO WORD 1 00AD 0910  0304 COPY =16,A 00AE 8481 0001 0305 COPY A,1(X) WORD 2 =16 (SKIP THE FIRST ENTRY) 00AF A472 0032 0306 COPY X,IO:CRI+LUN(Y) PUT CFI IN IOB 0307 * 0308 * EVERYTHING ELSE IS ALREADY SET UP FROM READING DIRECTORY #1, 0309 * SO ENTER LOOP TO FIND BLANK ENTRY AND SEARCH FOR DUPLICATES. 0310 * 00B0 1A07 0311 RENTLP2 I:IO LUN(Y) READ AN ENTRY 00B1 1030 0030 0311+ 00B2 9E94 00C7 0312 JMP ENDDIR2 ERROR READING AN ENTRY OR EOF 00B3 8076 0036 0313 COPY IO:ACT+LUN(Y),A ACTUAL COUNT TRANSFERRED 00B4 0C10 0314 CLSN A,=16 WAS IT 16 BYTES ? 00B5 9E81 00B7 0315 JMP $+2 YES: SUCCESS 00B6 9E6C 00A3 0316 JMP FNFERR NO: TREAT AS FILE-NOT-FOUND ERROR 00B7 C078 0038 0317 COPY CUNAME(Y),Q GET CURRENT F-NUMBER 00B8 51C8 00C1 0318 JNE Q,MBDUP IF NOT 0 MAY BE DUPLICATE 0319 * 0320 * HERE WE HAVE FOUND A BLANK ENTRY, WE'LL JUST REMEMBER THE CFI 0321 * 00B9 A072 0032 0322 COPY IO:CRI+LUN(Y),X CFI ADDRESS IN X 00BA 8080 0000 0323 COPY 0(X),A REMEMBER CFI FOR LATER USE 00BB 846E 002E 0324 COPY A,RCFI(Y) 00BC 8081 0001 0325 COPY 1(X),A 00BD 846F 002F 0326 COPY A,RCFI+1(Y) 00BE 8079 0039 0327  COPY CUNAME+1(Y),A GET NAME+1 00BF 114E 00CE 0328 JEQ A,FNDBLNK IF ZERO ITS A BLANK ENTRY (AND EOF) 00C0 9E6F 00B0 0329 JMP RENTLP2 AND LOOP 0330 * 0331 * HERE WE MUST CHECK FOR A DUPLICATE DEFINITION OF NAME2 0332 * 00C1 2906 0333 MBDUP COPY =6,X COUNT FOR CHECKING ENTRIES 00C2 80E6 0026 0334 CNAME3 COPY ACTNAME2(X,Y),A NTH WORD OF NAME2 00C3 8CF9 0039 0335  SUB CUNAME+1(X,Y),A SUBTRACT NTH WORD OF READ NAME 00C4 11AB 00B0 0336 JNE A,RENTLP2 HERE NOT FOUND - LOOP 00C5 35BC 00C2 0337 JNED X,CNAME3 LOOP, CHECKING ALL WORDS 00C6 9E38 007F 0338 JMP ISDUP HERE WE HAVE A DUPLICATE NAME 1PAGE 0009 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:47.75 -- C:RENAM0 -- 0340 * 0341 * NOW WE HAVE A BLANK ENTRY, LET'S WRITE THE NEW ENTRY 0342 * 00C7 8077 0037 0343 ENDDIR2 COPY IO:ST+LUN(Y),A GET I/O STATUS 00C8 1341 00CA 03 44 JGE A,$+2 SKIP IF NO ERROR 00C9 9FCC 0116 0345 JMP ERRXT3 IF -VE ITS AN ERROR  00CA 806F 002F 0346 COPY RCFI+1(Y),A GET CFI WORD 2 00CB 11C2 00CE 0347 JNE A,FNDBLNK JUMP IF FOUND BLANK ENTRY 00CC 806E 002E 0348 COPY RCFI(Y),A GET CFI WORD 1 00CD 1115 00A3 0349 JEQ A,FNFERR IF BOTH 0, FILE NOT FOUND 00CE 2060 0350 FNDBLNK COPY Y,X 00CF 2B2E 0351 ADD  =RCFI,X X POINTS TO REMEMBERED CFI 00D0 A472 0032 0352 COPY X,IO:CRI+LUN(Y) STORE CFI IN IOB 00D1 FEB9 010B 0353 JSK SUB16CFI PUT CFI BACK TO OVERWRITE THE ENTRY 00D2 0060 0354 COPY Y,A 00D3 0B25 0355 ADD =ACTNAME2-1,A A POINTS TO BUFFER TO WRITE 00D4 8475 0035 0356 COPY A,IO:BUF+LUN(Y) SET UP BUFFER ADDRESS 00D5 091C 0357 COPY =WRENT,A WRITE ENTRY FUNCTION CODE 00D6 8473 0033 0358 COPY A,IO:FC+LUN(Y) FUNCTION CODE SET UP 00D7 1A07 0359 I:IO LUN(Y) WRITE THE ENTRY 00D8 1030 0030 0359+ 00D9 9E47 00A1 0360 JMP ERRWENT HERE ERROR WRITING THE ENTRY  0361 * 0362 * NOW WE MUST ERASE THE OLD FILE - FIRST MOD THE IOB. 0363 * 00DA 8144 0004 0364 COPY *SID1(Y),A 00DB 8470 0030 0365 COPY A,LUN(Y) CHANGE LUN 00DC A046 0006 0366  COPY SCB1(Y),X SCB #1 00DD A085 0005 0367 COPY SCB:CFI(X),X CFI OF FILE #1 00DE A472 0032 0368 COPY X,IO:CRI+LUN(Y) PUT IN LUN 00DF FEAB 010B 0369 JSK SUB16CFI MOD THE CFI FOR WRITING THE ENTRY 00E0 0900 0370 COPY =0,A 0 => ENTRY DELETED 00E1 8465 0025 0371 COPY A,ACTNAME2-1(Y) F-NO IS NOW 0 => DELETED 00E2 1A07 0372 I:IO LUN(Y) WRITE THE ENTRY 00E3 1030 0030 0372+ 00E4 9E3C 00A1 0373 JMP ERRWENT HERE ERROR WRITING THE ENTRY 00E5 9E2E 0094 0374 JMP NORMEX NOW DO THE NORMAL EXIT CODE 1PAGE 0010 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:49.25 -- OPNFIL -- 0376 * 0377 * OPNFIL -- AN INTERNAL ROUTINE TO OPEN A FILE, (SCB ADDRESS IN Q). 0378 * THE FILE IS CONNECTED TO THE LUN SPECIFIED IN THE SCB, UNLESS  0379 * THE F-NUMBER IS ZERO, IN WHICH CASE WE MUST CONNECT TO THE ROOT 0380 * DIRECTORY. RETURNS ERROR STATUS IN A (0 => ALL OK). 0381 * 00E6 C46D 002D 0382 OPNFIL COPY Q,SAVSCB(Y) SAVE SCB ADDRESS 00E7 8083 0003 0383 COPY FNO:(X),A F-NUMBER OF FILE 00E8 11CC 00F5 0384 JNE A,NOTROOT HERE NOT THE ROOT DIRECTORY 00E9 0901 0385 COPY =1,A 00EA 8480 0000 0386 COPY A,NAMPT:(X) NAME POINTER SET UP 00EB 2048 0387 EXCH Q,X SCB ADDRESS IN X NOW 00EC 8083 0003 0388  COPY SCB:LUN(X),A GET LUN 00ED 2040 0389 COPY Q,X CONNECT BLOCK ADDRESS IN X 00EE 84 84 0004 0390 COPY A,LUN:(X) STORE LUN IN CONNECT BLOCK 00EF 1A1A 0391 F:CFNO 0(X)  CONNECT TO ROOT DIRECTORY 00F0 2000 0000 0391+ 00F1 0C02 0392 CLSN A,=2 IS REPLY OK? 00F2 9E82 00F5 0393 JMP NOTROOT YES: SKIP THE ERROR 00F3 08FD 0394 COPY =-3,A NO: -3 => CONNECT FAILED 00F4 9E92 0107 0395 JMP EXT EXIT WITH ERROR 00F5 A06D 002D 0396 NOTROOT COPY  SAVSCB(Y),X SCB ADDRESS IN X 00F6 8085 0005 0397 COPY SCB:CFI(X),A CFI ADDRESS 00F7 8472 0032 0398  COPY A,IO:CRI+LUN(Y) STORE IN IOB 00F8 8083 0003 0399 COPY SCB:LUN(X),A LUN (SID) 00F9 8470 0030 0400  COPY A,LUN(Y) SET UP LUN IN IOB 00FA 0900 0401 COPY =0,A 00FB 8471 0031 0402  COPY A,LUN+1(Y) ZERO IOB RESERVED WORD 00FC 0930 0403 COPY =FUOPER,A FUNCTION, OPEN 00FD 8473 0033 0404 COPY A,IO:FC+LUN(Y) STORE IN IOB 00FE 1A07 0405 I:IO LUN(Y) OPEN IT 00FF 1030 0030 0405+ 0100 9E88 0109 0406 JMP ERFOP ERROR ON FILE OPEN 0101 A06D 002D 0407 COPY  SAVSCB(Y),X RESTORE SCB ADDRESS 0102 0902 0408 COPY =DISKU:,A DISKU: => DISK FILE 0103 8481 0001  0409 COPY A,SCB:FLW(X) SET UP SCB FLAG WORD 0104 8021 0021 0410 COPY R:ACT,A USER ID 0105 8482 0002 0411 COPY A,SCB:USR(X) SET UP USER ID IN SCB 0106 0900 0412 COPY =0,A SAYS ALL OK 0413 EXTR C:UNLOCK 0107 FF8F 0117 0413+ EXT JSK C:UNLOCK DE-MUTUALLY EXCLUDE 0108 2309 0414 RSK RETURN TO CALLER 0109 8077 0037 0415 ERFOP COPY IO:ST+LUN(Y),A GET STATUS FOR ERROR RETURN 010A 9E7C 0107 0416 JMP EXT EXIT WITH STATUS 1PAGE 0011 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII1.ASM - 93530-11 E810 1982/02/02 14:26:50.75 -- SUB16CFI -- 0418 *  0419 * SUB16CFI - SUBTRACTS 16 FROM THE CFI WHOSE ADDRESS IS IN X. 0420 * IT ASSUMES THAT A LEGAL CFI CAN NEVER BE ZERO. 0421 * 010B 8081 0001 0422 SUB16CFI COPY 1(X),A 1(X) IS CFI WORD 2 010C 1143 0110 0423 JEQ A,DECW0 HERE MUST DEC WORD 1 010D 0AF0 0424 SUB =16,A  SUBTRACT 16 010E 8481 0001 0425 COPY A,1(X) STORE BACK IN WORD 2 010F 2309 0426 RSK  AND EXIT TO CALLER 0110 08F0 0427 DECW0 COPY =-16,A 0-16 = NEW WORD 2 0111 8481 0001 0428 COPY A,1(X) STORE AWAY 0112 8080 0000 0429 COPY 0(X),A WORD 1 0113 0AFF 0430 SUB =1,A NOW DECREMENTED 0114 8480 0000 0431 COPY A,0(X) STORE BACK IN WORD 1 0115 2309 0432 RSK AND EXIT TO CALLER 0116 002F ERRXT3 0117 0003 C:UNLOCK  0433 END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0001 MACRO (F300) EXTENDED I/O INTERFA  CE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:26:52.75 -- C:WRUID0 -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0001 EII: REL 0001+ SHARABLE EII: 0001+  ROMMABLE EII: 00000000 0002 SIDX EQU 0 00000001 0003 UIDX EQU 1 00000002 0004 REPLYX EQU 2 00000002 0005 SID EQU 2 00000003 0006 UID EQU SID+1 00000004 0007  NBYTES EQU SID+2 00000005 0008 ABYTEST EQU SID+3 00000006 0009 REPLY EQU SID+4 00000007 0010 BYTEST EQU REPLY+1 00000007 0011 ENDSTK EQU BYTEST 1PAGE 0002 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:26:53.00 -- C:WRUID0 -- 0013 ************************************************************************ 0014 *  * 0015 * E I I S E R V I C E --- C : W R U I D 0 --- *  0016 * * 0017 ************************************************************************ 0000 0018 NAM C:WRUID0 0019  EXTR C:WR0 0020 EXTR C:ENTER 0000 FF97 0018 0020+ C:WRUID0 JSK C:ENTER 0001 0009  0020+ WORD ENDSTK+2 0002 8080 0000 0021 COPY SIDX(X),A FETCH AND SAVE ... 0003 8442 0002 0022 COPY A,SID(Y) 0004 8081 0001 0023 COPY UIDX(X),A 0005 8443 0003 0024 COPY A,UID(Y) 0006 8082 0002 0025 COPY REPLYX(X),A 0007 8446 0006 0026 COPY A,REPLY(Y) ... ALL PARAMETERS 0008 0060 0027 COPY Y,A NOW SET UP ADDRESSES 0009 0B07 0028 ADD =BYTEST,A 000A 8445 0005 0029 COPY A,ABYTEST(Y) ADDRESS TO RETURN BYTES TRANSFERRED 000B 8143 0003 0030  COPY *UID(Y),A FIRST WORD OF UID 000C 0E79 0031 SHIFT A,RO,8 # CHARS TO O/P 000D 0AFD  0032 SUB =3,A MINUS THREE COUNT BYTES 000E 12C7 0016 0033 JLE A,NULLUID HERE NULL UID 000F 8444 0004 0034 COPY A,NBYTES(Y) STORE BYTE COUNT 0010 8043 0003 0035 COPY UID(Y),A  UID ADDRESS 0011 0B02 0036 ADD =UIDDATA,A UID DATA BYTE ADDRESS 0012 8443 0003 0037 COPY A,UID(Y) SAVE IT 0013 2060 0038 COPY Y,X 0014 2B02 0039 ADD =SID,X X SET UP FOR C:WR0 0015 FF83 0019 0040 JSK C:WR0 OUTPUT THE STRING 0016 8546 0006 0041 NULLUID COPY  A,*REPLY(Y) STORE REPLY 0042 EXTR C:RETURN 0017 9F82 001A 0042+ JMP C:RETURN 0018 0001 C:ENTER 0019 0002 C:WR0 001A 0000 C:RETURN 0043 END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0003 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:26:55.2! 5 -- C:OPUID0 -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0044 EII: REL  0044+ SHARABLE EII: 0044+ ROMMABLE EII: 00000000 0045 MADRX EQU 0 MEMORY ADDRESS 00000001 0046 SBYTEX EQU MADRX+1 BYTE # TO START 00000002 0047 MAXLENX EQU SBYTEX+1 MAXIMUM LENGTH 00000003 0048 UIDX EQU MAXLENX+1 UID ADDRESS 00000004 0049 ALASTBX EQU UIDX+1 ADDRESS TO STORE LAST BYTE # 00000005 0050 REPLYX EQU ALASTBX+1 ADDRESS TO STORE REPLY 00000002 0051 COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) 00000003 0052 ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000004 0053 ADROUT EQU  ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000005 0054 CUBYTE EQU ADROUT+1 CURRENT BYTE 00000006 0055 ADLASTB EQU CUBYTE+1 ADDRESS TO STORE LAST BYTE # 00000007 0056 REPLY EQU  ADLASTB+1 ADDRESS TO STORE REPLY 00000003 0057 UID EQU ADRIN UID ADDRESS (IS ADDRESS IN)  00000007 0058 ENDSTK EQU REPLY END STACK MARKER 1PAGE 0004 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:26:55.75 -- C:OPUID0 -- 0060 ************************************************************************ 0061 * *  0062 * E I I S E R V I C E --- C : O P U I D 0 --- * 0063 * ÿÿÿÿÿe820203152333820203152333820203153100eÚ@€820203152333820203152333820203153059" e820203152333820203152333820203152333e820203152333820203152333820203152333820203152333820203152333820203152333e ê8202021415482582020214154950820203152550e 480102808380875801028083819758202031526072e%3dý80101613490350801016134925758202031526252 eX# 5=8101130958242581011309582725820203152639 es)Z80102916122100801029161230258202031526522 e.[ã8103161351567581031613520200820203152710 eL*SÇ8201061200267582010612003125820203152726 ev »80102811525250801028115258008202031527352e8™8201201446147582012014461800820203152750ež¥8201191332205082012013460075820203152758$ eŸ3Ï8010281215562582020214303475820203152811eˆR¹;8202031528170082020315285625820203152856d% & ' ( ) * + ÿÿÿÿÿÿÿÿÿÿÀÿÿÿÿÿÿð. NEWEII MACNEWEII1 ASMNEWEII2 ASM NEWEII3 ASM NEWEII4 ASM NEWEII5 ASM NEWEII6 ASM NEWEII7 ASMNEWEII8 ASMNEWEII JCLEII LIBNEWEII LST,  ETITL5 C:OPEN0 * * EQUATES FOR C:OPEN0 * UIDX EQU 0 UID ADDRESS SIDX EQU UIDX+1 SID ADDRESS DTYPEX EQU SIDX+1 DATA TYPE REPLYX EQU DTYPEX+1 ADDRESS TO STORE REPLY REPBK EQU 1 ADDRESS OF REPLY BLOCK (FOR PARTIAL OPEN) RNAMAD EQU REPBK+NAMPT: RDIBAD EQU REPBK+PUN: RFNO EQU REPBK+FNO: RVOL EQU REPBK+VOLPT: RNAME EQU REPBK+RLN:+1 ADDRESS TO STORE 14-BYTE FILE NAME UID EQU 2 UID ADDRESS SID EQU UID+1 SID ADDRESS REPLY EQU SID+1 ADDRESS TO STORE REPLY DTYPE EQU REPLY+1 DATA TYPE PARTOPEN EQU DTYPE+1 INDICATOR (-1 => FULL OPEN, 0 => PARTIAL OPEN) SCB EQU PARTOPEN+1 ADDRESS OF STREAM CONTROL BLOCK MKR EQU SCB+1 MARKER USED WHEN DEALING WITH SID (ONLY) CNT EQU MKR+1 COUNT (USED BY COPYNAME), USED TO INDEX INTO UID IDX EQU CNT+1 TEMP INDEX INTO UID (USED IN COPYNAME) NAMVEC EQU IDX+1 NAME VECTOR (14 BYTES) VOLVEC EQU NAMVEC+7 VOLUME VECTOR (14 BYTES) CONNBK EQU VOLVEC+7 CONNECT BLOCK LUN EQU CONNBK+LUN: FNO EQU CONNBK+FNO: PUN EQU CONNBK+PUN: VOL EQU CONNBK+VOLPT: NAME EQU CONNBK+NAMPT: NSIZE EQU LUN+IO:ST+1 SAVE NAME SIZE HERE TERM EQU NSIZE+1 TERMINATOR IS SAVED HERE BADR EQU TERM+1 BLOCK ADDRESS (FOR FRMEM0) REPLY2 EQU BADR+1 REPLY ADDRESS (FOR FRMEM0) ENDSTK EQU REPLY2 END OF STACK MARKER FUOPER EQU FU:%4+OP: FUNCTION, OPEN NL EQU :A NEWLINE ETITL C:OPEN0 ************************************************************************ *  * * E I I S E R V I C E --- C : O P E N 0 --- * *  * ************************************************************************ NAM C:OPEN0,C:PTOPEN EXTR C:DIBCH,C:GTMEMX,C:FRMEM0,C:GTMEMX,C:SCBCH,C:INIT C:PTOPEN ENT:EII ENDSTK COPY =0,A SAYS IS A PARTIAL OPEN JMP ALTENT ENTER AT ALTERNATE ENTRY POINT C:OPEN0 ENT:EII ENDSTK COPY =-1,A SAYS IS A FULL OPEN ALTENT COPY A,PARTOPEN(Y) STORE PARTIAL OPEN MKR COPY UIDX(X),A GET UID COPY SIDX(X),Q AND SID COPY A,UID(Y) SAVE UID COPY Q,SID(Y) AND SID COPY DTYPEX(X),Q DATA TYPE? COPY REPLYX(X),A GET REPLY ADDRESS CSK Q,=:40 IS DATA TYPE 0-:3F? JGE Q,MBDTYP YES: MUST BE A DATA TYPE IF NOT -VE NOP NO: >= :40 COPY Q,A NO: >= :40, DATA TYPE MUST BE REPLY ADDRESS COPY =-1,Q -1 => DEFAULT THE DATA TYPE JMP DEFDTYP SKIP THE RANGE CHECK! MBDTYP CSK Q,=A2I: IN RANGE ? (A2I: IS HIGHEST) JGE Q,$+2 IS IT >=0 ? JMP BADDMD NO: BAD DATA MODE DEFDTYP COPY Q,DTYPE(Y) SAVE DATA TYPE COPY A,REPLY(Y) SAVE FOR LATER COPY A,REPLY2(Y) AND IN REPLY2 FOR FRMEM0 CALL JSK C:INIT DO INITIALIZATION FOR EII? JNE A,EROP0AL LONGJUMP (ERROR) IF SPACE EXHAUSTED COPY A,FNO(Y) ZERO F-NUMBER COPY A,PUN(Y) AND PHYSICAL UNIT COPY Y,X ADD =NAMVEC,X ADDRESS OF NAMVEC COPY X,NAME(Y) SAVE IN NAME ADD =VOLVEC-NAMVEC,X ADDRESS OF VOLVEC COPY X,VOL(Y) SAVE IN VOL COPY SID(Y),X GET SID ADDRESS IN X COPY 0(X),A GET WD 0 OF SID COPY A,LUN(Y) SAVE FOR LATER SHIFT A,RO,8 TOP BYTE ONLY JEQ A,WSID HERE WANT SID COPY 1(X),A GET WD 1 OF SID SHIFT A,RO,8 TOP BYTE ONLY JEQ A,$+3 OK IF ZERO COPY =-1,A -1 => WRONG SID ERROR EROP0AL JMP EROP0A ERROR EXIT (NO UNLOCK) COPY =-1,A -1 => GOT SID (IN MKR) WSID COPY A,MKR(Y) 0 => WANT SID (IN MKR)  LOCK COPY C:SCBCH,X GET SCB CHAIN HEAD FZLP JNE X,$+3 HERE NOT END COPY =-2,A -2 => SID NOT FOUND JMP ERROP0 OR SID NOT AVAI- LABLE COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=UNUSED: IS SCB UNUSED? JMP $+2 YES: THEN ITS OK JMP EFZLP NO: DON'T WANT IT IF ITS USED COPY SCB:LUN(X),A GET LUN FROM SCB COPY MKR(Y),Q JNE Q,GSID HERE GOT SID AND =:FF,A GET BOTTOM BYTE CSK A,='0' >='0'? JMP EFZLP NO: LOOP NOP YES: CSK A,='9' YES: <= '9'? JMP $+2 YES: JMP EFZLP NO: LOOP COPY SCB:LUN(X),A YES: NOW CHECK FOR X AND Z! SHIFT A,RO,8 GET TOP BYTE CLSN A,='X' IS IT X? JMP FNDSID HERE GOT NEW SID (X?) CLSN A,='Z' IS IT Z? JMP FNDSID HERE GOT NEW SID (Z?) EFZLP COPY SCB:CHN(X),X GET NEXT SCB IN CHAIN JMP FZLP AND LOOP BADDMD COPY =-26,A -26 => ILLEGAL DATA MODE SPECIFIED JMP EROP0A ERROR EXIT (NO UNLOCK) LPOOL TITL * * HERE WE HAVE AN SID, IS IT THE ONE WE WANT? * GSID CSK A,LUN(Y) LUN SAME? JMP EFZLP NO JMP EFZLP NO COPY X,SCB(Y) YES: REMEMBER SCB COPY SCB:UID(X),A GET SAVED UID JEQ A,NOSUID JUMP IF NO SAVED UID COPY A,BADR(Y) STORE FOR FRMEM0 CALL COPY Y,X ADD =BADR,X X SET UP FOR FRMEM0 CALL JSK C:FRMEM0 FREE THE BLOCK JEQ A,NOSUID JUMP IF NO ERROR JMP ERROP0 HERE ERROR, EXIT NOSUID COPY *UID(Y),A GET FIRST WORD OF UID SHIFT A,RO,9 BYTE COUNT / 2 ADD =1,A = # WORDS COPY A,CNT(Y) SAVE IN CNT JSK C:GTMEMX GET BLK ADDRESS IN A JNE A,$+3 SKIP IF NO ERROR COPY =-15,A -15 => FREE SPACE EXHAUSTED JMP ERROP0 HERE ERROR - EXIT COPY SCB(Y),X SCB ADDRESS IN X COPY A,SCB:UID(X) STORE POINTER TO UID COPY COPY A,BADR(Y) STORE UID COPY ADDR COPY CNT(Y),X COUNT IN X SUB =1,X DON'T COPY WORD 11 COPY *UID(Y,X),A GET NTH WORD COPY A,*BADR(Y,X) STORE NTH WORD JNED X,$-2 LOOP TILL COPIED ALL JMP GLUNSCB DONE - GOT LUN AND SCB FNDSID COPY SCB:LUN(X),A GET FOUND LUN AGAIN COPY A,LUN(Y) SAVE IT COPY X,SCB(Y) AND REMEMBER SCB COPY SID(Y),X GET SID ADDRESS COPY A,0(X) STORE SID BACK COPY =0,A COPY A,1(X) AND THE ZERO TERMINATOR TITL * * NOW HAVE SID (LUN) TO OPEN ON, NEXT WE PROCESS * THE UID BLOCK. * GLUNSCB COPY *UID(Y),A GET BYTE COUNT / PARTA SIZE AND =:FF,A PART A SIZE COPY A,CNT(Y) SAVE FOR COPYNAME CALL COPY =4,A INDEX IN (FOR DATA) FROM THE UID COPY A,IDX(Y) SAVE FOR COPYNAME CALL JSK COPYNAME GENERATE NAME IN 'NAME' JEQ Q,LEN0 LENGTH =0, MAY BE 'UF' OR '/' ! COPY =0,A COPY A,TERM(Y) TERMINATOR DOES NOT MATTER CLSN Q,=2 IS LENGTH 2 BYTES? JMP LEN2 YES: MAY BE LUN OR DEVICE CLSN Q,=3 NO: IS LENGTH 3 BYTES? JMP LEN3 YES: MAY BE A DEVICE CLSN Q,=4 NO: IS LENGTH 4 BYTES? JMP LEN4 YES: MAY ALSO BE A DEVICE * * DROP THROUGH TO ... * * HERE MUST BE A VOLUME NAME * MBVOL COPY VOL(Y),X NAME ADDRESS EXCH X,NAME(Y) IS NOW NAME ADDRESS COPY X,VOL(Y) AND VICE-VERSA COPY 5(X),A WORD 6 (WE NEED TO ADD .VOL HERE) AND =:FF00,A UPPER BYTE IS FILENAME OR ='V',A ADD 'V' OF .VOL EXTENSION COPY A,5(X) UPDATE NAME COPY ='OL',A 'OL' OF .VOL EXTENSION COPY A,6(X) .VOL EXTENSION NOW ADDED JMP PROCFN NOW PROCESS THE FILENAME * * HERE LENGTH IS ZERO, MUST DEFAULT 'UF' * LEN0 COPY A,TERM(Y) REMEMBER TERMINATOR E:SLU ='UF' JEQ A,$+3 JUMP IF REPLY OK COPY =-6,A -6 => PUN NOT FOUND JMP ERROP0 RETURN ERROR REPLY ISLUN COPY 1(X),X NOW X=DIB/FCB ADDRESS ISDEV COPY DI:FLG(X),A GET DIB/FCB FLAGWORD JLT A,ISFILE JUMP IF AN FCB SDPROCFN COPY X,PUN(Y) STORE THE DIB ADDRESS COPY =0,A COPY A,VOL(Y) BLANK OUT THE VOLUME NAME JMP PROCFN NOW PROCESS THE FILENAME TITL * * HERE WE.  HAVE A FILE (X= FCB ADDRESS) * ISFILE COPY TERM(Y),A GET TERMINATOR CLSN A,='/' IS IT '/' ONLY ? JMP WDIR YES: WANT ROOT DIRECTORY COPY FC:FNO(X),A F-NUMBER COPY A,FNO(Y) F-NUMBER SET UP WDIR COPY FC:DIB(X),X X = DIB ADDRESS JMP SDPROCFN STORE DIB AND PROCESS FILENAME * * HERE WE HAVE A NAME OF LENGTH 2, FIRST CHECK FOR LUN * LEN2 COPY Q,CNT(Y) SAVE LENGTH IN CNT COPY NAME(Y),X NAME ADDRESS IN X E:SLU 0(X) SEARCH FOR LOGICAL UNIT JEQ A,ISLUN JUMP IF FOUND LUN COPY NAME(Y),X NAME ADDRESS IN X AGAIN COPY ='00',A SB3FDIB COPY A,1(X) MAKE UNIT NUMBER '00' FDIB JSK PUNTODIB GET DIB ADDRESS COPY A,X GET REPLY (DIB ADDRESS?) IN X JNE X,ISDEV JUMP IF A DEVICE COPY NAME(Y),X ADDRESS OF NAME COPY CNT(Y),Q COUNT OF BYTES CLSN Q,=4 WERE THERE 4 BYTES? JMP MBVOL YES: MUST BE A VOLUME NAME CLSN Q,=3 NO: WERE THERE 3 BYTES? JMP WAS3 YES: WAS THREE BYTES COPY =' ',A SPACES RNA COPY A,1(X) RESTORE NAME AGAIN JMP MBVOL NOW TRY FOR VOLUME NAME WAS3 COPY 1(X),A GET MODIFIED PART OF NAME SHIFT A,LO,8 RESTORE BYTE 3 OR =' ',A AND ADD THE FOLLOWING SPACE JMP RNA RESTORE NAME AND TRY FOR VOLUME * * HERE WE HAVE A NAME OF LENGTH 3 * LEN3 COPY Q,CNT(Y) SAVE LENGTH IN CNT COPY NAME(Y),X NAME ADDRESS IN X COPY 1(X),A GET BYTE 3 OF NAME SHIFT A,RO,8 SHIFT IT TO BYTE 4 OR =:3000,A OR IN '0' AS BYTE 3 JMP SB3FDIB STORE BYTE 3 AND FIND DIB ETC. TITL * * HERE WE HAVE A NAME OF LENGTH 4 * LEN4 COPY Q,CNT(Y) SAVE LENGTH IN CNT COPY NAME(Y),X NAME ADDRESS IN X JMP FDIB NOW ATTEMPT TO FIND DEVICE OR VOLUME * * HERE WE DEAL WITH ERRORS * ERROP0 COPY A,*REPLY(Y) RETURN REPLY CORRECTLY UNLOCK COPY *REPLY(Y),A RESTORE REPLY TO A RET:EII . RETURN FROM CALL EROP0A COPY A,*REPLY(Y) RETURN REPLY CORRECTLY RET:EII . RETURN FROM CALL * LPOOL TITL * * WE HAVE NOW PROCESSED THE SID AND PART A OF THE UID. THE VOL, PUN * AND FNO FIELDS OF THE CONNECT BLOCK ARE CORRECTLY SET UP. * PROCFN COPY UID(Y),X UID ADDRESS IN X COPY PARTBC(X),A PART B/ PART C BYTE COUNTS SHIFT A,RO,8 PART B BYTE COUNT COPY A,CNT(Y) STORE FOR COPYNAME CALL JNE A,FNSTHERE JUMP IF FILENAME(S) EXIST * * HERE PART B IS NULL, ITS EITHER A DEVICE OR AN LUN (CONNECT BY FNO) * COPY FNO(Y),A F-NUMBER JNE A,ISCBFNO JUMP IF CONNECT BY F-NUMBER COPY A,NAME(Y) ZERO THE NAME (DEVICE CONNECT) F:CONN CONNBK(Y) CONNECT TO DEVICE CLSN A,=1 IS REPLY =1 (DEVICE CONNECTED) ? JMP $+3 YES: CONNECT OK, SKIP ERROR REPORT CONNFAIL COPY =-3,A -3 => CONNECT FAILED JMP ERROP0 REPLY WITH ERROR CODE COPY DI:NAM(X),A DEVICE NAME (2 CHARS) SHIFT A,RO,8 TOP CHAR IN A CLSN A,='D' IF DEVICE BEGINS WITH 'D', ITS A DISK JMP $+2 HERE ITS AN ERROR JMP ISCHDEV HERE IS A CHARACTER DEVICE COPY =-4,A -4 => ATTEMPT TO OPEN A DISK, NOT A FILE JMP ERROP0 REPLY WITH ERROR CODE * * HERE ITS A CONNECT BY F-NUMBER DUE TO AN LUN NAME * ISCBFNO COPY A,NAME(Y) OVERWRITE NAME WITH F-NUMBER COPY =0,A COPY A,FNO(Y) ZERO F-NUMBER F:CFNO CONNBK(Y) CONNECT TO FILE CLSN A,=2 IS CONNECT TO A FILE JMP FILECON YES: CONNECT OK JMP CONNFAIL NO: FLAG ERROR TITL * * HERE PART B IS NOT NULL, SO WE MUST LOOP, PROCESSING FILENAMES AS * NECESSARY UNTIL WE REACH END-OF-STRING ON PART B. * FNSTHERE JSK COPYNAME GET NEXT FILENAME IN NAME JEQ Q,CONNFAIL NULL NAME WILL FAIL CONNECT CLSN A,='/' IS TERMINATOR '/' ? JMP ADDDIR YES: MUST ADD .DIR TO N/ AME * * DROP THROUGH TO ... * * HERE WE HAVE REACHED THE END OF PART B. WE NEED TO ADD THE * EXTENSION (IN PARTC) TO THE NAME. * ADDEXT COPY UID(Y),X GET UID ADDRESS IN X COPY PARTBC(X),A PART B/ PART C BYTE COUNTS AND =:FF,A PART C BYTE COUNT SUB =1,A MINUS 1 FOR THE MANDATORY '.' JLE A,CHKPOPN CHECK FOR PARTIAL OPEN IF NO EXTENSION IMS IDX(Y) INCREMENT BYTE INDEX PAST '.' NEG A,A COUNT NOW -VE COPY A,CNT(Y) SET UP COUNT FOR LOOP COPY =11,X BYTE 11 IS WHERE WE START STORING COPY UID(Y),Q ADDRESS IN IN Q EXTLP EXCH X,IDX(Y) INDEX IN IN X, INDEX OUT IN IDX EXCH Q,Y ADDRESS IN IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPY 0(Y,X),A GET BYTE FROM UID RBIT 2,S WORD MODE EXCH Q,Y RESTORE Y, ADDRESS IN IN Q EXCH Q,NAME(Y) ADDRESS OUT IN Q, ADDRESS IN IN NAME ADD =1,X INC INDEX IN EXCH X,IDX(Y) INDEX OUT IN X, INC'D INDEX IN IN IDX EXCH Q,Y ADDRESS OUT IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPY A,0(Y,X) STORE BYTE IN NAME RBIT 2,S WORD MODE EXCH Q,Y RESTORE Y, ADDRESS OUT IN Q EXCH Q,NAME(Y) ADDRESS IN IN Q, ADDRESS OUT IN NAME ADD =1,X INC INDEX OUT IMS CNT(Y) INC COUNT, SKIP IF DONE JMP EXTLP LOOP, COPYING EXTENSION * * DROP THROUGH TO ... TITL * * HERE WE CHECK FOR A PARTIAL OPEN * CHKPOPN COPY PARTOPEN(Y),A GET PARTIAL OPEN MARKER JLT A,CONNFILE JUMP IF A NORMAL OPEN * * HERE ITS A PARTIAL OPEN - WE MUST RETURN THE DATA REQUIRED. * COPY REPLY(Y),X REPLY ADDRESS (ITS A VECTOR !!) COPY PUN(Y),A COPY A,RDIBAD(X) RETURN DIB ADDRESS COPY FNO(Y),A COPY A,RFNO(X) RETURN F-NUMBER COPY VOL(Y),A COPY A,RVOL(X) RETURN VOLUME NAME ADDRESS COPY X,A ADD =RNAME,A ADDRESS TO STORE NAME COPY A,RNAMAD(X) STORE FOR REPLY COPY A,X GET IN X FOR COPY LOOP COPY =6,Q COUNT FOR # WORDS NAMLP COPY *NAME(Y),A GET WORD FROM NAME COPY A,0(X) STORE IN REPLY VECTOR IMS NAME(Y) INC INPUT NAME ADDRESS ADD =1,X AND DESTINATION ADDRESS JNED Q,NAMLP LOOP TILL STORED 7 WORDS COPY =0,A 0 => ALL OK COPY A,*REPLY(Y) STORE REPLY COPY SCB(Y),Q GET SCB IN Q FOR EXIT * NOTE THAT THE CALLER MUST 'UNLOCK' ON A SUCCESSFUL RETURN RET:EII * * HERE WE NEED TO ADD .DIR TO THE FILENAME * ADDDIR COPY NAME(Y),X NAME ADDRESS IN X COPY 5(X),A AND =:FF00,A UPPER BYTE IS FILENAME OR ='D',A OR IN 'D' OF .DIR EXTENSION COPY A,5(X) UPDATE THE NAME COPY ='IR',A 'IR' OF .DIR EXTENSION COPY A,6(X) .DIR EXTENSION NOW ADDED COPY CNT(Y),A GET COUNT REMAINING JEQ A,CHKPOPN CHECK FOR PARTIAL OPEN IF EOS * * DROP THROUGH TO ... TITL * * HERE WE ARE ALL SET UP FOR THE CONNECT * CONNFILE COPY *NAME(Y),A FIRST TWO CHARS OF FILENAME SUB ='##',A '##' MEANS F-NUMBER FOLLOWS JEQ A,CFNOCON JUMP IF F-NUMBER CONNECT F:CONN CONNBK(Y) CONNECT TO FILE/DIRECTORY  CLSN A,=2 IS IT CONNECTED TO A FILE JMP $+2 YES: ALL OK JMP CONNFAIL NO: WE FAILED TO CONNECT COPY FC:FNO(X),A GET F-NUMBER OF CONNECTED FILE COPY A,FNO(Y) SAVE FOR MULTI-DIR CONNECT COPY CNT(Y),A CHARS LEFT IN PART B JEQ A,FILECON JUMP IF NO FILENAMES LEFT JMP FNSTHERE HERE THERE ARE FILENAMES TO PROCESS * * HERE WE DEAL WITH AN F-NUMBER OPEN DUE TO A '##XXXX' CONSTRUCT. * THE REST OF THE UID IS IGNORED. * CFNOCON COPY PARTOPEN(Y),A WHAT SORT OF OPEN? JEQ A,INVPOPN INVALID FOR PARTIAL OPEN COPY NAME(Y),X NAME ADDRESS IN X ADD =1,X POINTS PAST THE '##' JSK CONVHEX CONVERT FOLLOWING NUMBER TO HEX JEQ A,$+2 SKIP IF NO E0 RROR JMP ERROP0 JUMP IF IN ERROR COPY Q,A GET F-NUMBER IN A JMP ISCBFNO CONNECT BY F-NUMBER AND EXIT * * HERE HAVE CONNECTED ALONG A PATH TO A FILE * FILECON COPY SCB(Y),X SCB ADDRESS IN X COPY DTYPE(Y),Q GET DATA TYPE IN Q JGE Q,$+2 SKIP IF SPECIFIED COPY =UFM:,Q THE DEFAULT (FOR A DISK) IS UNFORMATTED COPY Q,SCB:DTP(X) STORE IN THE SCB COPY =DISKU:,A UNBUFFERED DISK CLSN Q,=I2A: IS DATA TYPE ISO2ASCII? ADD =DISKB:-DISKU:,A YES: THEN MAKE IT A BUFFERED DISK CLSN Q,=A2I: IS DATA TYPE ASCII2ISO?  ADD =DISKB:-DISKU:,A YES: THEN MAKE IT A BUFFERED DISK JMP NAFCD NOW AS FOR A CHARACTER DEVICE LPOOL TITL * * HERE HAVE CONNECTED ALONG A PATH TO A CHARACTER DEVICE * ISCHDEV COPY PARTOPEN(Y),A WHAT SORT OF OPEN? JLT A,$+3 JUMP IF NORMAL INVPOPN COPY =-9,A -9 => INVALID PARTIAL OPEN JMP ERROP0 ERROR EXIT COPY SCB(Y),X GET SCB ADDRESS COPY DTYPE(Y),A DATA TYPE JGE A,$+2 JUMP IF SPECIFIED COPY =I2A:,A THE DEFAULT (FOR CHAR. DEVICES) IS ISO2ASCII COPY A,SCB:DTP(X) STORE DATA TYPE IN SCB COPY =CHDEV:,A SAYS IS A CHARACTER DEVICE NAFCD COPY A,SCB:FLW(X) STORE SCB FLAGWORD COPY R:ACT,A USER ID COPY A,SCB:USR(X) STORE IN SCB COPY =UNUSED:,A UNUSED IDENTIFIER COPY A,SCB:IOM(X) SAYS I/O MODE IS UNSPECIFIED COPY =NL,A NEWLINE COPY A,SCB:ELT(X) MAKE NEWLINE END-OF-LINE TERMINATOR COPY =0,A COPY A,SCB:CC(X) ZERO CHARACTER COUNT AND ... COPY A,SCB:CBP(X) ... BUFFER POINTER (IN CASE BUFFERED) * * DATA TYPE, ETC. DEALT WITH -- BUT DO WE NEED A BUFFER? * COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=DISKU: IS THIS AN UNBUFFERED DISK? JMP GOTBUF YES: THEN WE DON'T NEED A BUFFER COPY SCB:CHB(X),A GET CHAR BUFFER JNE A,GOTBUF HERE ALREADY HAVE A BUFFER COPY C:SCBCH,X GET SCB CHAIN HEAD FSCBUF JEQ X,NONEAVL HERE NO BUFFERS AVAILABLE COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=1 1 => IN USE JMP BFUSED HERE IN USE COPY SCB:CHB(X),A 2 OR 0 => AVAIL, IS IT THERE? JEQ A,BFUSED JUMP IF NOT THERE COPY =0,Q COPY Q,SCB:CHB(X) MARK NOT THERE COPY SCB(Y),X COPY A,SCB:CHB(X) PUT IN OUR SCB JMP GOTBUF NOW WE'VE GOT A BUFFER BFUSED COPY SCB:CHN(X),X NEXT SCB JMP FSCBUF LOOK AT NEXT ONE NONEAVL COPY =CHBUFLEN/2,A CHBUFLEN/2 WORD BUFFER JSK C:GTMEMX GET MEMORY JNE A,$+3 OK IF NOT 0 COPY =-15,A -15 => FREE SPACE EXHAUSTED JMP ERROP0 ERROR EXIT COPY SCB(Y),X SCB ADDRESS IN X COPY A,SCB:CHB(X) UPDATE IN SCB * * DROP THROUGH TO ... * TITL * * HERE WE HAVE THE SCB SET UP AND THE BUFFER ALLOCATED (IF REQUIRED). * NOW WE MUST OPEN THE FILE/DEVICE. THE SCB IS IN X. * GOTBUF COPY SCB:CFI(X),A CFI (FROM SCB) IS IN A COPY A,IO:CRI+LUN(Y) SET UP IN THE OPEN BLOCK COPY =0,A COPY A,LUN+1(Y) ZERO THE RESERVED WORD OF THE IOB COPY =FUOPER,A FUNCTION, OPEN. COPY A,IO:FC+LUN(Y) STORE IN THE IOB I:IO LUN(Y) OPEN THE FILE/DEVICE JMP ERFDOP ERROR ON FILE/DEVICE OPEN COPY =0,A 0 => GOOD REPLY JMP ERROP0 NOW AS FOR ERROR EXIT * * HERE WE HAVE AN OPEN ERROR * ERFDOP COPY SCB(Y),X GET SCB ADDRESS IN X COPY =UNUSED:,A UNUSED MARKER COPY A,SCB:FLW(X) SAYS SCB UNUSED COPY IO:ST+LUN(Y),A ERROR STATUS JMP ERROP0 REPLY WITH THAT! * LPOOL ETITL PUNTODIB PUN0X EQU 0 PUN1X EQU 1 PUN0 EQU 2 PUN1 EQU 3 PUNTODIB ENT:EII 2 COPY PUN0X(X),A COPY PUN1X(X),Q COPY A,PUN0(Y) COPY Q,PUN1(Y) PUN0(Y) AND PUN1(Y) HOLD PUN NAME COPY =C:DIBCH,X DIB CHAIN ADDR IN X LP COPY DBC:CHN(X),X NEXT 1 DIB CHAIN ELEMENT JEQ X,DONEND HERE DONE (ERROR) - GOT TO END COPY DBC:NAM1(X),A GET FIRST DIB WORD CSK A,PUN0(Y) EQUAL TO FIRST WORD OF THIS ENTRY? JMP LP NO: TRY NEXT ONE JMP LP NO: TRY NEXT ONE COPY DBC:NAM2(X),A FIRST EQUAL, TRY SECOND WORD CSK A,PUN1(Y) IS IT EQUAL? JMP LP NO: TRY NEXT ONE JMP LP NO: TRY NEXT ONE COPY DBC:DIB(X),A EQUAL: GET DIB ADDRESS RET:EII . AND RETURN DONEND COPY =0,A 0 => NOT FOUND RET:EII ETITL COPYNAME * * COPYNAME - AN INTERNAL ROUTINE WHICH COPIES A NAME FROM THE UID * INTO THE NAME BLOCK. THE DATA EXPECTED IS AS FOLLOWS: * * OUTPUT BASE ADDRESS IN NAME(Y) * INPUT BASE ADDRESS IN UID(Y) * INPUT BYTE INDEX (INTO UID) IN IDX(Y) * COUNT OF BYTES LEFT IN CNT(Y) * THE NAME IS COPIED AND SPACE-FILLED. THE ACTUAL SIZE OF THE NAME * (LESS TERMINATOR) IS LEFT IN Q AND THE INCREMENTED INPUT BYTE * INDEX IS LEFT IN X AND IDX(Y) ON EXIT. THE TERMINATING CHARACTER * IS LEFT IN A ON EXIT, OR ZERO IF END OF STRING TERMINATED. * * NOTE: * THIS ROUTINE ASSUMES THAT THE UID WILL NOT CONTAIN A NAME WHICH * IS ILLEGAL OR LONGER THAN PERMISSABLE. IF PRESENTED WITH A BAD * UID THE RESULT IS UNDEFINED. AN UNMODIFIED UID INPUT VIA RDUID0 * WILL ALWAYS WORK PROPERLY. * COPYNAME COPY NAME(Y),X NAME ADDRESS IN X COPY =' ',A TWO SPACES COPY =6,Q N:=6 SFLLP XNX Q COPY A,0(X) SPACE-FILL WORD N JNED Q,SFLLP N:=N-1, REPEATWHILE N NE 0 COPY CNT(Y),A GET COUNT JNE A,NZLEFT JUMP IF INPUT NOT EMPTY COPY A,Q EOS RETURNED COPY IDX(Y),X AND INPUT BYTE INDEX  RSK RETURN TO CALLER NZLEFT NEG A,A COPY A,CNT(Y) NEGATIVE COUNT NOW IN CNT(Y) COPY IDX(Y),X GET INPUT BYTE INDEX COPY =0,Q OUTPUT BYTE INDEX IS ZERO EXCH Q,UID(Y) INDEX OUT IN UID, ADDRESS IN IN Q BLOOP EXCH Q,Y ADDRESS IN IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB 0(Y,X),A GET INPUT BYTE RBIT 2,S WORD MODE EXCH Q,Y RESTORE Y, ADDRESS IN IN Q ADD =1,X INC INPUT BYTE INDEX CLSN A,='/' IS CHARACTER '/' ? JMP FNDTERM YES: FOUND TERMINATOR CLSN A,='.' NO: IS CHARACTER '.' ? JMP FNDTERM YES: FOUND TERMINATOR EXCH X,UID(Y) NO: INDEX OUT IN X, INDEX IN IN UID EXCH Q,NAME(Y) ADDRESS OUT IN Q, ADDRESS IN IN NAME EXCH Q,Y ADDRESS OUT IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB A,0(Y,X) STORE BYTE IN OUTPUT RBIT 2,S WORD MODE EXCH Q,Y RESTORE Y, ADDRESS OUT IN Q ADD =1,X INCREMENT INDEX OUT EXCH X,UID(Y) INDEX IN IN X, INDEX OUT IN UID EXCH Q,NAME(Y) ADDRESS IN IN Q, ADDRESS OUT IN NAME IMS CNT(Y) INC COUNT, SKIP IF EOS JMP BLOOP ELSE CONTINUE BYTE COPY LOOP EXCH Q,UID(Y) NAME SIZE IN Q, ADDRESS IN IN UID COPY X,IDX(Y) SAVE INPUT BYTE INDEX COPY =0,A 0 => EOS FOUND RSK * * HERE FOUND A TERMINATOR * FNDTERM EXCH Q,UID(Y) NAME SIZE IN Q, ADDRESS IN IN UID EXCH A,CNT(Y) -VE COUNT IN A, TERMINATOR IN CNT ADD =1,A INC COUNT NEG A,A COUNT IN A NOW +VE EXCH A,CNT(Y) TERMINATOR IN A, COUNT REMAINING IN CNT COPY X,IDX(Y) SAVE INPUT BYTE INDEX RSK RETURN TO CALLER ETITL CONVHEX * * CONVHEX - TAKES THE ADDRESS OF FOUR HEXADECIMAL CHARACTERS IN X * AND CONVERTS THEM TO AN INTEGER IN Q. A SPACE TERMINATES * THE HEX NUMBER. A RETURN CODE IS RETURNED IN A, * 0 => ALL OK, -VE => ERROR CODE. * CONVHEX COPY =0,Q RESULT SO FAR =0 COPY 0(X),A SHIFT A,RO,8 FIRST CHARACTER JSK CNVAC CONVERT AND ACCUMULATE JLE A,DUN HER2 E ERROR OR TERMINATE COPY 0(X),A AND =:FF,A SECOND CHARACTER JSK CNVAC CONVERT AND ACCUMULATE JLE A,DUN HERE ERROR OR TERMINATE COPY 1(X),A SHIFT A,RO,8 THIRD CHARACTER JSK CNVAC CONVERT AND ACCUMULATE JLE A,DUN HERE ERROR OR TERMINATE COPY 1(X),A AND =:FF,A FOURTH CHARACTER JSK CNVAC CONVERT AND ACCUMULATE JLE A,DUN HERE ERROR OR TERMINATE COPY 2(X),A SHIFT A,RO,8 FIFTH CHARACTER CLSN A,=' ' MUST BE SPACE? JMP OKHEX HERE OK COPY =-18,A -18 => ILLEGAL ## HEX VALUE DUN RSK RETURN CODE IN A, HEX VAL IN Q * OKHEX COPY =0,A 0 => ALL OK (SPACE TERMINATES XXXX) RSK ETITL CNVAC * * CNVAC - CONVERT A AND ACCUMULATE IN Q * CNVAC CSK A,='9' IN RANGE '0'-'9'? CSK A,='0' JMP $+3 NO JMP IS09 YES JMP IS09 YES CSK A,='F' IN RANGE 'A'-'F'? CSK A,='A' JMP $+3 NO JMP ISAZ YES JMP ISAZ YES CLSN A,=' ' IS IT A SPACE? JMP ISTM YES: TERMINATES COPY =-18,A NO: -18 => ILLEGAL ## HEX VALUE RSK ISTM COPY =0,A 0 => ALL OK RSK ISAZ ADD =:A-'A',A VALUE IN A VALINA SHIFT Q,LO,4 MULT Q BY :10 ADD A,Q ADD A, RESULT IN Q COPY =1,A IN CASE 0 IN A! RSK IS09 ADD =0-'0',A VALUE IN A JMP VALINA AND ACCUMULATE IN Q AS FOR 'A'-'F' END  ETITL5 C:CLOSE0 * * SETS FOR C:CLOSE0 * SIDX EQU 0 REPLY EQU 2 REPLYX EQU 1 SCB EQU 3 SID EQU 4 FC EQU SID+IO:FC IOSTAT EQU SID+IO:ST SIDW EQU IOSTAT+1 BADRW EQU SIDW+1 NBYTESW EQU SIDW+2 RBCADRW EQU SIDW+3 REPLYW EQU SIDW+4 RBCAD EQU SIDW+5 BYTEW EQU SIDW+6 CLFL EQU FU:%4+CL:+ER:V ETITL C:CLOSE0 ************************************************************************ *  * * E I I S E R V I C E --- C : C L O S E 0 ---  * * * ************************************************************************ NAM C:CLOSE0 EXTR C:CKOPEN,C:WR0 C:CLOSE0 ENT:EII :11 COPY REPLYX(X),Q GET REPLY ADDRESS COPY Q,REPLY(Y) SAVE ADDRESS FOR REPLY COPY Q,REPLYW(Y) AND FOR POSSIBLE WRITE COPY SIDX(X),X GET SID ADDRESS IN X COPY X,SIDW(Y) AND SAVE FOR POSSIBLE WRITE JSK C:CKOPEN CHECK OPEN SID ETC COPY Q,SCB(Y) SAVE RETURNED SCB JNE A,ERRCL0 IF NOT 0 ERROR COPY SCB(Y),X GET SCB ADDRESS COPY SCB:CC(X),A CHARACTER COUNT JEQ A,EXOK IF DON'T NEED TO PURGE OUT COPY SCB:IOM(X),A GET I/O MODE CLSN A,=CREAD: SKIP IF WRITING JMP EXOK JUMP IF READING COPY =:A00,A COPY A,BYTEW(Y) BYTE TO TRANSFER (=NEWLINE) COPY =1,A COPY A,NBYTESW(Y) WRITE ONE BYTE COPY Y,X ADD =RBCAD,X ADDRESS TO PUT ACTUAL BYTE COUNT COPY X,RBCADRW(Y) STORE FOR WRITE ADD =BYTEW-RBCAD,X ADDRESS OF BYTE TO WRITE COPY X,BADRW(Y) STORE BUFFER ADDRESS ADD =SIDW-BYTEW,X ADDRESS OF PARAMETER BLOCK FOR ... JSK C:WR0 ... WR0 CALL TO WRITE NEWLINE COPY *REPLYW(Y),A REPLY JEQ A,EXOK JUMP IF NO ERRORS JMP ERRCL0 EXIT WITH WRITE REPLY * LPOOL TITL * * HERE WE CLOSE THE FILE/DEVICE * EXOK COPY SCB(Y),X SCB ADDRESS COPY SCB:LUN(X),A LUN/SID COPY A,SID(Y) SAVE FOR I:IO CALL COPY SCB:CFI(X),X ADDRESS CG1/CFI IN X COPY X,SID+2(Y) STORE FOR CLOSE COPY =0,A COPY A,SID+1(Y) ZERO RESERVED WORD OF IOB COPY =CLFL,A FUNCTION, CLOSE, DON'T CALL DOIO COPY A,FC(Y) SET FUNCTION I:IO SID(Y) CLOSE FILE JMP ERRIIO HERE ERROR! COPY SCB(Y),X SCB ADDRESS COPY =0,A COPY A,SCB:FLW(X) SCB NOW FREE FOR USE ERRCL0 COPY A,*REPLY(Y) RETURN RE3 PLY RET:EII . RETURN, REPLY IN A ERRIIO COPY IOSTAT(Y),A GET REPLY STATUS JMP ERRCL0 ERROR EXIT * * END OF C L O S E 0 EII FUNCTION * END ETITL5 C:REV1 NAM C:REV1 C:REV1 EQU $ SATISFIES PEOPLE WHO READ THE MANUAL END ESS IN X COPY X,SIDW(Y) AND  ETITL6 C:WR0 * * SETS FOR C:WR0 * SIDX EQU 0 SID ADDRESS BADRX EQU SIDX+1 BUFFER ADDRESS NBYTESX EQU SIDX+2 BYTES TO TRANSFER RBCADRX EQU SIDX+3 ADDRESS TO RETURN THE NUMBER OF BYTES XFERRED REPLYX EQU SIDX+4 ADDRESS TO STORE REPLY BADR EQU 2 BUFFER ADDRESS NBYTES EQU BADR+1 BYTES TO TRANSFER RBCADR EQU BADR+2 ADDRESS TO RETURN THE NUMBER OF BYTES TRANSFERRED REPLY EQU BADR+3 ADDRESS TO STORE REPLY SCB EQU REPLY+1 ADDRESS OF STREAM CONTROL BLOCK COUNT EQU SCB+1 INTERNAL COUNTER FOR LOOP SAVX EQU COUNT+1 X SAVED HERE INSIDE LOOP TADR EQU SAVX+1 TRANSFER ADDRESS SAVED HERE INSIDE LOOP RCFI EQU TADR+1 CFI RETURNED HERE ELT EQU RCFI+2 HOLDS END LINE TERMINATOR (IN TXLT) SID EQU ELT+1 SID STORED HERE, XFER BLOCK STARTS HERE ... FC EQU SID+IO:FC CGI EQU SID+IO:CRI IOBYTES EQU SID+IO:BCT IOBUF EQU SID+IO:BUF IOACT EQU SID+IO:ACT IOSTAT EQU SID+IO:ST ... AND ENDS HERE NL EQU :A ASCII NEWLINE FF EQU :C ASCII FORM FEED CR EQU :D ASCII CARRIAGE RETURN WDIRS EQU WR:%4+DS:+ER:V WRITE, DIRECT STREAM, DON'T CALL DOIO WFORMS EQU WR:%4+FS:+ER:V WRITE, FORMATTED STREAM, DON'T CALL DOIO POSWAB EQU PO:%4+WAB:+ER:V POSITION, WP ABS BYTES, DON'T CALL DOIO WRFA EQU WR:%4+FA: WRITE, FORMATTED ASCII WUF EQU WR:%4+UF: WRITE, UNFORMATTED RWP EQU PO:%4+RWP:+ER:V POSITION, READ WRITE POINTER, DON'T CALL DOIO ENDSTK EQU IOSTAT END OF STACK MARKER ETITL C:WR0 ************************************************************************ * * * E I I S E R V I C E  --- C : W R 0 --- * * * ************************************************************************ NAM C:WR0 EXTR C:CKOPEN C:WR0 ENT:EII ENDSTK COPY BADRX(X),Q GET BUFFER ADDRESS COPY Q,BADR(Y) SAVE BUFFER ADDRESS COPY NBYTESX(X),A GET # BYTES COPY A,NBYTES(Y) SAVE FOR LATER COPY RBCADRX(X),A GET RETURN BYTE CT ADDRESS COPY A,RBCADR(Y) AND PRESERVE COPY REPLYX(X),A GET REPLY ADDRESS COPY A,REPLY(Y) AND PRESERVE COPY =0,Q COPY Q,*RBCADR(Y) SAY 0 BYTES TRANSFERRED FOR NOW! COPY SIDX(X),X GET SID ADDRESS JSK C:CKOPEN CHECK OPEN SID ETC COPY Q,SCB(Y) SAVE RETURNED SCB JNE A,ERRWR0 IF NOT 0 ERROR COPY Q,X GET SCB ADDRESS IN X COPY SCB:LUN(X),A LUN/SID COPY A,SID(Y) SAVE FOR I:IO CALL COPY =0,A COPY A,SID+1(Y) ZERO RESERVED WORD OF IOB COPY SCB:CFI(X),A ADDRESS CGI/CFI IN A COPY A,CGI(Y) STORE IN IOB COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=DISKU: IS IT AN UNBUFFERED DISK? JMP STRWT YES: ITS A STRAIGHT WRITE  COPY SCB:DTP(X),A GET DATA TYPE IN A COPY =WUF,Q WRITE, U/F IN CASE OF JUMP CLSN A,=UFM: IS IT U/F WRITE TO CH DEV? JMP ISUFMCH YES: ITS UNBUFFERED THEN JMP ISBUFWRT NO: HERE ITS A BUFFERED WRITE STRWT COPY =WDIRS,Q WRITE, DIRECT STREAM,DON'T CALL DOIO ISUFMCH COPY Q,FC(Y) STORE IN FUNCTION CODE OF IOB COPY NBYTES(Y),A JEQ A,ERRWR0 WRITE ZERO BYTES OK! COPY A,IOBYTES(Y) # BYTES TO XFER IN IOB COPY BADR(Y),A COPY A,IOBUF(Y) IO BUF ADDRESS IN IOB JSK DOWRITE DO THE WRITE OPERATION COPY A,Q GET REP4 LY IN Q COPY IOACT(Y),A EXTOK COPY A,*RBCADR(Y) REPLY WITH # BYTES XFERD COPY Q,A REPLY (Q) NOW IN A ERRWR0 COPY A,*REPLY(Y) RETURN REPLY RET:EII . RETURN WITH CODE TITL * * HERE WE HAVE A CHARACTER DEVICE, OR BUFFERED DISK FILE * * WITH OUTPUT TO A BUFFERED DEVICE, IT IS NOT NECESSARY TO * HAVE BOTH A CHARACTER COUNT AND AN INTERNAL BUFFER INDEX * POINTER. THE CHARACTER COUNT, (SCB:CC) HOWEVER, MUST BE MAINTAINED * TO ALLOW FOR INPUT AND OUTPUT SWITCHING. THIS EXPLAINS WHY * THE BUFFER POINTER (SCB:CBP) IS NOT USED IN THE FOLLOWING CODE. * ISBUFWRT COPY SCB:IOM(X),A GET I/O MARKER CLSN A,=CWRITE: IS IT WRITE? JMP ISWRT YES: OK COPY SCB:CC(X),A NO: GET CHAR COUNT JEQ A,$+3 IF 0 CHARS CAN SWITCH TO OUTPUT COPY =-8,A -8 => INCOMPATIBLE READS/WRITES JMP ERRWR0 RETURN ERROR CODE COPY =CWRITE:,A COPY A,SCB:IOM(X) UPDATE MODE FLAG = WRITE ISWRT COPY NBYTES(Y),A COPY =0,Q ZERO IN CASE WE JUMP ON NEXT LINE JEQ A,EXTOK HERE WRITE DONE! (WRITE 0 CHARS) NEG A,A COPY A,COUNT(Y) -VE COUNT SET UP COPY =0,A COPY A,SAVX(Y) SAVED (INPUT BYTE INDEX) X SET UP COPY SCB:CHB(X),A ADDRESS OF CHARACTER BUFFER COPY A,TADR(Y) SAVED IN TEMP ADDRESS COPY SCB:CC(X),X CHAR POSITION IN X COPY BADR(Y),Q GET INPUT ADDRESS IN Q CNZRO EXCH X,SAVX(Y) X IS INPUT X EXCH Q,Y SBIT 2,S COPYB 0(X,Y),A GET CHARACTER RBIT 2,S EXCH Q,Y EXCH Q,TADR(Y) Y IS OUTPUT Y ADD =1,X INC INPUT X EXCH X,SAVX(Y) X IS OUTPUT X CLSN A,=NL IS IT NEWLINE? JMP ISNL YES: OUTPUT THE BUFFER CLSN A,=CR IS IT CARRIAGE RETURN? JMP ISNL CR ALSO TERMINATES CLSN A,=FF IS IT FORM-FEED? JMP ISNL FORM FEED ALSO TERMINATES EXCH Q,Y SBIT 2,S COPYB A,0(X,Y) OUTPUT CHARACTER RBIT 2,S EXCH Q,Y ADD =1,X INC OUTPUT X CLSN X,=CHBUFLEN-3 IS IT (CHBUFLEN-3)TH CHARACTER? JMP FORCENL YES: FORCE THE NEWLINE ENLP EXCH Q,TADR(Y) Y IS INPUT Y IMS COUNT(Y) INC COUNT, SKIP IF DONE JMP CNZRO LOOP TILL DONE JMP NEXTOK NOW EXIT AND REPLACE SCB COUNT TITL * * HERE DEALING WITH END OF BUFFER * FORCENL COPY =NL,A FORCE A NEWLINE HERE ISNL COPY X,IOBYTES(Y) # BYTES COPY Q,IOBUF(Y) BUFFER ADDRESS EXCH Q,Y SBIT 2,S COPYB A,0(X,Y) OUTPUT NEWLINE IN CASE DISK I/O RBIT 2,S EXCH Q,Y  COPY SCB(Y),X SCB ADDRESS COPY SCB:FLW(X),A GET SCB FLAG WORD COPY =WRFA,Q WRITE, FORMATTED ASCII CLSN A,=DISKB: SKIP IF NOT DISK I/O JMP BUFDISK HERE ITS A BUFFERED DISK BACKIN COPY Q,FC(Y) FUNCTION CODE JSK TXLT TRANSLATE BUFFER? JSK DOWRITE DO THE WRITE OPERATION JNE A,IOERWBDV JUMP IF I/O ERROR COPY IOBUF(Y),Q RESTORE Q FOR LOOP RE-ENTRY COPY =0,X RE-FILLS BUFFER JMP ENLP AND RE-ENTER LOOP BUFDISK IMS IOBYTES(Y) INC NUMBER OF BYTES TO XFER (ADDS NEWLINE) COPY =WDIRS,Q WRITE, DIRECT STREAM IN Q NOW JMP BACKIN RE-ENTER MAIN CODE IOERWBDV COPY COUNT(Y),A - BYTES LEFT ADD NBYTES(Y),A BYTES TRANSFERRED COPY A,*RBCADR(Y) RETURN BYTES TRANSFERRED COPY IOSTAT(Y),A GET ERROR STATUS JMP ERRWR0 AND RETURN IT NEXTOK COPY X,A GET X IN A COPY SCB(Y),X GET SCB ADDRESS COPY A,SCB:CC(X) PUT COUNT BACK COPY COUNT(Y),A - BYTES LEFT ADD NBYTES(Y),A +BYTES GIVEN = BYTES TRANSFERRED COPY =0,Q REPLY (0 => OK) IN Q JMP EXTOK NOW EXIT OK * * END OF W R 0 EII FUNCTION * LPOOL ETITL DOWRITE * * DOWRITE -- AN INTERNAL FUNCTION TO PERFORM THE REQUIRED WRITE OPERATION. * THE CFI IS MODIFIED IF THE WRITE OPERATION ITSELF WOULD NO5 T ORDINARILY * MODIFY IT. RETURNS ERROR CODE IN A. THE CALLER MUST SET UP THE IOB. * DOWRITE I:IO SID(Y) DO THE I/O JMP CHKERR ERROR - CHECK WHY DEXOK COPY =0,Q REPLY FOR LATER DEXERR COPY SCB(Y),X SCB ADDRESS COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=CHDEV: SKIP IF NEED TO MOD THE CFI JMP DNOMCFI CH DEVICE - NO MOD TO CFI REQUIRED COPY SCB:CFI(X),X GET CFI ADDRESS IN X COPY 1(X),A GET CFI WORD 2 JT CY,$+1 ZERO CARRY FOR ADDC ADDC IOACT(Y),A ADD BYTES XFERRED, SET CARRY COPY A,1(X) STORE BACK CFI WORD 2 JF CY,$+2 SKIP INC IF NO CARRY IMS 0(X) INC TOP ADDRESS DNOMCFI COPY Q,A GET REPLY FOR RETURN RSK RETURN TO CALLER TITL * * NOW CHECK FOR WRITE DIRECT PAST EOF * CHKERR COPY IOSTAT(Y),A GET I/O STATUS AND =:7F,A GET RELEVANT PART OF STATUS CSK A,=WDEOF: IS IT WRITE DIRECT PASSES EOF? JMP DIOERR HERE I:IO ERROR JMP DIOERR AND HERE TOO COPY =POSWAB,A WP POSITION, ABS BYTE, DON'T CALL DOIO COPY A,FC(Y) UPDATE FUNCTION I:IO SID(Y) POSITION TO CGI/CFI JMP MBIOERR HERE MAY BE ERROR TRYWRT COPY =WFORMS,A WRITE,FORMATTED STREAM, DON'T CALL DOIO COPY A,FC(Y) UPDATE FUNCTION I:IO SID(Y) AND WRITE (UPDATES CGI/CFI) JMP DIOERR HERE I/O ERROR JMP DEXOK HERE EXIT OK DIOERR COPY IOSTAT(Y),Q GET I/O STATUS JMP DEXERR AND REPLY WITH IT MBIOERR COPY IOSTAT(Y),Q GET I/O STATUS COPY Q,*REPLY(Y) STORE IN CASE OF ERROR LATER CLSN Q,=EOF: IS IT EOF? JMP $+2 YES: THEN WE NEED TO CHECK THE CFI JMP DEXERR HERE JUST I/O ERROR COPY =RWP,A POSITION, READ WRITE PTR, DON'T CALL DOIO COPY A,FC(Y) UPDATE FUNCTION COPY Y,A ADD =RCFI,A ADDRESS TO RETURN CFI IN A COPY A,CGI(Y) STORE IN IOB I:IO SID(Y) READ THE WRITE POINTER JMP DIOERR HERE I/O ERROR ON READING WRITE POINTER COPY SCB(Y),X GET SCB ADDRESS COPY SCB:CFI(X),X ADDRESS OF USER'S CFI COPY X,CGI(Y) RESET CFI COPY RCFI(Y),A GET RETURNED CFI WORD 1 SUB 0(X),A SUBTRACT USER'S CFI WORD 1 JNE A,WASIOERR JUMP IF WAS I/O ERROR COPY RCFI+1(Y),A GET RETURNED CFI WORD 2 SUB 1(X),A SUBTRACT USER'S CFI WORD 2 JEQ A,TRYWRT THE'RE THE SAME, SO TRY THE WRITE WASIOERR COPY *REPLY(Y),Q GET OLD ERROR REPLY BACK JMP DEXERR AND REPLY WITH IT LPOOL ETITL TXLT * * TXLT -- A ROUTINE TO TRANSLATE THE OUTPUT BUFFER ACCORDING TO THE * DATA MODE. THE LINE IS TERMINATED BY NEWLINE, CR OR FORM FEED. * TXLT COPY SCB(Y),X SCB ADDRESS COPY SCB:DTP(X),A GET THE DATA TYPE CLSN A,=I2A: IS IT ISO TO ASCII? JMP DI2A YES: DO TRANSLATION CLSN A,=A2I: IS IT ASCII TO ISO? JMP DA2I YES: DO TRANSLATION RSK NO: I2I AND A2A ARE NULL TRANSLATIONS * * TRANSLATE ISO TO ASCII * DI2A COPY SCB:ELT(X),A CURRENT END-LINE TERMINATOR COPY A,ELT(Y) STORE FOR USE INSIDE COPY IOBYTES(Y),X X IS BYTE INDEX IMS IOBYTES(Y) THERE WILL BE ONE MORE COPY IOBUF(Y),Q Q IS WORD ADDRESS OF BUFFER EXCH Q,Y Y=BASE ADDRESS, SAVE Y IN Q COPY =NL,A NEWLINE IN A SBIT 2,S BYTE MODE EXCHB 0(Y,X),A GET TERMINATING CHARACTER, STORE NEWLINE RBIT 2,S WORD MODE EXCH Q,Y Q= BASE ADDRESS, RESTORE Y EXCH A,ELT(Y) REMEMBER TERMINATOR, GET LAST ONE COPY A,IOACT(Y) SAVE TEMPORARILY IN IOACT JEQ X,ZBUFI2A JUMP IF ZERO BUFFER ON I2A EXCH Q,Y Y=BASE ADDRESS, SAVE Y IN Q SBIT 2,S BYTE MODE I2ALP COPYB 0(Y,X),A MOVE BYTE ... COPYB A,1(Y,X) ... ONE PLACE UP THE BUFFER JNED X,I2ALP LOOP, DECREMENTING X TILL DONE RBIT 2,S WORD MODE EXCH Q,Y Q=BASE ADDRESS, RESTORE Y6  ZBUFI2A EXCH IOACT(Y),A SAVE LAST CHAR IN IOACT, GET TERMINATOR CLSN A,=FF FORM FEED? COPY ='1',A YES: TRANSLATE TO '1' CLSN A,=CR CARRIAGE RETURN? COPY ='+',A YES: TRANSLATE TO '+' CLSN A,=NL NEWLINE? COPY =' ',A YES: TRANSLATE TO SPACE SHIFT A,LO,8 GET IN UPPER BYTE OR IOACT(Y),A GET LAST TWO CHARS COPY Q,X SET UP X TO STORE FIRST WORD COPY A,0(X) STORE FIRST WORD OF BUFFER COPY SCB(Y),X SCB IN X COPY ELT(Y),A REMEMBER THIS TERMINATOR ... COPY A,SCB:ELT(X) ... IN THE SCB SLOT RSK AND RETURN TO CALLER * * TRANSLATE ASCII TO ISO * DA2I COPY IOBYTES(Y),X # OF BYTES SUB =1,X THERE WILL BE ONE LESS (UNLESS 0) COPY X,IOBYTES(Y) UPDATE IOBYTES COPY IOBUF(Y),Q Q IS WORD ADDRESS OF BUFFER EXCH Q,Y Y=BASE ADDRESS, SAVE Y IN Q SBIT 2,S BYTE MODE  COPYB 0(Y),A FIRST BYTE RBIT 2,S WORD MODE CLSN A,='1' IS IT '1'? COPY =FF,A REPLACE '1' BY FORM FEED CLSN A,='+' IS IT '+'? COPY =CR,A REPLACE '+' BY CARRIAGE RETURN CLSN A,='0' IS IT '0'? JMP IS0 YES: NEED TWO NEWLINES COPY =NL,A SO ASSUME ITS A SPACE SBIT 2,S COPYB A,0(Y) STORE UPDATED FIRST BYTE RBIT 2,S WORD MODE COPY Q,Y RESTORE Y RSK AND RETURN TO CALLER * * HERE WE NEED TWO NEWLINES, WE MUST SHUFFLE THE BUFFER UP * IS0 SBIT 2,S BYTE MODE A2ILP COPYB 0(Y,X),A MOVE BYTE ... COPYB A,1(Y,X) ... ONE PLACE UP THE BUFFER JNED X,A2ILP LOOP, DECREMENTING X TILL DONE RBIT 2,S WORD MODE COPY =:0A0A,A TWO NEWLINES COPY A,0(Y) PUT THEM IN THE BUFFER COPY Q,Y RESTORE Y IMS IOBYTES(Y) NOW REPLACE IOBYTES! RSK AND RETURN TO CALLER END ETITL6 C:RD0 * * SETS FOR C:RD0 * SIDX EQU 0 SID ADDRESS BADRX EQU SIDX+1 BUFFER ADDRESS NBYTESX EQU SIDX+2 BYTES TO TRANSFER RBCADRX EQU SIDX+3 ADDRESS TO RETURN THE NUMBER OF BYTES XFERRED REPLYX EQU SIDX+4 ADDRESS TO STORE REPLY BADR EQU 2 BUFFER ADDRESS NBYTES EQU BADR+1 BYTES TO TRANSFER RBCADR EQU BADR+2 ADDRESS TO RETURN THE NUMBER OF BYTES TRANSFERRED REPLY EQU BADR+3 ADDRESS TO STORE REPLY SCB EQU REPLY+1 ADDRESS OF STREAM CONTROL BLOCK COUNT EQU SCB+1 INTERNAL COUNTER FOR LOOP SAVX EQU COUNT+1 X SAVED HERE INSIDE LOOP TADR EQU SAVX+1 TRANSFER ADDRESS SAVED HERE INSIDE LOOP IPCNT EQU TADR+1 INPUT COUNT SID EQU IPCNT+1 SID STORED HERE, XFER BLOCK STARTS HERE ... FC EQU SID+IO:FC CGI EQU SID+IO:CRI IOBYTES EQU SID+IO:BCT IOBUF EQU SID+IO:BUF IOACT EQU SID+IO:ACT IOSTAT EQU SID+IO:ST ... AND ENDS HERE * NL EQU :A ASCII NEWLINE FF EQU :C ASCII FORM FEED CR EQU :D ASCII CARRIAGE RETURN WPROMPT EQU WR:%4+WP:+ER:V RFORMS EQU RE:%4+FS:+ER:V RFORMA EQU RE:%4+FA: RUF EQU RE:%4+UF: READ, UNFORMATTED ENDSTK EQU IOSTAT END OF STACK MARKER ETITL C:RD0 ************************************************************************ *  * * E I I S E R V I C E --- C : R D 0 --- * *  * ************************************************************************ NAM C:RD0 EXTR C:CKOPEN,C:WP,C:WPL C:RD0 ENT:EII ENDSTK COPY BADRX(X),Q GET BUFFER ADDRESS COPY Q,BADR(Y) SAVE BUFFER ADDRESS COPY NBYTESX(X),A GET # BYTES COPY A,NBYTES(Y) SAVE FOR LATER COPY RBCADRX(X),A GET RETURN BYTE CT ADDRESS COPY A,RBCADR(Y) AND PRESERVE COPY REPLYX(X),A GET REPLY ADDRESS COPY A,REPLY(Y) AND PRESERVE COPY =0,Q COPY Q,*RBCADR(Y) SA7 Y 0 BYTES TRANSFERRED FOR NOW! COPY SIDX(X),X GET SID ADDRESS JSK C:CKOPEN CHECK OPEN SID ETC COPY Q,SCB(Y) SAVE RETURNED SCB JNE A,ERRRD0 IF NOT 0 ERROR COPY Q,X GET SCB ADDRESS IN X COPY SCB:LUN(X),A LUN/SID COPY A,SID(Y) SAVE FOR I:IO CALL COPY =0,A COPY A,SID+1(Y) ZERO RESERVED WORD OF IOB COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=CHDEV: SKIP IF NOT A CHARACTER DEVICE JMP RCHDEV HERE CHAR DEVICE COPY =RFORMS,A READ, FORMATTED STREAM, DON'T CALL DOIO DOTRN COPY A,FC(Y) STORE IN FUNCTION CODE OF IOB COPY NBYTES(Y),A COPY A,IOBYTES(Y) # BYTES TO XFER IN IOB COPY BADR(Y),A COPY A,IOBUF(Y) IO BUF ADDRESS IN IOB COPY SCB:CFI(X),X ADDRESS CGI/CFI IN X COPY X,CGI(Y) I:IO SID(Y) DO INPUT JMP RSTATUS ERROR - RETURN STATUS COPY IOACT(Y),A EXTOK COPY A,*RBCADR(Y) REPLY WITH # BYTES XFERD COPY =0,A 0 => DONE OK ERRRD0 COPY A,*REPLY(Y) RETURN REPLY RET:EII . RETURN WITH CODE LPOOL TITL * * HERE WE HAVE A CHARACTER DEVICE * RCHDEV COPY SCB:DTP(X),A DATA TYPE CLSN A,=UFM: IS IT UNFORMATTED? JMP RDUF YES: STRAIGHT TRANSFER REQUIRED COPY SCB:IOM(X),A GET I/O MARKER CLSN A,=CREAD: IS IT READ? JMP ISREAD YES: OK COPY SCB:CC(X),A NO: GET CHAR COUNT JEQ A,SWTOREAD IF 0 CHARS CAN SWITCH TO INPUT (USUAL EII PROMPT) COPY SCB:CHB(X),Q ADDRESS CHAR BUFFER IN Q COPY Q,IOBUF(Y) IS I/O BUFFER COPY A,X BYTE INDEX IN X ADD =1,A COUNT NOW INCLUDES CC CHAR COPY A,IOBYTES(Y) NUMBER OF BYTES TO PROMPT WITH EXCH Q,Y SAVE Y IN Q, GET BUFFER ADDRESS IN Y SBIT 2,S BYTE MODE NOW MOVLP COPYB 0(Y,X),A MOVE BYTE ... COPYB A,1(Y,X) ... ONE PLACE UP THE BUFFER JNED X,MOVLP LOOP, DECREMENTING X TILL DONE COPY =0,A ZERO THE ... COPYB A,0(Y) ... FIRST BYTE FOR THE OR BELOW RBIT 2,S WORD MODE EXCH Y,Q RESTORE Y, GET BUFFER ADDRESS IN Q COPY SCB(Y),X RESTORE SCB ADDRESS TO X COPY SCB:ELT(X),A GET THE CC CHARACTER CLSN A,=FF FORM FEED? COPY ='1',A YES: TRANSLATE TO '1' CLSN A,=CR CARRIAGE RETURN? COPY ='+',A YES: TRANSLATE TO '+' CLSN A,=NL NEWLINE? COPY =' ',A YES: TRANSLATE TO SPACE SHIFT A,LO,8 GET IN UPPER BYTE EXCH Q,X SCB ADDRESS IN Q, BUF ADDRESS IN X OR 0(X),A MAKE NEW FIRST WORD COPY A,0(X) STORE IN BUFFER COPY Q,X RESTORE SCB ADDRESS COPY =WPROMPT,A WRITE, WRITE PROMPT, DON'T CALL DOIO COPY A,FC(Y) STORE AS FUNCTION CODE I:IO SID(Y) WRITE PROMPT NOP IGNORE WRITE PROMPT ERRORS COPY NBYTES(Y),A EEXTOK JEQ A,EXTOK HERE READ DONE! (READ 0 CHARS) NEG A,A COPY A,COUNT(Y) -VE COUNT SET UP COPY SCB:CC(X),A COPY A,IPCNT(Y) INPUT COUNT SET UP COPY SCB:CHB(X),Q ADDRESS INPUT CHAR BUFFER IN Q COPY BADR(Y),A COPY A,TADR(Y) OUTPUT CHARACTER BUFFER COPY =0,A COPY A,SAVX(Y) OUTPUT CHARACTER INDEX COPY =CREAD:,A COPY A,SCB:IOM(X) UPDATE MODE FLAG = READ COPY SCB:CBP(X),X X IS INPUT CHARACTER INDEX JMP DUNWP NOW ENTER THE LOOP (WE'VE DONE THE WRITE PROMPT) RDUF COPY =RUF,A READ, UNFORMATTED JMP DOTRN NOW DO THE TRANSFER SWTOREAD COPY =CREAD:,A COPY A,SCB:IOM(X) UPDATE MODE FLAG = READ ISREAD COPY NBYTES(Y),A JEQ A,EEXTOK HERE READ DONE! (READ 0 CHARS) NEG A,A COPY A,COUNT(Y) -VE COUNT SET UP COPY SCB:CC(X),A COPY A,IPCNT(Y) INPUT COUNT SET UP COPY SCB:CHB(X),Q ADDRESS INPUT CHAR BUFFER IN Q COPY BADR(Y),A COPY A,TADR(Y) OUTPUT CHARACTER BUFFER COPY =0,A COPY A,SAVX(Y) OUTPUT CHARACTER INDEX COPY SCB:CBP(X),X X IS INPUT CHARACTER INDEX R8 CLOOP JNE X,CNZRO COUNT NONZERO => CHARS ALREADY THERE COPY =WPROMPT,A WRITE, WRITE PROMPT, DON'T CALL DOIO COPY A,FC(Y) STORE AS FUNCTION CODE COPY =C:WP,A WRITE PROMPT MESSAGE COPY A,IOBUF(Y) IS I/O BUFFER COPY C:WPL,A COPY A,IOBYTES(Y) NUMBER OF BYTES TO PROMPT WITH I:IO SID(Y) WRITE PROMPT NOP IGNORE WRITE PROMPT ERRORS DUNWP COPY =RFORMA,A READ, FORMATTED ASCII, DON'T CALL DOIO COPY A,FC(Y) STORE AS FUNCTION CODE COPY Q,IOBUF(Y) I/O BUFFER COPY =CHBUFLEN-3,A COPY A,IOBYTES(Y) MAX INPUT BYTES=CHBUFLEN-3 I:IO SID(Y) INPUT INFORMATION JMP RDERR HERE A READ ERROR COPY IOACT(Y),X GET ACTUAL BYTES TRANSFERRED COPY =NL,A NEWLINE CHARACTER EXCH Q,Y SBIT 2,S COPYB A,0(X,Y) BUNG IN THE END OF THE BUFFER RBIT 2,S EXCH Q,Y ADD =1,X ADD ONE FOR NEWLINE NEG X,A GET -VE COUNT IN A COPY A,IPCNT(Y) SAVE FOR LATER COPY =0,X INPUT INDEX TO BEGINING OF BUFFER CNZRO EXCH Q,Y SBIT 2,S COPYB 0(X,Y),A GET NEXT CHARACTER RBIT 2,S EXCH Q,Y ADD =1,X INC INPUT BUFFER INDEX EXCH X,SAVX(Y) X IS OUTPUT INDEX EXCH Q,TADR(Y) Q HOLDS OUTPUT Y EXCH Q,Y SBIT 2,S COPYB A,0(X,Y) PUT CHARACTER IN USER BUFFER RBIT 2,S EXCH Q,Y ADD =1,X INC OUTPUT BUFFER INDEX EXCH X,SAVX(Y) X IS INPUT INDEX EXCH Q,TADR(Y) Q HOLDS INPUT Y IMS IPCNT(Y) END OF INPUT COUNT JMP CONT NO: CONTINUE COPY =0,X ZERO INDEX NOW IMS COUNT(Y) INC COUNT ANYWAY! NOP JUST IN CASE IT SKIPS JMP $+3 MAKE END-OF-LINE TERMINATE C:RD0 CONT IMS COUNT(Y) INC USER COUNT JMP RCLOOP LOOP, CHECKING X COPY =0,Q REPLY FOR LATER, 0=> ALL OK EXLOOP COPY X,A SAVE X IN A COPY SCB(Y),X SCB ADDRESS IN X COPY A,SCB:CBP(X) SAVE BUFFER INDEX COPY IPCNT(Y),A CURRENT INPUT COUNT  COPY A,SCB:CC(X) SAVE CURRENT CHAR COUNT COPY COUNT(Y),A - COUNT REMAINING ADD NBYTES(Y),A +ORIGINAL COUNT = BYTES XFERRED COPY A,*RBCADR(Y) RETURN BYTES TRANSFERRED COPY Q,A GET SAVED REPLY JMP ERRRD0 AND EXIT RDERR COPY IOSTAT(Y),Q GET STATUS FOR REPLY JMP EXLOOP AND EXIT FROM LOOP RSTATUS COPY IOACT(Y),A COPY A,*RBCADR(Y) REPLY WITH BYTES XFERRED COPY IOSTAT(Y),A GET ERROR STATUS JMP ERRRD0 AND REPLY WITH THAT * * END OF R D 0 EII FUNCTION * LPOOL END ETITL6 C:WP,C:WPL NAM C:WP,C:WPL C:WP BYTE ' ' C:WPL WORD $-C:WP*2 END ETITL6 C:RDCOM0 MADRX EQU 0 MEMORY ADDRESS ALENX EQU MADRX+1 ADDRESS TO STORE LENGTH REPLYX EQU ALENX+1 ADDRESS TO STORE REPLY MADR EQU 2 MEMORY ADDRESS ALENGTH EQU MADR+1 ADDRESS TO STORE LENGTH REPLY EQU ALENGTH+1 ADDRESS TO STORE REPLY CUBYTE EQU REPLY+1 SID EQU CUBYTE+1 FC EQU SID+IO:FC CGI EQU SID+IO:CRI IOBYTES EQU SID+IO:BCT IOBUF EQU SID+IO:BUF IOACT EQU SID+IO:ACT IOSTAT EQU SID+IO:ST SYMBL EQU IOSTAT+1 ENDSTK EQU SYMBL+ISMLN: WPROMPT EQU WR:%4+WP:+ER:V * * PRESET LOCATION TO INDICATE IF WE NEED TO READ THE COMMAND LINE * SHARABLE TABLE: TABLE: REL FIRSTIME WORD -1 IMS WILL SKIP FIRST TIME ROUND (FAILS AFTER 65535 LINES) EII: REL ETITL C:RDCOM0 ************************************************************************ * * * E I I S E R V I C E --- C : R D C O M 0 --- * * * ************************************************************************ * * C:RDCOM0 - READS A COMMAND LINE USING E:ICH * NAM C:RDCOM0 EXTR C:WPC,9 C:WPCL C:RDCOM0 ENT:EII ENDSTK COPY MADRX(X),A FETCH AND SAVE... COPY A,MADR(Y) COPY ALENX(X),A COPY A,ALENGTH(Y) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS * * NOW DO INITIALISATION * IMS FIRSTIME DO WE NEED TO READ THE COMMAND LINE? JMP RDCOM YES: READ IT RDCOMBAK COPY =0,A COPY A,CUBYTE(Y) INITIAL BYTE # IS 0 COPY Y,X ADD =SYMBL,X ADDRESS OF SYMBOL BLOCK COPY A,ISMBP:(X) ZERO THE BUFFER POINTER COPY A,ISMUB:(X) ZERO USER BUFFER (SAYS USE SYSTEM ONE) * * NOW LOOP, READING AND STORING CHARS. * NXCH E:ICH SYMBL(Y) INPUT THE CHARACTER CLSN A,=0 IS CHARACTER 0 (END BUFFER)? COPY =:0A,A YES: MAKE IT A NEWLINE  COPY CUBYTE(Y),X GET INDEX TO STORE BYTE IMS CUBYTE(Y) AND INCREMENT IT COPY MADR(Y),Q MEMORY ADDRESS IN Q EXCH Q,Y MEMORY ADDRESS IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB A,0(Y,X) STORE BYTE IN MEMORY RBIT 2,S WORD MODE COPY Q,Y RESTORE Y CLSN A,=:0A WAS IT A NEWLINE? JMP $+2 YES: END OF LOOP JMP NXCH NO: LOOP * * HERE END OF BUFFER * COPY CUBYTE(Y),X BYTE INDEX COPY X,*ALENGTH(Y) STORE FOR USER COPY =0,A 0 => GOOD REPLY! ERROR COPY A,*REPLY(Y) STORE REPLY FOR USER RET:EII * * HERE NEED TO READ THE COMMAND LINE * RDCOM COPY ACTSID,A ADDRESS OF SID COPY A,SID(Y) SET UP 'CI' FOR PROMPT COPY =WPROMPT,A WRITE, WRITE PROMPT, DON'T CALL DOIO COPY A,FC(Y) STORE AS FUNCTION CODE COPY =C:WPC,A WRITE PROMPT MESSAGE COPY A,IOBUF(Y) IS I/O BUFFER COPY C:WPCL,A COPY A,IOBYTES(Y) NUMBER OF BYTES TO PROMPT WITH I:IO SID(Y) WRITE PROMPT NOP IGNORE ERRORS E:RCI JNE A,ERROR ERROR IF NOT ZERO JMP RDCOMBAK JUMP BACK INTO THE MAIN CODE * * THE SID LIES HERE * ACTSID BYTE 'CI' END ETITL6 C:WPC,C:WPCL NAM C:WPC,C:WPCL C:WPC BYTE ' EII..' C:WPCL WORD $-C:WPC*2 END * IMS FIRSTIME DO WE NEED TO READ THE COMMAND LINE? JMP ETITL7 C:REOF0 * * EQUATES FOR C:REOF0 * SIDX EQU 0 ARHFBAX EQU 1 REPLYX EQU 2 REPLY EQU 2 SID EQU 3 FC EQU SID+IO:FC ARHFBA EQU SID+IO:CRI IOSTAT EQU SID+IO:ST GETWAB EQU PO:%4+RWP:+ER:V ETITL C:REOF0 ************************************************************************ * * * E I I S E R V I C E  --- C : R E O F 0 --- * * * ************************************************************************ NAM C:REOF0 EXTR C:CKOPEN C:REOF0 ENT:EII :9 COPY ARHFBAX(X),A GET ADDRESS TO STORE HIGH FBA COPY A,ARHFBA(Y) STORE FOR LATER COPY REPLYX(X),Q GET REPLY ADDRESS COPY Q,REPLY(Y) SAVE ADDRESS FOR REPLY COPY SIDX(X),X GET SID ADDRESS IN X JSK C:CKOPEN CHECK OPEN SID ETC JNE A,ERRRF0 IF NOT 0 ERROR COPY Q,X GET SCB ADDRESS COPY SCB:FLW(X),A GET FLAG WORD CLSN A,=CHDEV: SKIP IF NOT A CHARACTER DEVICE JMP ISCHDEV HERE A CHARACTER DEVICE COPY SCB:LUN(X),A LUN/SID COPY A,SID(Y) SAVE FOR I:IO CALL COPY =0,A COPY A,SID+1(Y) ZERO RESERVED WORD OF IOB COPY =GETWAB,A GET WRITE POINTER, DON'T CALL DOIO COPY A,FC(Y) SET FUNCTION I:IO SID(Y) TRUNCATE FILE JMP ERRIIO HERE ERROR! COPY =0,A 0 => ALL OK! ERRRF0 COPY A,*REPLY(Y) RETURN REPLY RET:EII . RETURN, REPLY IN A ISCHDEV COPY =0,A OK REPLY COPY A,*ARHFBA(Y) ZERO WORD ONE AND ... IMS ARHFBA(Y) COPY A,*ARHFBA(Y) ... AND WORD TWO OF HIGH FBA JMP ERRRF0 SUCCESSFUL RETURN ERRIIO COPY IOSTAT(Y),: A GET REPLY STATUS JMP ERRRF0 ERROR EXIT END ETITL7 C:WEOF0 * * SETS FOR C:WEOF0 * SIDX EQU 0 REPLY EQU 2 REPLYX EQU 1 SID EQU 3 FC EQU SID+IO:FC CGI EQU SID+IO:CRI IOSTAT EQU SID+IO:ST POSWAB EQU PO:%4+WAB:+ER:V ETITL C:WEOF0 ************************************************************************ * * *  E I I S E R V I C E --- C : W E O F 0 --- * *  * ************************************************************************ NAM C:WEOF0 EXTR C:CKOPEN C:WEOF0 ENT:EII :9 COPY REPLYX(X),Q GET REPLY ADDRESS COPY Q,REPLY(Y) SAVE ADDRESS FOR REPLY COPY SIDX(X),X GET SID ADDRESS IN X JSK C:CKOPEN CHECK OPEN SID ETC JNE A,ERRWF0 IF NOT 0 ERROR COPY Q,X GET SCB ADDRESS COPY SCB:FLW(X),A GET FLAG WORD CLSN A,=CHDEV: SKIP IF NOT A CHARACTER DEVICE JMP NORMEX JUST EXIT IF A CHARACTER DEVICE COPY SCB:LUN(X),A LUN/SID COPY A,SID(Y) SAVE FOR I:IO CALL ADD =SCB:CG1,X ADDRESS CGI/CFI IN X COPY X,CGI(Y) PUT IN IOB COPY =0,A COPY A,SID+1(Y) ZERO RESERVED WORD OF IOB COPY =POSWAB,A POSITION WP ABS BYTES, DON'T CALL DOIO COPY A,FC(Y) SET FUNCTION I:IO SID(Y) TRUNCATE FILE JMP ERRIIO HERE ERROR! NORMEX COPY =0,A 0 => ALL OK! ERRWF0 COPY A,*REPLY(Y) RETURN REPLY RET:EII . RETURN, REPLY IN A ERRIIO COPY IOSTAT(Y),A GET REPLY STATUS JMP ERRWF0 ERROR EXIT END ETITL7 C:CKOPEN * * EQUATES * SID EQU 2 * * C:CKOPEN - TAKES AN SID ADDRESS AND AN OUTPUT ADDRESS AND STORES THERE * THE SCB ADDRESS (IF ANY) CORRESPONDING TO THE QUOTED SID. * RETURNS A RESULT CODE IN A. * NAM C:CKOPEN EXTR C:SCBCH,C:INIT C:CKOPEN ENT:EII :1 COPY X,SID(Y) HOLDS SID ADDRESS JSK C:INIT INITIALIZE, IF NECESSARY COPY C:SCBCH,X ADDRESS FIRST SCB LP JNE X,$+3 JUMP IF NOT END-OF-CHAIN COPY =-2,A -2 => SID NOT FOUND JMP EXCKOPEN ERROR EXIT COPY SCB:LUN(X),A GET LUN (SID) CSK A,*SID(Y) EQUAL TO GIVEN SID? JMP $+3 NO JMP $+2 NO JMP FNDSCB HERE FOUND RIGHT SCB COPY SCB:CHN(X),X TO NEXT SCB JMP LP AND LOOP FNDSCB COPY SCB:FLW(X),A GET FLAGWORD CLSN A,=UNUSED: SKIP IF OK JMP NOTOPEN HERE NOT OPEN COPY X,Q RETURN SCB ADDRESS IN Q COPY =0,A MEANS ALL OK EXCKOPEN RET:EII . EXIT NOTOPEN COPY =-7,A -7 => SID NOT OPENED RET:EII END ETITL7 C:MOVBTS **************************************************************************** * THESE EQUATES MUST BE DEFINED TO THE SAME VALUES IN THE CALLING ROUTINE * **************************************************************************** COUNT EQU 2 COUNT OF BYTES TO MOVE ADRIN EQU COUNT+1 ADDRESS OF INPUT BLOCK ADROUT EQU ADRIN+1 ADDRESS OF OUTPUT BLOCK NAM C:MOVBTS ETITL C:MOVBTS * * THIS ROUTINE MOVES BYTES FROM ONE AREA (ADDRESS PREVIOUSLY STORED IN * ADRIN) TO ANOTHER AREA (ADDRESS PREVIOUSLY STORED IN ADROUT). THE COUNT * OF BYTES TO MOVE IS EXPECTED IN A, THE INPUT BYTE INDEX IS EXPECTED IN * X, THE OUTPUT BYTE INDEX IS EXPECTED IN Q. THE UPDATED INPUT AND OUTPUT * BYTE INDICES ARE LEFT IN X AND Q RESPECTIVELY ON EXIT. COUNT WILL BE * CORRUPTED, BUT ADRIN AND ADROUT WILL BE UNCHANGED. * C:MOVBTS JNE A,$+2 IS COUNT 0 (NULL TRANSFER)? RSK YES: JUST EXIT NEG A,A COPY A,COUNT(Y) -VE COUNT FOR IMS EXCH Q,ADRIN(Y) INDEX OUT IN ADRIN, ADDRESS IN IN Q LOOP EXCH Q,Y A; DDRESS IN IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB 0(Y,X),A GET INPUT BYTE RBIT 2,S WORD MODE EXCH Q,Y RESTORE Y, ADDRESS IN IN Q ADD =1,X INCREMENT INDEX IN EXCH X,ADRIN(Y) INDEX OUT IN X, INDEX IN IN ADRIN EXCH Q,ADROUT(Y) ADDRESS OUT IN Q, ADDRESS IN IN ADROUT EXCH Q,Y ADDRESS OUT IN Y, SAVE Y IN Q SBIT 2,S BYTE MODE COPYB A,0(Y,X) STORE BYTE IN OUTPUT RBIT 2,S WORD MODE EXCH Q,Y RESTORE Y, ADDRESS OUT IN Q ADD =1,X INCREMENT INDEX OUT EXCH X,ADRIN(Y) INDEX IN IN X, INDEX OUT IN ADRIN EXCH Q,ADROUT(Y) ADDRESS IN IN Q, ADDRESS OUT IN ADROUT IMS COUNT(Y) INC COUNT, SKIP IF MOVED ALL JMP LOOP EXCH Q,ADRIN(Y) ADDRESS IN IN ADRIN, INDEX OUT IN Q RSK RETURN TO CALLER END G ROUTINE * ********************************************************* ETITL8 C:ENTER,C:RETURN NAM C:ENTER,C:RETURN LOAD C:INIT * * COMMON SERVICE ENTRY AND EXIT SUBROUTINES * C:ENTER EQU $ COPY Y,Q SAVE Y COPY K,A AND OLD K COPY K,Y STACK POINTER COPY *0(Y),Y Y=STACK SPACE REQUESTED * ENTER10 EQU $ PUSH :40 ALLOCATE 6 WORDS SUB =6,Y JGT Y,ENTER10 LOOP UNTIL ENOUGH COPY K,Y NEW STACK TOP COPY A,OLDK+1(Y) SAVE OLD K IMS OLDK+1(Y) ADJUST FOR REAL OLD K COPY Q,OLDY+1(Y) AND ORIGINAL Y COPY A,Y COPY 0(Y),A RETURN ADDRESS ADD =1,A JUMP AROUND PARAMETER COPY K,Y COPY A,0(Y) SET UP EXIT ADD =1,Y REAL Y RSK AND EXIT * C:RETURN EQU $ COPY OLDK(Y),X OLD K COPY OLDY(Y),Y RESTORE Y COPY X,K RESTORE STACK RSK RETURN TO CALLER TITL OBJECT REVISION NOTE REVNOTE END ETITL8 C:INIT CUCIB EQU 2 CUDIB EQU CUCIB+1 COUNT EQU CUCIB (COMMON WITH CUCIB) CUENT EQU CUDIB (COMMON WITH CUDIB) CUUAT EQU CUDIB+1 USERID EQU CUUAT+1 ENDSTK EQU USERID NL EQU :A NEWLINE EXUAT EQU 1 CI:PER EQU 0 CI:DIB EQU 3 OPENMASK EQU 1%FCF:OP ETITL C:INIT NAM C:INIT EXTR C:DIBCH,C:CIBHD,E:UAT,C:SCBCH,C:GTMEMX,C:INITFS EXTR E:CIFP,E:SLFP * C:INIT COPY C:SCBCH,A GET SCB CHAIN HEAD JEQ A,$+3 JUMP IF NEED INITIALIZATION COPY =0,A 0 => ALL OK! RSK RETURN OK ENT:EII ENDSTK JSK C:INITFS INITIALIZE FREE SPACE? * * FIRST WE CREATE DIB CHAIN * COPY =0,A COPY A,C:DIBCH DIB CHAIN TERMINATOR COPY C:CIBHD,X ADDRESS OF ADDRESS OF FIRST CIB IN X CIBLP COPY CI:PER(X),X X HOLDS ADDRESS OF CIB JEQ X,NMCIBS JUMP IF NO MORE CIBS COPY X,CUCIB(Y) SAVE CU CIB ADDRESS COPY CI:DIB(X),X GET FIRST DIB ADDRESS IN X DIBLP JEQ X,NMDIBS JUMP IF NO MORE DIBS COPY X,CUDIB(Y) SAVE CU DIB ADDRESS COPY =4,A FOUR WORDS REQUIRED JSK C:GTMEMX ALTERNATE GETMEM ENTRY JEQ A,FSPEMPTY HERE FREE SPACE EXHAUSTED COPY CUDIB(Y),X CURRENT DIB EXCH A,Y ** TEMPORARILY SWAP A AND Y COPY X,DBC:DIB(Y) ** DEPOSIT DIB ADDRESS COPY DI:NAM(X),Q ** MOVE ACROSS... COPY Q,DBC:NAM1(Y) ** COPY DI:NAM+1(X),Q ** COPY Q,DBC:NAM2(Y) ** ... DIB NAME COPY C:DIBCH,Q ** CURRENT DIB CHAIN ADDRESS COPY Q,DBC:CHN(Y) ** AND CHAIN WITH THIS ELEMENT  EXCH A,Y ** SWAP A AND Y BACK NOW! COPY A,C:DIBCH UPDATE DIB CHAIN COPY DI:PER(X),X GET NEXT DIB IN CHAIN JMP DIBLP AND LOOP ON DIBS NMDIBS COPY CUCIB(Y),X GET CU CIB BACK IN X JMP CIBLP AND LOOP ON CIBS FSPEMPTY COPY =-15,A -15 => FREE SPACE EXHAUSTED ERRINIT RET:EII TITL * * DIB CHAIN HAS NOW BEEN CREATED. * NEXT IS I/O INITIALIZATION (CREATES SCB CHAIN). * NMCIBS COPY E:UAT,X UAT ADDRESS COPY =0,Q COPY Q,C:SCBCH SCB CHAIN (NULL) SET UP NXTUAT COPY X,CUUAT(Y) SAVE UAT ADDRESS FOR LATER COPY 0(X< ),A # ENTRIES ADD =4,X X POINTS TO FIRST UAT ENTRY NEG A,A - # ENTRIES COPY A,COUNT(Y) SET COUNT FOR LOOPING COPY X,CUENT(Y) SAVE CURRENT ENTRY ADDRESS LP COPY CUENT(Y),X CURRENT UAT ENTRY COPY 0(X),A CURRENT LUN NAME CSK A,='ZB' IS IS 'ZB'? JMP $+3 NO JMP $+2 NO JMP PRMTERM YES, DON'T USE 'ZB' AND BEYOND COPY =SCB:LEN,A SCB:LEN WORDS PER ENTRY JSK C:GTMEMX ALTERNATE GETMEM ENTRY JEQ A,FSPEMPTY HERE FREE SPACE EXHAUSTED COPY C:SCBCH,Q GET SCB CHAIN COPY A,X CURRENT SCB BLOCK IN X COPY Q,SCB:CHN(X) CHAIN TO NEXT ONE COPY X,C:SCBCH AND STORE CHAIN BACK COPY =UNUSED:,A UNUSED MARKER COPY A,SCB:IOM(X) SAYS I/O MODE UNUSED COPY A,SCB:FLW(X) MARK SCB UNUSED COPY =0,A COPY A,SCB:USR(X) SAYS NO USER COPY A,SCB:CHB(X) SAYS NO CHARACTER BUFFER  COPY A,SCB:UID(X) SAYS NO UID REMEMBERED COPY A,SCB:CG1(X) ZERO CFI WORD ONE ... COPY A,SCB:CG1+1(X) ... AND TWO COPY A,SCB:CC(X) ZERO CHARACTER COUNT COPY A,SCB:CBP(X) ZERO CHARACTER BUFFER POINTER COPY =NL,A NEWLINE COPY A,SCB:ELT(X) IS DEFAULT END OF LINE TERMINATOR COPY X,A SCB ADDRESS ADD =SCB:CG1,A POINTER TO CFI WORD ONE COPY A,SCB:CFI(X) STORE AS CFI ADDRESS COPY CUENT(Y),X GET UAT ENTRY ADDRESS COPY R:ACT,A USER ID COPY A,USERID(Y) SAVE AS USER ID COPY 0(X),A LUN NAME COPY 1(X),Q DIB/FCB ADDRESS IN Q ADD =2,X X POINTS TO NEXT ENTRY COPY X,CUENT(Y) UPDATE UAT ENTRY ADDRESS COPY C:SCBCH,X CURRENT SCB ADDRESS COPY A,SCB:LUN(X) PUT LUN NAME IN SCB JEQ Q,CONLP IGNORE IF UNNASSIGNED CSK A,='ZP' IS IT ZP? JMP $+3 NO: CONTINUE JMP $+2 NO: CONTINUE JMP CONLP YES: DON'T OPEN ZP! CSK A,='CI' IS IT CI? JMP $+3 NO: CONTINUE JMP $+2 NO: CONTINUE JMP OPCI YES: OPEN AS A CHARACTER DEVICE CSK A,='OC' IS IT OC? JMP $+3 NO: CONTINUE JMP $+2 NO: CONTINUE JMP OPOC YES: OPEN AS A CHARACTER DEVICE CSK A,='SL' IS IT SL? JMP $+3 NO: CONTINUE JMP $+2 NO: CONTINUE JMP OPSL YES: OPEN AS A CHARACTER DEVICE COPY Q,X FCB/DIB ADDRESS IN X NOW COPY DI:FLG(X),Q GET FCB/DIB FLAGWORD JGT Q,CONLP JUMP IF A DIB (NO ACTION REQ'D!) AND =OPENMASK,Q GET 'FILE OPEN' BIT JNE Q,MKFILEOP JUMP IF NEED TO MARK FILE OPEN CONLP IMS COUNT(Y) INC COUNT, SKIP IF DONE JMP LP OTHERWISE LOOP COPY CUUAT(Y),X GET UAT ADDRESS IN X COPY EXUAT(X),X NEXT UAT ADDRESS JEQ X,$+2 SKIP IF NO UAT EXTENSION JMP NXTUAT NEXT UAT IF EXTENSION PRMTERM COPY =0,A 0 => ALL OK! JMP ERRINIT SUCCESSFUL RETURN * LPOOL TITL * * HERE NEED TO OPEN CI, OC OR SL AS A CHARACTER DEVICE * OPCI COPY E:CIFP,A GET CI FILE POINTER JMP $+2 SKIP INTO COMMON LOOP OPSL COPY E:SLFP,A GET SL FILE POINTER COPY A,SCB:CFI(X) REMEMBER THIS CFI OPOC COPY Q,X FCB/DIB ADDRESS IN X NOW COPY DI:FLG(X),Q GET FCB/DIB FLAGWORD JGT Q,CHAROPEN HERE WANT TO OPEN AS A CHARACTER DEVICE AND =OPENMASK,Q GET 'FILE OPEN' BIT JEQ Q,CONLP NO ACTION IF A CLOSED FILE! COPY =-1,A COPY A,USERID(Y) MAKE THIS SO WE CAN'T CLOSE IT! JMP MKFILEOP NOW AS FOR A DISK FILE CHAROPEN COPY =CHBUFLEN/2,A CHBUFLEN/2 WORD BUFFER JSK C:GTMEMX GET MEMORY JNE A,$+2 JUMP IF OK JMP FSPEMPTY HERE FREE SPACE EXHAUSTED COPY C:SCBCH,X SCB ADDRESS IN X COPY A,SCB:CHB(X) UPDATE IN SCB COPY =I2A:,A ISO2ASCII ... COPY A,SCB:DTP(X) ... IS DATA TYPE COPY =CHDEV:,A CHDEV: => CHARACTER DEVICE COPY A,SCB:FLW(X) SET SCB FLAGWORD COPY USERID(Y),A GET THIS USER'S ID COPY A,SCB:USR(X) NOW WE CAN = CLOSE IT! JMP CONLP AND CONTINUE THE LOOP * * * HERE WE HAVE AN OPEN FILE, HAVE TO SET UP THE SCB * MKFILEOP COPY C:SCBCH,X SCB ADDRESS IN X COPY =DISKU:,A DISKU: => UNBUFFERED DISK FILE COPY A,SCB:FLW(X) SET SCB FLAGWORD COPY USERID(Y),A GET USER'S ID COPY A,SCB:USR(X) SET USER ID IN SCB COPY =UFM:,A UNFORMATTED ... COPY A,SCB:DTP(X) ... IS DATA TYPE JMP CONLP NOW CONTINUE LOOP END ETITL8 C:RTX NAM C:RTX C:RTX EQU 1 SNAM E:UAT,E:CIFP,E:SLFP SNAM C:DIBCH,C:SCBCH,C:CIBHD SNAM C:LOCK,C:UNLOCK SNAM C:LKDIB,C:ULDIB SNAM C:TERM SNAM C:CHAIN0 SNAM C:INITFS,C:GTMEMX,C:GTMEM0,C:FRMEM0 EXTR UAT:S EXTR C:INIT E:UAT WORD UAT:S TABLE: REL SHARABLE TABLE: E:CIFP RES 2,0 E:SLFP RES 2,0 C:DIBCH RES 1,0 C:SCBCH RES 1,0 EII: REL C:CIBHD WORD $+1 HEAD CIB: * RTX4 EII LOCK AND UNLOCK ROUTINES C:LOCK R:WAIT MUTEX RSK RSK C:UNLOCK R:SIG MUTEX RSK C:LKDIB EQU $ R:WAIT 0(X) WAIT UNTIL AVAILABLE RSK * RELEASE CONTROL OF DIB IF A WAIT WAS DONE C:ULDIB EQU $ R:SIG 0(X) RSK SDB:A MUTEX,1 * RTX4 EII EXIT ROUTINE C:TERM WORD $+1 R:END * FURTHER DUMMY RTX4 ROUTINES C:GTMEMX COPY A,X GET NWORDS IN X FOR EII ENTRY SEQUENCE R:ABUF 0(X) COPY X,A A=BUFFER ADDRESS C:INITFS EQU $ DUMMY RSK C:FRMEM0 COPY =0,A EXCH X,Y COPY A,*1(Y) REPLY WITH 0 (EXCEPTION IF IT FAILS) EXCH X,Y COPY 0(X),X X HOLDS ADDRESS OF MEMORY R:RBUF 0(X) RETURN BUFFER COPY =0,A 0 => OK REPLY RSK AND RETURN TO CALLER BSIZE EQU 0 RBADR EQU 1 REPLY EQU 2 C:GTMEM0 EQU $ COPY X,A SAVE X COPY BSIZE(X),X BLOCK SIZE REQUESTED R:ABUF 0(X) GET MEMORY EXCH A,X A=BUFFER X=PARAM LIST EXCH X,Y Y=PARAM LIST, SAVE Y COPY A,*RBADR(Y) RETURN BLOCK ADDRESS JNE A,$+3 GO IF GOOD ADDRESS COPY =-23,A BAD REPLY JMP $+2 STORE REPLY AND EXIT COPY =0,A 0= GOOD REPLY COPY A,*REPLY(Y) EXCH X,Y RESTORE Y AND X RSK * * DUMMY (TEMP) C:CHAIN0 FOR RTX * C:CHAIN0 COPY -19,A -19 => CHAIN0 LOAD FAILURE EXCH X,Y TEMPORARILY SWAP X AND Y COPY A,*1(Y) STORE REPLY COPY X,Y RESTORE Y RSK END ETITL8 C:CHAIN0 UIDX EQU 0 REPLYX EQU 1 UID EQU 2 NAM C:CHAIN0 TITL C:CHAIN0 ENT:EII 3 COPY UIDX(X),X FETCH UID PARAMETER COPY 0(X),A GET LENGTH .. SHIFT A,RO,8 .. IN BYTES SUB =3,A IGNORE LENGTH BYTES COPY A,1(X) PUT IN FOR E:CMD CALL E:CMD 1(X) BYE-BYE EVERYBODY HLT PLEASE DONT GET HERE END ETITL8 C:GTMEM0 BSIZEX EQU 0 RBADRX EQU 1 REPLYX EQU 2 BSIZE EQU 2 RBADR EQU 3 REPLY EQU 4 ETITL C:GTMEM0 NAM C:GTMEM0 EXTR C:GTMEMY,C:INIT C:GTMEM0 ENT:EII 3 COPY BSIZEX(X),A FETCH AND SAVE ... COPY A,BSIZE(Y) COPY RBADRX(X),A COPY A,RBADR(Y) COPY REPLYX(X),A  COPY A,REPLY(Y) ... ALL PARAMETERS EXCEPT BLOCKSIZE JSK C:INIT INITIALIZE (IF NECESSARY) JNE A,ERRGM0 IF NOT 0, ERROR EXIT COPY BSIZE(Y),A BLOCKSIZE JSK C:GTMEMY GET MEMORY BLOCK JEQ A,FSPEXD HERE FREE SPACE EXHAUSTED COPY A,*RBADR(Y) RETURN BLOCK ADDRESS COPY =0,A REPLY OK! ERRGM0 COPY A,*REPLY(Y) RETURN REPLY RET:EII FSPEXD COPY =-15,A -15 => FREE SPACE EXHAUSTED JMP ERRGM0 REPLY AND RETURN END ETITL8 C:GTMEMX,C:GTMEMY SAVX EQU 2 BSIZE EQU 3 USERID EQU 4 TITL NAM C:GTMEMX,C:GTMEMY EXTR C:FSBC C:GTMEMY COPY A,X PUT IN X FOR ENTRY SEQUENCE ENT:EII 3 COPY X,BSIZE(Y) SAVE BLOCK SIZE SIN 1 . NO INTERRUPTS? COPY R:ACT,A GET USER ID JMP ALTENT NOW ENTER COMMON CODE SECTION * C:GTMEMX COPY A,X PUT IN X FOR ENTRY SEQUENCE ENT:EII 4 COPY X,BSIZ> E(Y) SAVE BLOCK SIZE COPY =-1,A DUMMY USERID (NEVER FREED) ALTENT COPY A,USERID(Y) STORE USER ID LOCK COPY C:FSBC,X GET FREE SPACE BLOCK CHAIN BLKLOOP JEQ X,NONELEFT HERE CAN'T FULFILL REQUEST COPY FSB:USR(X),A GET USERID OF THIS BLOCK JNE A,NEXTBLK IF USED, MOVE ON COPY FSB:LEN(X),A GET LENGTH CSK A,BSIZE(Y) COMPARE WITH REQUESTED SIZE JMP NEXTBLK NO: NOT BIG ENOUGH JMP MAYSPLIT YES: DO WE NEED TO SPLIT IT? ALLOCIT COPY USERID(Y),A GET USER ID COPY A,FSB:USR(X) MARK USED (WITH USERID) COPY X,A RETURN BLOCK ADDRESS ADD =FSB:BLK,A A IS ADDRESS OF USER BLOCK RETURN EQU $ UNLOCK RET:EII NEXTBLK COPY FSB:CHN(X),X GET NEXT IN CHAIN JMP BLKLOOP AND CYCLE LPOOL TITL * * HERE WE HAVE A SUITABLE BLOCK, BUT DO WE NEED TO SPLIT IT? * MAYSPLIT SUB =11,A NEED 11 WORDS (MIN 8-WORD BLOCK) CSK A,BSIZE(Y) COMPARE WITH REQUIRED SIZE JMP ALLOCIT HERE NOT WORTH SPLITTING IT! NOP . HERE >, WANT TO SPLIT COPY X,SAVX(Y) SAVE CURRENT BLOCK ADDRESS COPY FSB:CHN(X),A SAVE CHAIN POINTER COPY FSB:LEN(X),Q SAVE BLOCKSIZE IN Q ADD =FSB:BLK,X PLUS OVERHEAD LOCS ADD BSIZE(Y),X PLUS SIZE = NEW X BLOCK COPY A,FSB:CHN(X) UPDATE CHAIN POINTER  COPY =0,A COPY A,FSB:USR(X) USER = NOBODY! SUB BSIZE(Y),Q SUBTRACT BLOCK SIZE SUB =FSB:BLK,Q AND BOOKKEEPING WORDS COPY Q,FSB:LEN(X) NEW LENGTH SET COPY X,A GET X FOR CHAIN COPY SAVX(Y),X BACK TO OLD BLOCK COPY A,FSB:CHN(X) UPDATE NEW CHAIN COPY BSIZE(Y),A GET REQUESTED SIZE COPY A,FSB:LEN(X) IS NOW THE SIZE OF THIS BLOCK JMP ALLOCIT NOW ALLOCATE THIS BLOCK * NONELEFT COPY =0,A 0 => NO BLOCK THIS SIZE! JMP RETURN * LPOOL END ETITL8 C:FRMEM0 BADRX EQU 0 REPLYX EQU 1 BADR EQU 2 REPLY EQU 3 LASTBLK EQU 4 TITL NAM C:FRMEM0 EXTR C:FSBC C:FRMEM0 ENT:EII 3 COPY BADRX(X),A FETCH AND SAVE ... SUB =FSB:BLK,A SUBTRACT BOOKKEEPING WORDS COPY A,BADR(Y) (NOTE: ACTUAL ADDRESS OF BLOCK NOW!) COPY REPLYX(X),A COPY A,REPLY(Y) ... ALL PARAMETERS LOCK COPY C:FSBC,X GET FCB CHAIN COPY =0,A COPY A,LASTBLK(Y) 0 => LAST BLOCK NOT PRESENT BLKLOOP JEQ X,NONELEFT HERE NO BLOCKS LEFT TO SCAN COPY X,A GET X IN A FOR CSK CSK A,BADR(Y) IS IT THIS BLOCK? JMP $+3 NO: SKIP EXIT JMP $+2 NO: SKIP EXIT JMP THISBLK YES: FREE IT? COPY X,LASTBLK(Y) REMEMBER AS LAST BLOCK COPY FSB:CHN(X),X NEXT IN CHAIN JMP BLKLOOP AND LOOP TILL WE FIND IT! NONELEFT COPY =-16,A -16 => ADDRESS IS NOT AN ALLOCATED BLOCK ERRFR0 COPY A,*REPLY(Y) SET REPLY UNLOCK RET:EII TITL * * HERE HAVE FOUND THE BLOCK, WE WILL FREE IT. * THISBLK COPY =0,A SO ... COPY A,FSB:USR(X) ... MARK FREE COPY LASTBLK(Y),X GET LAST BLOCK JEQ X,NOMERGE1 DON'T MERGE PREVIOUS (NOT THERE!) COPY FSB:USR(X),A GET USER # LAST BLOCK JNE A,NOMERGE1 DON'T MERGE PREVIOUS (NOT FREE!) COPY BADR(Y),X BLOCK # 2 COPY FSB:CHN(X),A GET CHAIN PTR IN A COPY FSB:LEN(X),Q LENGTH IN Q ADD =FSB:BLK,Q PLUS OVERHEAD WORDS COPY LASTBLK(Y),X GET BLOCK # 1 COPY X,BADR(Y) THIS IS NOW THE CURRENT BLOCK COPY A,FSB:CHN(X) UPDATE POINTER ADD FSB:LEN(X),Q ADD LENGTH BLOCK # 2 COPY Q,FSB:LEN(X) AND UPDATE WITH TOTAL LENGTH NOMERGE1 COPY BADR(Y),X GET THIS BLOCK ADDRESS COPY FSB:CHN(X),X GET NEXT BLOCK ADDRESS JEQ X,NOMERGE2 DON'T MERGE NEXT (NOT THERE!) COPY FSB:USR(X),A GET USER ID NEXT BLOCK JNE A,NOMERGE2 DON'T MERGE NEXT (NOT FREE!) COPY FSB:CHN(X),A GET CHAIN POINTER IN A COPY FSB:LEN(X),Q GET LEN? GTH IN Q ADD =FSB:BLK,Q PLUS OVERHEAD WORDS COPY BADR(Y),X BACK TO BLOCK # 1 COPY A,FSB:CHN(X) UPDATE POINTER ADD FSB:LEN(X),Q ADD LENGTH BLOCK # 2 COPY Q,FSB:LEN(X) AND UPDATE TOTAL LENGTH NOMERGE2 COPY =0,A 0 => ALL OK! JMP ERRFR0 SUCCESSFUL EXIT * LPOOL END ETITL8 C:INITFS,C:FSBC NAM C:INITFS,C:FSBC EXTR C:MEMORY,E:SLFP C:INITFS COPY L,A WILL CREATE NEW L IN A COPY L,X ADDRESS OF MEMORY IN X ADD C:MEMORY,A ADD AMOUNT TO ALLOCATE COPY A,L UPDATE L COPY =0,A COPY A,FSB:CHN(X) NO CHAINED BLOCKS COPY A,FSB:USR(X) NOT USED COPY C:MEMORY,A THE NUMBER OF WORDS ALLOCATED SUB =FSB:BLK,A MINUS OVERHEAD WORDS COPY A,FSB:LEN(X) IS LENGTH OF INITIAL BLOCK COPY X,C:FSBC NOW X IS FREE SPACE CHAIN COPY E:SLFP,A GET ADDRESS OF SL WRITE POINTER COPY A,SET:SLFP+IO:CFI STORE IT IN IOB I:IO SET:SLFP READ SL WRITE POINTER INTO E:SLFP NOP IGNORE ERRORS RSK . RETURN TO CALLER * * IOB TO READ SL WRITE POINTER INTO E:SLFP IOB:A SET:SLFP,'SL',PO:,RWP:,0,0,0,ER: C:FSBC WORD 0 FREE SPACE CHAIN END ETITL8 C:LOCK,C:UNLOCK NAM C:LOCK,C:UNLOCK NAM C:LKDIB,C:ULDIB * DUMMY ROUTINES FOR OS4 * C:LOCK EQU $ * C:UNLOCK EQU $ * C:LKDIB EQU $ * C:ULDIB EQU $ * RSK C:LOCK PUSH :40 COPY =-1,A INLK1 ADD LK1,A COPY A,LK1 ADD =:1000,A SELP A,4 POP RSK C:UNLOCK PUSH :40 COPY =1,A JMP INLK1 * C:LKDIB PUSH :40 COPY =-1,A INLK2 ADD LK2,A COPY A,LK2 ADD =:2000,A SELP A,4 POP RSK C:ULDIB PUSH :40 COPY =1,A JMP INLK2 * SHARABLE TABLE: TABLE: REL LK1 WORD 1 LK2 WORD 1 END ETITL8 C:MEMORY NAM C:MEMORY TABLE: REL SHARABLE TABLE: C:MEMORY WORD 1024 1024 WORDS REQUIRED (STANDARD) END ETITL8 C:EXTSIZ NAM C:EXTSIZ TABLE: REL SHARABLE TABLE: C:EXTSIZ WORD :40 // DEFAULT :40 AUS PER EXTENT END ETITL8 C:CIBHD,C:SBC,C:DIBCH,C:TERM NAM C:CIBHD,C:SCBCH,C:DIBCH,C:TERM EXTR E:MON EXTR E:CIBHD C:TERM WORD E:MON C:CIBHD WORD E:CIBHD CIB LIST HEAD POINTER TABLE: REL SHARABLE TABLE: C:DIBCH WORD 0 C:SCBCH WORD 0 END ADD C:MEMORY,A ADD AMOUNT TO ALLOCATE COPY A,L UPDATE L COPY =0,A COPY A,FSB:CHN(X) NO CHAINED BLOCKS COPY A,FSB:USR(X) NOT USED COPY C:MEMORY,A THE NUMBER OF WORDS ALLOCATED SUB =FSB:BLK,A MINUS OVERHEAD WORDS COPY A,FSB:LEN(X) IS LENGTH OF INITIAL BLOCK COPY X,C:FSBC NOW X IS FREE SPACE CHAIN COPY E:SLFP,A GET ADDRESS OF SL WRITE POINTER COPY / NEWEII.JCL --- ASSEMBLE EII INTERFACE (93530-70-E700) / ALL SOURCE FILES ASSUMED TO BE ON UF /  SYSTEM MACRO FILES ON SF / CREATES LIBRARY & LISTING ON UF / AS SF=/SYS/ /MACRO NEWEII.LIB=NEWEII1(D=SF.GEN+ SF.RTX+SF.IOS+SF.IOSD+SF.SFM+SF.OS4+ NEWEII(L=NEWEII,P=62,SAVE))+ NEWEII2+NEWEII3+NEWEII4+NEWEII5+NEWEII6+NEWEII7+NEWEII8 PRINT NEWEII //C EII.LIB=NEWEII.LIB /JOB ¥8201191332205082012013460075820203152757JC:RENAM0O0SEGMENTBLANK EII: o KF:CFNO I:IO C:RETURNKC:UNLOCKC:ENTER C:CLOSE0KC:ULDIB C:LKDIB C:PTOPENim MACRO (F300) @ig ÿÀA€€„C€„G€‚„B `+ ¤D  …D+¤H…H+¤E+¤I*åÿ¬åÄF `+ÿ¨à `+ÿ£ÖÄJ€RŒaC ÿ™螀SŒb\ÿ˜ `+Èžš…B  mÿ `+ÿ‹ž…B `+ÿ†BŸˆ…BŸ†tttttæt ÿw „H R+¤mÿÙD„p F … ¤r „n„o„€ „„t „s` 8 „u0ž €v žž¾ÀxQÀyX žt)€×ŒùÊ5¼Äe€Hõ r€€„n €„ožf€H¤)€æŒù 5¼õž. €wAž+€o€n[` %„u „s `+.¤rþú0ž mÿ)€HE ` +ÿ@ %Až `+ÿ ž€wÁêž  t H„p J … „€ „¤r0ž” €v žžlÀxQÈ r€€„n€„o€y Nžo)€æŒù«5¼ž8€wAŸÌ€o €n `+.¤rþ¹` %„u „s 0žGD„p F …¤rþ« „e 0ž<ž.Äm€ƒÌ „€ H€ƒ @„„  ž‚ýž’ m€…„r€ƒ„p  „q 0„s0žˆ m „€!„‚  ÿ# €wž|€C ð„# ð„€€ ÿ„€# /tÿÿJC:WRUID0O0SEGMENTBLANK EII: o KC:RETURNC:ENTER C:WR0 im MACRO (F300) @ig ÿ— €€„B€„C€‚„F` „EC y ýÇ„D€C „C `+ÿƒ…FŸ‚tttÿÿJC:OPUID0O0SEGMENTBLANK EII: o %KC:RETURNC:ENTER C:MOVBTSim MACRO (F300) @ig ÿ¡ €€„D€„EÀ‚ÄB€ƒ„C€„„F €…„GCyKžžÆ€E ÿ…F  …GŸ‰ˆE…F)ÀEÿ…žwçžvtttÿÿJC:SPUID0O0SEGMENTBLANK EII: o -KC:RETURNC:ENTER C:MOVBTSim MACRO (F300) @ig ÿ© €€„E€„F€‚„G€ƒ„H€„„I Eq…Fy)ÀEÄCÀFÄDIÿ”ÜE E…GyÀGÄDIÿŒEq…HyÀHÄDIÿ„ …IŸ‚tttÿÿJC:MGUID0O0SEGMENTBLANK EII: o ;KC:RETURNC:ENTER C:MOVBTSim MACRO (F300) @ig ÿ· €ƒ„D€€„E€„F€‚„G€„„H Ey…DÁFNyB¡G.yNq@'"  ÿžž›qµD…D DÄI€E„C) Eyÿ’€F„C)FyÿŒ€G„C)Gyÿ† …HŸ„ëž|tttÿÿJC:RDUID0O0SEGMENTBLANK EII: o KC:RETURNC:ENTER C:GETUIDKC:RD0 im MACRO (F300) @ig ÿ–€€„G€„D€‚„E€ƒ„F„K  „I `+ ¤J‡ÄB*û¤C*ûÿƒŸƒttttÿÿJC:IPUID0O0SEGMENTBLANK EII: o KC:RETURNC:ENTER C:GETUIDKC:GCFM im MACRO (F300) @ig ÿ– €€„G€„I€‚„J€ƒ„D€„„E €…„F` „C‚†„B `+ÿƒŸƒttttÿÿJC:GCFM O0SEGMENTBLANK EII: o KC:RETURNC:ENTER im MACRO (F300) @ig ÿ˜€€„B€„C€ƒO ÿ„ƒÀ‚Ü‚ @ÀB`H%€À'`@q…C Ÿƒÿž{ttÿÿJC:GETUIDO0SEGMENTBLANK EII:  o ºKE:SLU C:RETURNC:ENTER KC:MOVBTSC:DIBCH C:RDSTR im MACRO (F300) @ig ÿ±€€„G€„H€‚„D€ƒ„J€„„K ` „I „F„C „M „N„O„P „E `+ÿ“ЀLÔJ /žÅ€M ÿq´N D„€€Oq´P„ …KŸƒthtt ž… ž˜ žšžÅ€Qÿ÷ЀL) ÀMÿó€MˆL„M€NˆL„NJ .ž / ž›žU‚瞃€Ry¶ä„R¢ã €1H€‚ ¸Qž{žz€ƒ¸Ržwžv€L ž‚1žZ €Rq„RžzÜN MJÀD`H%„À' `@ÜM `+ÿ;Až7€LÁž)ˆM þ žƒëž.€L)ÀMÿ±€MˆL„M€O ˆL„OJ /žƒ .žƒžÜOžWÜP M ÀD`H%„À'`@ÜM „E `+ÿ Až €LÁŸ”ˆM þžžU€L)ÀMÿˆ€MˆL„M€PˆL„PŸ…tt000t#ÿÿJC:RDSTR O0SEGMENTBLANK EII: o BKC:RETURNC:ENTER im MACRO (F300) @ig ÿ¿ €€„B€„C€‚„D€„„F€…„G €†„H`  ƒ„¤E „I EýDØ €J| z `ž à Z @žžÀIH 9 /žžŠ :žˆ _ž†…G€I…F  …HŸÀI @KøBžž]ÄIÀC`H%„À'`@žUttÿÿJC:CVUID0O0SEGMENTBLANK EII: o KC:RETURNC:CKOPENC:ENTER im MACRO (F300) @ig ÿš€„B€‚„C €ÿ”Æ @ 1Å …BÜB…B…CŸŒÀ€N‰K€€…B+ÜBU» žttttÿÿJC:RDFST0O0SEGMENTBLANK EII: o hKC:RETURNE:SLU C:ENTER KC:REOF0 C:CLOSE0C:OPEN0 im MACRO (F300) @ig ÿ·€€„B€„H€‚„I€ƒ„F€„„D „G` „C„E „J„K `+ÿ¢Þ  C€€ÿŸBžÀ €ᙀŠA ö—€‹––Aö•€ŒAö“ÅH …I …FÜF…F `+ÿŸ‰ttttÀÿýt ‚¢…H Bî„L€‚yC+ÜLžz €€ÿ Džž†€º’žƒž‚ ž  …I `+ÿŠ„L `+ÿU€L…DžQÿIRtÿÿJC:DTTIM0O0SEGMENTBLANK EII: o -KC:RETURNR:GATD C:ENTER im MACRO (F300) @ig ÿ© €€„B€„CÀDþ˜ÅBÜB ÀEþ”ÅBÜBÀFþÅBÜBÀGþŒÅBÜB ÀHþˆÅBÜBÀIþ„ÅB „CŸ‰@NyJÐÿ ÐG€# tt ÿÿJC:LOAD0 O0SEGMENTBLANK EII: o KC:RETURNI:LOAD C:ENTER im MACRO (F300) @ig ÿš `(@„‚€A„„„†A €B„… „ƒ „‹ €‡…C€ˆ ÿ…D€‰–„…F`(Ÿ‚tÿtÿÿJC:EXIT0AC:EXIT0 O0SEGMENTBLANK EII: o 'KC:RETURNC:ENTER C:TERM KC:SCBCH C:CLOSE0im MACRO (F300) @igþ‚£ œ€g ÿŸ  !¤B` „F „G „D£• ž‚ H €1N¤H€‚¸Bžyžx€ žu€ƒ„C `+ÿ…žoŸ„tttttÿÿJC:WRLOG0O0SEGMENTBLANK EII: o )KC:RETURNE:SLU C:ENTER KC:WR0 im MACRO (F300) @ig ÿ¢ €€„C€„D€‚„F `+¤B+ ¤E „H‚”„G*ùÿ’΂ÿ€„G ‚ŽÿŒ€ŒGE‚‰„G `+ÿƒŸ…tOCttSLtÿÿJC:UNMAP0O0SEGMENTBLANK EII: o KC:WR0 C:XXMAP0im MACRO (F300) @ig‚„`(…E hŸttÿÿJC:MAP0 O0SEGMENTBLANK EII: o KC:RD0 C:XXMAP0im MACRO (F300) @ig‚„`(…E hŸttÿÿJC:XXMAP0O0SEGMENTBLANK EII: o  KC:RETURNC:ENTER C:POS0 im MACRO (F300) @ig ÿœ€€„B„G€„C€‚„D€ƒ„H€„ „I€…„F„KF„L `+ ¤J¤E*úÿ†à `+ýLŸ‚tttÿÿJC:DEL0 O0SEGMENTBLANK EII: o KC:RETURNF:DELE C:UNLOCKKC:ENTER C:PTOPENim MACRO (F300) @ig ÿ™€€„C€„B „F„G `+¤D +¤E*ûÿ‹ÇÿŠ Âóž …BŸƒttttÿÿJC:CREAT0O0SEGMENTBLANK EII: o ¥KF:CREA C:UNLOCKC:RETURNKC:ENTER C:DRENTSC:EXTSIZKC:WR0 C:CLOSE0C:OPEN0 KC:PTOPENim MACRO (F300) @ig ÿ©€€„D€‚„B€„C ž… žƒ ö…BŸœ „G„H„Q `+¤E+¤F *úÿ’²ÿ‘ƒ‘„O„P Âõži„I€C žˆ žcttt tt `+ÿÒ™€E„Y€NÁÜN `+ ¤Z „[*ü¤\*ü¤]+ÿÂû€K„Z „[ `+ÿºó `+¤Z „[+  ÿ²낶„Z „[ `+ÿªã `+  ¤Z „[+ÿ¢Û‚®„Z „[ `+ ÿšÓ‚™ „N‚ª„Z „[ `+ ÿŽÇÜNžz `+ÿŠ ž `+ÿ…ôžtttt.. •. ÿÿJC:DRENTSO0SEGMENTBLANK EII: OTABLE: o im MACRO (F300) @iig@ÿÿJC:POS0 O0SEGMENTBLANK  EII: o *KC:RETURNC:ENTER C:CKOPENim MACRO (F300) @ig ÿ¦€„C€‚„D€ƒ„E€„„F €ÿœ ÄGÍ @ „‹€ ž‰ ž‡ …E ÜE…Eò…FŸŒ€C …„€…EÜE€D„…E žttttÿÿJC:RDPOS0O0SEGMENTBLANK EII: o "KC:RETURNC:ENTER C:CKOPENim MACRO (F300) @ig ÿž€„C€‚„D €ÿ˜ÄEË @€ ž‰ ž‡ …CÜC…Cò…DŸŠ …€€…CÜC€…C žvtttÿÿJC:PTOPENC:OPEN0 O0SEGMENTBLANK EII: o KI:IO F:CFNO F:CONN KC:RETURNC:UNLOCKE:SLU KC:LOCK C:ENTER C:INIT KC:SCBCH C:FRMEM0C:GTMEMXKC:DIBCH im MACRO (F300) @igÿÌ* žƒg ÿÈ*ÿ„F€€À„BÄCÀ‚€ƒM@SD @HÿžƒMSAž³ÄE„D„hÿ³Ð „\„[ `+ ¤Y+¤Z C€€„]yF €yBÿŸ¢ÿ„Hÿ £ 1ÂþŸ˜ € žž€ƒÀHQØÿ 0žŠ 9 žž†€ƒy Xžª Zž¨ €žgæžýÅttÉtt  ¸]žsžr¤G€F„g `+'ÿñA žæB‰ „IÿëÂñžÞ G„„g  I*ÿÂ…ç5½ž‡€ƒ„]¤G C„€  „Bÿ„I „JÿÎQR „fLž¢ Lž¸Lž¼ Z°Y¤Z€…–ÁV„…‚ „†žÉ„f‚¿ÿ¿Búž¯ €Ĥ[ „Zž¼€f /ž‚€Š„\ ‰žuÄI Y €€ÿª- Y‚¨„ÿ§ 1¨ YÀIL žSLžƒ‚Ÿ„žN€q žzÄI Y €y¶•žiÄI Yžg…DÿDŸ„…DŸ‚²ÿtt t OLUFt00 0t  B€y„IØ€\΄Y  ž‚ýž^€„y DžžñüžW„Y  „\ ž×žoÿTQ- /ž³ B€ ÿ ÿ×ÜJ„I) ÀB°J`H%€À '`HÐY+°J`H%„À'`HÐY+ ÜIžn€FÞ D€[„ƒ€\„„€Z„‚  „ IY„€ÜY+U» …DÀG Ÿ  Y€…–D„…‚¥„†€I YŽ¡ J žž'€Š„\€IJž3€F Z Y+ÿ’AŸ@ž" GÀESAIÄŒ L L žÅIR##ã €FÂ÷Ÿv G€EA „Œ  „€!„‚ „Š „‹ „‰„ˆ€  ž—€„Õ£¤1L€ ž‡€„EIÄ„  G„„ž‰ €žs Eÿ–ÂñŸN G„„ €…„_ „^ 0„`ž‚ ŸA G „€dŸgÿÿJC:RDCOM0O0SEGMENTBLANK EII: OTABLE: o =KE:RCI I:IO C:RETURNKE:ICH C:ENTER C:WPCL KC:WPC im MACRO (F300) @iiÿÿig ÿ´€€„B€„C€‚„Dß­ž› „E `+„„Ž) bÿ¤  EÜEÀB `H%„À'`@ žžp E¥C …D Ÿ“‚Ž„F‚‘„I‚„Kƒ„J)ÿŠ°žVCItdÿÿtttttÿÿJC:WPCL C:WPC O0SEGMENTBLANK EII: o im MACRO (F300) @ig EII..gÿÿJC:REOF0 O0SEGMENTBLANK EII: o $KC:RETURNI:IO C:ENTER KC:CKOPENim MACRO (F300) @ig ÿŸ €„EÀ‚ÄB €ÿ™Î @€  žŒ€ƒ„C „D‚„Fžˆ …BŸŠ …EÜE…Ežy€Jžwtt'tÿÿJC:WEOF0 O0SEGMENTBLANK EII: o KC:RETURNI:IO C:ENTER KC:CKOPENim MACRO (F300) @ig ÿš ÀÄB €ÿ–Ð @€ ž‹€ƒ „C+¤E „D‚‹„Fžƒ …BŸ…€Jž|tt"tÿÿJC:CKOPENO0SEGMENTBLANK EII: o KC:RETURNC:ENTER C:INIT KC:SCBCH im MACRO (F300) @ig ÿ–¤Bÿ”£”1ÂþžŒ€ƒ¹Bž‚ž ž‚ €žv€ žƒ@ Ÿ…ùŸƒttttÿÿJC:MOVBTSO0SEGMENTBLANK EII: o im MACRO (F300) @ig Á# „BÐC`H%€À'`H+°C ÐD`H%„À'`H+°CÐDÜBžnÐC# ÿÿJC:RETURNC:ENTER O0SEGMENTBLANK EII: o KC:INIT im MACRO (F300) @ig @`p`pá@C @júr<`p„AÜAÄB`€@ `p„@k# g @àAp # m**C * EII.LIB - REV E810 m ***ÿÿJC:INIT O0SEGMENTBLANK EII: o ¥KC:RETURNC:ENTER E:SLFP KE:CIFP C:INITFSC:GTMEMXKC:SCBCH E:UAT C:CIBHD KC:DIBCH im MACRO (F300) @ig ƒðB # ÿïÿî ‡í£í €1X ¤B ƒ1Q¤C ÿàO C`¤AÀ„ÄB À…ÄCÃÛÄ@`‡Ø €žn BžhñŸÔ £ÔIÇʤD€€+„B¤C C€€ºÊ ž‚žž¼ ÿ½,ú Ä€§· „Š „ „‚„„„„†„‡„‰„ˆ „‹  „… C€!„E€€À+¤C£Ÿ„ƒQU º¦ž‚žž‘º£ž‚žž¦º ž‚žž¦ ºž‚žž  @ÀRBÖ‹QòÜBžB D 1Až8 ž2ttttt ttt ZBZPCIOCSLƒ žƒŸ„… @ÀREÖiQÿ„Ež EÿbÁž £^„„ „Œ „€E„‚žN£U „€E„‚ „ŒžFttÿÿJMUTEX C:RTX LC:FRMEM0C:GTMEM0C:GTMEMXLC:INITFSC:CHAIN0C:TERM LC:ULDIB C:LKDIB C:UNLOCKLC:LOCK C:CIBHD C:SCBCH LC:DIBCH E:SLFP E:CIFP LE:UAT O0SEGMENTBLANK EII: OTABLE: o 4 KR:RBUF R:ABUF R:END KR:SIG R:WAIT UAT:S NR:SL CIB: im MACRO (F300) @ifghtihh h h ih lh :dÿÿ# h:dÿÿ# h # h # ikgð>ih:h  h# h `(…A`( € # h  € `(…AÂéž …B`(# hƒ„`(…A` # ÿíÿÿJC:CHAIN0O0SEGMENTBLANK EII: o  KE:CMD C:ENTER im MACRO (F300) @ig ÿ‰ €€€y ý„+ÿ‚ ttÿÿJC:GTMEM0O0SEGMENTBLANK EII: o KC:RETURNC:ENTER C:INIT KC:GTMEMYim MACRO (F300) @ig ÿ’€€„B€„C€‚„Dÿ‹Å€Bÿ‰D…C …DŸ…ñž|ttttÿÿJC:GTMEMYC:GTMEMXO0SEGMENTBLANK EII: o ;KC:RETURNC:UNLOCKC:LOCK KC:ENTER C:FSBC im MACRO (F300) @ig ÿœ¤C€!ž…g ÿ•¤Cÿ„Dÿ‘£‘1i€‚Ê€ ¸Cž‡žŽ€D„‚ ÿ†Ÿ† €žqttttt õ¸Cžo¤B€€À+¨C„€  „‚ÌCJýÄ  B„€€C„ž] ž_ÿÿJC:FRMEM0O0SEGMENTBLANK EII: o :KC:RETURNC:UNLOCKC:LOCK KC:ENTER C:FSBC im MACRO (F300) @ig ÿ´€€ ý„B€„Cÿ®£® „D1H ¸Bž‚žž‡¤D €žwð…Cÿ¡Ÿ¡ „‚ D1K€‚É B€€ÀK D¤B „€ÈÄ B €1I€‚Ç€€ÀK B„€ÈÄ ž`tttttÿÿJC:FSBC C:INITFSO0SEGMENTBLANK EII: o KI:IO E:SLFP C:MEMORYim MACRO (F300) @ig P P‹—P „€„‚ƒ’ ý„¦Žƒ††: # SL'gttÿÿJC:ULDIB C:LKDIB C:UNLOCKJC:LOCK O0SEGMENTBLANK EII: OTABLE: o im MACRO (F300) @ig C @ÿ‹–‡•Š•c # gC @ žvg C @ÿ‹‹‡ŠŠŠc # gC @ žvdÿÿdÿÿ iÿÿJC:MEMORYO0SEGMENTBLANK EII: OTABLE: o im MACRO (F300) @iigÿÿJC:EXTSIZO0SEGMENTBLANK EII: OTABLE: o im MACRO (F300) @iig@ÿÿJC:TERM C:DIBCH C:SCBCH JC:CIBHD O0SEGMENTBLANK EII: OTABLE: o KE:CIBHD E:MON im MACRO (F300) @igtgtiggÿÿ @ig ÿ‰ €€€y ý„+ÿ‚ ttÿÿJC:GTM * 0064 ************************************************************************ 0000 0065 NAM C:OPUID0 0066 EXTR C:MOVBTS 0067 EXTR C:ENTER 0000 FFA1 0022 0067+ C:OPUID0 JSK C:ENTER 0001 0009 0067+  WORD ENDSTK+2 0002 8080 0000 0068 COPY MADRX(X),A FETCH AND SAVE... 0003 8444 0004 0069 D COPY A,ADROUT(Y) (MEM ADDRESS IS OUTPUT ADDRESS) 0004 8081 0001 0070 COPY SBYTEX(X),A 0005 8445 0005 0071 COPY A,CUBYTE(Y) 0006 C082 0002 0072 COPY MAXLENX(X),Q 0007 C442 0002 0073 COPY Q,COUNT(Y) RETAIN MAX COUNT IN Q (AND COUNT) 0008 8083 0003 0074 COPY UIDX(X),A 0009 8443 0003 0075  COPY A,UID(Y) (THIS IS ALSO ADRIN!) 000A 8084 0004 0076 COPY ALASTBX(X),A 000B 8446 0006 0077  COPY A,ADLASTB(Y) 000C 8085 0005 0078 COPY REPLYX(X),A 000D 8447 0007 0079 COPY A,REPLY(Y) ... ALL PARAMETERS 000E 8143 0003 0080 COPY *UID(Y),A CALCULATE LENGTH 000F 0E79 0081  SHIFT A,RO,8 GET COUNT OF BYTES IN UID 0010 004B 0082 CSK A,Q LESS THAN OR EQUAL TO MAX COUNT? 0011 9E81 0013 0083 JMP $+2 YES: LESS THAN MAX 0012 9E8D 0020 0084 JMP TOOLONG NO: TOO LONG 0013 11C6 001A 0085 JNE A,MOVBYTS JUMP IF NOT NULL UID 0014 8045 0005 0086  COPY CUBYTE(Y),A CURRENT BYTE 0015 0AFF 0087 SUB =1,A -1 0016 8546 0006 0088  COPY A,*ADLASTB(Y) IS LAST BYTE STORED 0017 0900 0089 NORMEX COPY =0,A GOOD REPLY 0018 8547 0007 0090 BADEX COPY A,*REPLY(Y) STORE FOR USER 0091 EXTR C:RETURN 0019 9F89 0023 0091+  JMP C:RETURN 001A 8845 0005 0092 MOVBYTS ADD CUBYTE(Y),A CURRENT BYTE +COUNT=LASTBYTE 001B 8546 0006 0093 COPY A,*ADLASTB(Y) WILL BE THE LAST BYTE STORED 001C 2904 0094 COPY =UIDBYTS,X INITIAL BYTE INDEX INTO UID 001D C045 0005 0095 COPY CUBYTE(Y),Q OUTPUT BYTE INDEX IN Q 001E FF85 0024 0096  JSK C:MOVBTS MOVE THE BYTES 001F 9E77 0017 0097 JMP NORMEX NOW NORMAL EXIT 0020 08E7  0098 TOOLONG COPY =-25,A =>UID TOO LONG FOR AVAILABLE MEMORY 0021 9E76 0018 0099 JMP BADEX 0022 0001 C:ENTER 0023 0000 C:RETURN 0024 0002 C:MOVBTS 0100 END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0005 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:26:58.25 -- C:SPUID0 -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0101 EII: REL  0101+ SHARABLE EII: 0101+ ROMMABLE EII: 00000000 0102 UIDX EQU 0  UID ADDRESS 00000001 0103 PARTAX EQU UIDX+1 ADDRESS TO STORE PARTA 00000002 0104 PARTBX EQU PARTAX+1 ADDRESS TO STORE PARTB 00000003 0105 PARTCX EQU PARTBX+1 ADDRESS TO STORE PARTC  00000004 0106 REPLYX EQU PARTCX+1 REPLY ADDRESS 00000002 0107 COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) 00000003 0108 ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000004 0109 ADROUT EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) E 00000005 0110 UID EQU ADROUT+1 UID ADDRESS 00000006 0111 PARTA EQU UID+1 ADDRESS TO STORE PARTA 00000007 0112 PARTB EQU PARTA+1 ADDRESS TO STORE PARTB 00000008 0113 PARTC EQU  PARTB+1 ADDRESS TO STORE PARTC 00000009 0114 REPLY EQU PARTC+1 ADDRESS TO STORE REPLY 00000009 0115 ENDSTK EQU REPLY END STACK MARKER 1PAGE 0006 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:26:58.75 -- C:SPUID0 -- 0117 ************************************************************************ 0118 * *  0119 * E I I S E R V I C E --- C : S P U I D 0 --- * 0120 *  * 0121 ************************************************************************ 0000 0122 NAM C:SPUID0 0123 EXTR C:MOVBTS  0124 EXTR C:ENTER 0000 FFA9 002A 0124+ C:SPUID0 JSK C:ENTER 0001 000B 0124+ WORD ENDSTK+2 0002 8080 0000 0125 COPY UIDX(X),A FETCH AND SAVE... 0003 8445 0005 0126 COPY  A,UID(Y) 0004 8081 0001 0127 COPY PARTAX(X),A 0005 8446 0006 0128 COPY A,PARTA(Y) 0006 8082 0002 0129 COPY PARTBX(X),A 0007 8447 0007 0130 COPY A,PARTB(Y) 0008 8083 0003 0131 COPY PARTCX(X),A 0009 8448 0008 0132 COPY A,PARTC(Y) 000A 8084 0004 0133 COPY REPLYX(X),A 000B 8449 0009 0134 COPY A,REPLY(Y) ... ALL PARAMETERS 0135 * MOVE PART A 000C 8145 0005 0136  COPY *UID(Y),A 000D 0E71 0137 SHIFT A,LO,8 COUNT IN TOP BYTE 000E 8546 0006 0138  COPY A,*PARTA(Y) STORE IN BLOCK 000F 0E79 0139 SHIFT A,RO,8 COUNT NOW IN A (LSB) 0010 2904 0140 COPY =UIDBYTS,X INPUT INDEX IN X 0011 C045 0005 0141 COPY UID(Y),Q 0012 C443 0003 0142 COPY Q,ADRIN(Y) UID IS INPUT ADDRESS 0013 C046 0006 0143 COPY PARTA(Y),Q 0014 C444 0004 0144 COPY Q,ADROUT(Y) PARTA IS OUTPUT ADDRESS 0015 4901 0145 COPY =1,Q OUTPUT INDEX IN Q 0016 FF94 002B 0146 JSK C:MOVBTS MOVE THE BYTES 0147 * MOVE PART B (ADRIN AND X ALREADY SET UP FROM ABOVE CODE!) 0017 DC45 0005 0148 IMS UID(Y) INC UID ADDRESS 0018 8145 0005 0149 COPY *UID(Y),A COUNT B/ COUNT C 0019 8547 0007 0150 COPY A,*PARTB(Y) STORE COUNT IN PARTB 001A 0E79 0151 SHIFT A,RO,8 COUNT B IN A 001B C047 0007 0152 COPY PARTB(Y),Q 001C C444 0004 0153 COPY Q,ADROUT(Y) PARTB IS NEW OUTPUT ADDRESS 001D 4901 0154 COPY =1,Q  OUTPUT INDEX IN Q 001E FF8C 002B 0155 JSK C:MOVBTS MOVE THE BYTES 0156 * MOVE PART C (F ADRIN AND X ALREADY SET UP FROM ABOVE CODE!) 001F 8145 0005 0157 COPY *UID(Y),A COUNT B/ COUNT C 0020 0E71  0158 SHIFT A,LO,8 COUNTC / 0 0021 8548 0008 0159 COPY A,*PARTC(Y) STORE COUNT IN PARTC 0022 0E79 0160 SHIFT A,RO,8 COUNT C IN A 0023 C048 0008 0161 COPY PARTC(Y),Q 0024 C444 0004 0162 COPY Q,ADROUT(Y) PARTC IS NEW OUTPUT ADDRESS 0025 4901 0163 COPY =1,Q  OUTPUT INDEX IN Q 0026 FF84 002B 0164 JSK C:MOVBTS MOVE THE BYTES 0027 0900 0165 COPY =0,A REPLY (ALWAYS GOOD!) 0028 8549 0009 0166 COPY A,*REPLY(Y) STORE FOR USER 0167 EXTR C:RETURN 0029 9F82 002C 0167+ JMP C:RETURN 002A 0001 C:ENTER 002B 0002 C:MOVBTS 002C 0000 C:RETURN 0168 END 1PAGE 0007 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:00.00 -- C:SPUID0 -- 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0008 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:01.75 -- C:MGUID0 -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0169 EII: REL 0169+ SHARABLE EII:  0169+ ROMMABLE EII: 00000000 0170 PARTAX EQU 0 ADDRESS TO STORE PARTA 00000001  0171 PARTBX EQU PARTAX+1 ADDRESS TO STORE PARTB 00000002 0172 PARTCX EQU PARTBX+1 ADDRESS TO STORE PARTC 00000003 0173 UIDX EQU PARTCX+1 UID ADDRESS 00000004 0174 REPLYX EQU UIDX+1  REPLY ADDRESS 00000002 0175 COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) 00000003 0176 ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000004 0177 ADROUT  EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000004 0178 UID EQU ADROUT  UID ADDRESS (IS ADROUT!) 00000005 0179 PARTA EQU UID+1 ADDRESS TO STORE PARTA 00000006 0180 PARTB EQU PARTA+1 ADDRESS TO STORE PARTB 00000007 0181 PARTC EQU PARTB+1 ADDRESS TO STORE PARTC 00000008 0182 REPLY EQU PARTC+1 ADDRESS TO STORE REPLY 00000008 0183 ENDSTK EQU REPLY END STACK MARKER 1PAGE 0009 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:02.25 -- C:MGUID0 -- 0185 ************************************************************************  0186 * * 0187 * E I I S E R V I C E --- C : M G U I D 0 --- * 0188 *  * 0189 ************************************************************************ 0000  0190 NAM C:MGUID0 0191 EXTR C:MOVBTS 0192 EXTR G  C:ENTER 0000 FFB7 0038 0192+ C:MGUID0 JSK C:ENTER 0001 000A 0192+ WORD ENDSTK+2 0002 8083 0003 0193 COPY UIDX(X),A FETCH AND SAVE... 0003 8444 0004 0194 COPY A,UID(Y) 0004 8080 0000 0195  COPY PARTAX(X),A 0005 8445 0005 0196 COPY A,PARTA(Y) 0006 8081 0001 0197 COPY PARTBX(X),A 0007 8446 0006 0198 COPY A,PARTB(Y) 0008 8082 0002 0199 COPY PARTCX(X),A 0009 8447 0007 0200 COPY A,PARTC(Y) 000A 8084 0004 0201 COPY REPLYX(X),A 000B 8448 0008 0202 COPY A,REPLY(Y) ... ALL PARAMETERS 0203 * 0204 * FIRST CHECK IF IT WILL FIT AND INSERT COUNTS 0205 * 000C 8145 0005 0206 COPY *PARTA(Y),A 000D 0E79 0207 SHIFT A,RO,8  COUNT FOR PARTA IN A 000E 8544 0004 0208 COPY A,*UID(Y) STORE IN UID 000F C146 0006 0209 COPY *PARTB(Y),Q 0010 4E79 0210 SHIFT Q,RO,8 COUNT FOR PARTB IN Q 0011 0042 0211 ADD Q,A COUNT(A)+COUNT(B) NOW IN A 0012 A147 0007 0212 COPY *PARTC(Y),X 0013 2E79 0213  SHIFT X,RO,8 COUNT FOR PARTC IN X 0014 4E71 0214 SHIFT Q,LO,8 0015 4027 0215  OR X,Q COUNTB / COUNTC NOW IN Q 0016 0022 0216 ADD X,A SUM OF ALL COUNTS IN A 0017 0B03 0217 ADD =3,A ADD THE COUNT BYTES 0018 0DFF 0218 CSK A,=255  IS IT <= 255 CHARS? 0019 9E81 001B 0219 JMP $+2 YES: 001A 9E9B 0036 0220 JMP TOOBIG NO: FLAG AN ERROR 001B 0E71 0221 SHIFT A,LO,8 YES: GET COUNT IN TOP BYTE 001C B544 0004 0222 OR *UID(Y),A OR IN PARTA COUNT 001D 8544 0004 0223 COPY A,*UID(Y) AND STORE IN UID 001E A044 0004 0224 COPY UID(Y),X UID ADDRESS IN X 001F C481 0001 0225 COPY Q,PARTBC(X) STORE COUNTB / COUNTC IN UID 0226 * 0227 * NOW WE MOVE THE DATA 0228 * 0020 4904 0229 COPY =UIDBYTS,Q OUTPUT BYTE INDEX IN Q 0021 8045 0005 0230 COPY PARTA(Y),A 0022 8443 0003 0231 COPY A,ADRIN(Y) PARTA IS ADDRESS IN 0023 2901 0232 COPY =1,X BYTE INDEX IS 1 0024 8145 0005 0233 COPY *PARTA(Y),A 0025 0E79 0234 SHIFT A,RO,8 BYTE COUNT (PARTA) 0026 FF92 0039 0235 JSK C:MOVBTS MOVE THE BYTES 0027 8046 0006 0236 COPY PARTB(Y),A 0028 8443 0003 0237 COPY A,ADRIN(Y) PARTB IS ADDRESS IN 0029 2901 0238 COPY =1,X BYTE INDEX IS 1 002A 8146 0006 0239 COPY *PARTB(Y),A 002B 0E79 0240 SHIFT A,RO,8  BYTE COUNT (PARTB) 002C FF8C 0039 0241 JSK C:MOVBTS MOVE THE BYTES 1PAGE 0010 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:03.75 -- C:MGUID0 -- 002D 8047 0007 0242 COPY H  PARTC(Y),A 002E 8443 0003 0243 COPY A,ADRIN(Y) PARTC IS ADDRESS IN 002F 2901 0244 COPY  =1,X BYTE INDEX IS 1 0030 8147 0007 0245 COPY *PARTC(Y),A 0031 0E79 0246 SHIFT A,RO,8 BYTE COUNT (PARTC) 0032 FF86 0039 0247 JSK C:MOVBTS MOVE THE BYTES 0033 0900 0248  COPY =0,A 0 => ALL OK 0034 8548 0008 0249 BADEX COPY A,*REPLY(Y) STORE REPLY 0250 EXTR C:RETURN 0035 9F84 003A 0250+ JMP C:RETURN 0036 08EB 0251 TOOBIG COPY =-21,A  -21 => FILE NAME TOO BIG FOR UID 0037 9E7C 0034 0252 JMP BADEX ERROR RETURN 0038 0001 C:ENTER 0039 0002 C:MOVBTS 003A 0000 C:RETURN 0253 END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0011 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:05.25 -- C:RDUID0 -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0254 EII: REL 0254+  SHARABLE EII: 0254+ ROMMABLE EII: 00000000 0255 SIDX EQU 0 INPUT ... 00000001 0256 UIDX EQU SIDX+1 00000002 0257 ATERMX EQU UIDX+1 00000003 0258 REPLYX EQU ATERMX+1 ... PARAMETERS 00000002 0259 RCH EQU 2 C:GETUID ... 00000003 0260 RCHX EQU RCH+1 00000004 0261 UID EQU RCH+2 00000005 0262 ATERM EQU RCH+3  00000006 0263 REPLY EQU RCH+4 ... PARAMETER BLOCK 00000007 0264 SID EQU REPLY+1 C:RD0 ... 00000008 0265 ABYTE EQU SID+1 00000009 0266 BCOUNT EQU SID+2 0000000A 0267 ARBCOUNT EQU SID+3 0000000B 0268 REPLY2 EQU SID+4 ... PARAMETER BLOCK 0000000C 0269 RBCOUNT EQU REPLY2+1 REPLY BYTE COUNT 0000000C 0270 ENDSTK EQU RBCOUNT END OF STACK MARKER 1PAGE 0012 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:05.75 -- C:RDUID0 -- 0000 0272 NAM C:RDUID0 0273 EXTR C:RD0,C:GETUID 0274 * 0275 ************************************************************************ 0276 *  * 0277 * E I I S E R V I C E --- C : R D U I D 0 --- * 0278 * * 0279 ************************************************************************ 0280 * 0281 * C:RDUID0 - READS A UID FROM A STREAM. CALLS C:GETUID (WITH C:RD0 AS 0282 * A PARAMETER) TO GET THE CHARS FROM THE INPUT STREAM. 0283 * 0284 EXTR C:ENTER 0000 FF96 0017 0284+ C:RDUID0 JSK C:ENTER 0001 000E 0284+ WORD ENDSTK+2 0002 8080 0000 0285 COPY SIDX(X),A FETCI H AND SAVE ... 0003 8447 0007 0286 COPY A,SID(Y) 0004 8081 0001 0287 COPY UIDX(X),A 0005 8444 0004 0288 COPY A,UID(Y) 0006 8082 0002 0289 COPY ATERMX(X),A 0007 8445 0005 0290 COPY  A,ATERM(Y) 0008 8083 0003 0291 COPY REPLYX(X),A 0009 8446 0006 0292 COPY A,REPLY(Y) 000A 844B 000B 0293 COPY A,REPLY2(Y) ... ALL PARAMETERS 0294 * 0295 * NOW INITIALISE BLOCKS 0296 * 000B 0901 0297 COPY =1,A 000C 8449 0009 0298 COPY A,BCOUNT(Y) C:RD0 TO TRANSFER 1 CHAR 000D 2060 0299 COPY Y,X 000E 2B0C 0300 ADD =RBCOUNT,X 000F A44A 000A 0301 COPY X,ARBCOUNT(Y) ADDRESS OF RETURNED BYTE COUNT SET UP 0010 C287 0018 0302 COPY =C:RD0,Q 0011 C442 0002 0303 COPY Q,RCH(Y) C:RD0 IS THE CHARACTER GETTER 0012 2AFB 0304  ADD =SID-RBCOUNT,X ADDRESS OF SID 0013 A443 0003 0305 COPY X,RCHX(Y) STORE AS X-REG FOR CALL  0306 * 0307 * NOW CALL C:GETUID 0308 * 0014 2AFB 0309 ADD  =RCH-SID,X X POINTS TO C:GETUID PARAMETER BLOCK 0015 FF83 0019 0310 JSK C:GETUID GET THE UID  0311 EXTR C:RETURN 0016 9F83 001A 0311+ JMP C:RETURN 0017 0001 C:ENTER 0018 0003 C:RD0 0019 0002 C:GETUID 001A 0000 C:RETURN 0312 END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0013 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:08.25 -- C:IPUID0 -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0313 EII: REL 0313+ SHARABLE EII: 0313+ ROMMABLE EII: 00000000 0314 MADRX EQU 0 INPUT ... 00000001 0315 SBYTEX EQU MADRX+1 00000002 0316 LENGTHX EQU SBYTEX+1 00000003 0317 UIDX EQU LENGTHX+1 00000004 0318 ATERMX EQU UIDX+1 00000005 0319 REPLYX EQU ATERMX+1  ... PARAMETERS 00000002 0320 RCH EQU 2 C:GETUID ... 00000003 0321 RCHX EQU  RCH+1 00000004 0322 UID EQU RCH+2 00000005 0323 ATERM EQU RCH+3 00000006 0324 REPLY EQU RCH+4 ... PARAMETER BLOCK 00000007 0325 MADR EQU REPLY+1 C:GCFM ... 00000008 0326 ABYTE EQU MADR+1 00000009 0327 CUBYTE EQU MADR+2 0000000A 0328 LENGTH EQU MADR+3 ... PARAMETER BLOCK 0000000A 0329 ENDSTK EQU LENGTH END OF STACK MARKER 1PAGE 0014 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:08.50 -- C:IPUID0 -- 0000 0331  NAM C:IPUID0 0332 EXTR C:GCFM,C:GETUID 0333 * 0334 ************************************************************************ 0335 * J  * 0336 * E I I S E R V I C E --- C : I P U I D 0 ---  * 0337 * * 0338 ************************************************************************ 0339 * 0340 * C:IPUID0 - READS A UID FROM MEMORY. CALLS C:GETUID (WITH C:GCFM AS 0341 * A PARAMETER) TO GET THE CHARS FROM MEMORY. 0342 * 0343 EXTR C:ENTER 0000 FF96 0017 0343+ C:IPUID0 JSK C:ENTER 0001 000C 0343+ WORD ENDSTK+2 0002 8080 0000 0344 COPY MADRX(X),A FETCH AND SAVE ... 0003 8447 0007 0345 COPY A,MADR(Y) 0004 8081 0001 0346 COPY SBYTEX(X),A 0005 8449 0009 0347  COPY A,CUBYTE(Y) 0006 8082 0002 0348 COPY LENGTHX(X),A 0007 844A 000A 0349 COPY A,LENGTH(Y) 0008 8083 0003 0350 COPY UIDX(X),A 0009 8444 0004 0351 COPY A,UID(Y) 000A 8084 0004 0352  COPY ATERMX(X),A 000B 8445 0005 0353 COPY A,ATERM(Y) 000C 8085 0005 0354 COPY REPLYX(X),A 000D 8446 0006 0355 COPY A,REPLY(Y) ... ALL PARAMETERS 0356 * 0357 * SET UP THE X-REGISTER FOR CHAR-GETTER AND CHAR-GETTER ADDRESS 0358 * 000E 0060 0359 COPY  Y,A 000F 0B07 0360 ADD =MADR,A 0010 8443 0003 0361 COPY A,RCHX(Y) X REGISTER FOR C:GCFM 0011 8286 0018 0362 COPY =C:GCFM,A 0012 8442 0002 0363 COPY A,RCH(Y) SET UP ADDRESS OF CHAR-GETTER 0364 * 0365 * NOW INPUT UID VIA C:GETUID 0366 * 0013 2060  0367 COPY Y,X 0014 2B02 0368 ADD =RCH,X X SET UP FOR C:GETUID 0015 FF83 0019 0369 JSK C:GETUID INPUT THE UID 0370 EXTR C:RETURN 0016 9F83 001A 0370+  JMP C:RETURN 0017 0001 C:ENTER 0018 0003 C:GCFM 0019 0002 C:GETUID 001A 0000 C:RETURN 0371  END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0015 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:10.75 -- C:CGFM -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST  0000 0002 0372 EII: REL 0372+ SHARABLE EII: 0372+ ROMMABLE EII:  00000000 0373 MADRX EQU 0 MEMORY ADDRESS 00000001 0374 ABYTEX EQU MADRX+1 ADDRESS TO STORE BYTE 00000002 0375 CUBYTEX EQU MADRX+2 CURRENT BYTE NUMBER 00000003 0376 LENGTHX EQU MADRX+3 LENGTH OF ITEM IN BYTES 00000002 0377 MADR EQU 2 MEMORY ADDRESS 00000003 0378 ABYTE EQU MADR+1 ADDRESS TO STORE BYTE 00000003 0379 ENDSTK EQU ABYTE END OF STACK MARKER 1PAGE 0016 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:11.00 -- C:GCFM -- K  0000 0381 NAM C:GCFM 0382 * 0383 * C:GCFM - GETS A CHARACTER FROM MEMORY. DECREMENTS LENGTH AND STORES 0384 * IT BACK. RETURNS -1 IF LENGTH IS 0. 0385 * INCREMENTS BYTE NUMBER. 0386 * 0387 EXTR C:ENTER 0000 FF98 0019 0387+ C:GCFM JSK C:ENTER 0001 0005 0387+ WORD ENDSTK+2 0002 8080 0000 0388 COPY MADRX(X),A 0003 8442 0002 0389 COPY A,MADR(Y) SAVE MEMORY ADDRESS 0004 8081 0001 0390 COPY ABYTEX(X),A 0005 8443 0003 0391 COPY A,ABYTE(Y) AND ADDRESS TO STORE BYTE 0006 8083 0003 0392 COPY LENGTHX(X),A LENGTH IN A 0007 114F 0017 0393 JEQ A,EOSTRING HERE MUST RETURN -1 0008 0AFF 0394 SUB =1,A LENGTH-1 0009 8483 0003 0395 COPY A,LENGTHX(X) STORE DECREMENTED X 000A C082 0002 0396  COPY CUBYTEX(X),Q CURRENT BYTE NUMBER IN Q 000B DC82 0002 0397 IMS CUBYTEX(X) INCREMENT BYTE COUNT 000C 2040 0398 COPY Q,X BYTE INDEX IN X 000D C042 0002 0399 COPY MADR(Y),Q  MEMORY ADDRESS IN Q 000E 6048 0400 EXCH Q,Y Y=MEM ADDRESS, SAVE Y IN Q 000F 0E25 0401  SBIT 2,S BYTE MODE 0010 80C0 0000 0402 COPYB 0(Y,X),A GET BYTE 0011 0E27 0403  RBIT 2,S WORD MODE 0012 6040 0404 COPY Q,Y RESTORE Y 0013 0E71 0405 SHIFT A,LO,8 GET CHAR IN TOP BYTE 0014 8543 0003 0406 EXWB COPY A,*ABYTE(Y) STORE BYTE WHERE REQUIRED 0015 0900 0407 COPY =0,A 0 => GOOD REPLY (NEVER BAD!!) 0408 EXTR C:RETURN 0016 9F83 001A 0408+ JMP C:RETURN 0017 08FF 0409 EOSTRING COPY =-1,A -1 MEANS END OF BYTES 0018 9E7B 0014 0410 JMP EXWB EXIT WITH BYTE (WORD) 0019 0001 C:ENTER 001A 0000 C:RETURN 0411 END 0000 ERRORS (0000/0000) 0000 WARNINGS (0000/0000) 1PAGE 0017 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:15.75 -- C:GETUID -- SI = DH01.NEWEII2.ASM SO = DH01.NEWEII.LIB LO = DH01.NEWEII.LST 0000 0002 0412 EII: REL 0412+ SHARABLE EII:  0412+ ROMMABLE EII: 00000000 0413 GCRX EQU 0 CHAR-GETTER FUNCTION ADDRESS 00000001 0414 XRX EQU GCRX+1 X-REG ON CALL TO GCRX 00000002 0415 UIDX EQU XRX+1 UID ADDRESS 00000003 0416 ATERMX EQU UIDX+1 ADDRESS TO STORE TERMINATOR 00000004 0417 REPLYX EQU ATERMX+1 ADDRESS TO STORE REPLY 00000002 0418 COUNT EQU 2 COUNT (USED BY C:MOVBTS - MUST KEEP IN STEP) 00000003 0419 ADRIN EQU COUNT+1 ADDRESS IN (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000004  0420 ADROUT EQU ADRIN+1 ADDRESS OUT (FOR BY C:MOVBTS - MUST KEEP IN STEP) 00000004 0421 UID EQU L  ADROUT UID ADDRESS (IS ADDRESS OUT) 00000005 0422 MAXCHS EQU ADROUT+1 PARAMETERS FOR C:RDSTR ...  00000006 0423 ASTRING EQU MAXCHS+1 STRING ADDRESS 00000007 0424 RCH EQU MAXCHS+2 CHARACTER-GETTER 00000008 0425 XRCH EQU MAXCHS+3 X-REG FOR RCH 00000009 0426 AACTLEN EQU MAXCHS+4 ADDRESS OF ACTUAL STRING LENGTH 0000000A 0427 ATERM EQU MAXCHS+5 ADDRESS TO STORE TERMINATOR  0000000B 0428 REPLY EQU MAXCHS+6 ... END OF PARAMETERS 0000000C 0429 ACTLEN EQU REPLY+1  ACTUAL STRING LENGTH 0000000D 0430 UIDL EQU ACTLEN+1 UID LENGTH (BYTES) 0000000E 0431 PALEN EQU UIDL+1 PART A LENGTH (BYTES) 0000000F 0432 PBLEN EQU PALEN+1 PART B LENGTH (BYTES) 00000010 0433 PCLEN EQU PBLEN+1 PART C LENGTH (BYTES) 00000011 0434 STRING EQU PCLEN+1 STRING (11 CHARS, 6 WORDS) 00000017 0435 ENDSTK EQU STRING+6 END OF STACK MARKER 1PAGE 0018 MACRO (F300) EXTENDED I/O INTERFACE - NEWEII2.ASM - 93530-12 E810 1982/02/02 14:27:16.75 -- C:GETUID -- 0437 *  0438 * C:GETUID - GENERAL UID GETTER, CALLED BY C:RDUID0 AND C:IPUID0 TO 0439 * PRODUCE A UID FROM A CHARACTER GETTER FUNCTION. 0440 * CALLS C:RDSTR TO READ STRINGS. 0441 * CALLS C:MOVBTS TO MOVE BYTES INTO THE UID. 0442 * 0000 0443 NAM C:GETUID 0444  EXTR C:RDSTR,C:DIBCH,C:MOVBTS 0445 EXTR C:ENTER 0000 FFB1 0032 0445+ C:GETUID JSK C:ENTER 0001 0019 0445+ WORD ENDSTK+2 0002 8080 0000 0446 COPY GCRX(X),A FETCH AND SAVE ... 0003 8447 0007 0447 COPY A,RCH(Y) 0004 8081 0001 0448 COPY XRX(X),A 0005 8448 0008 0449 COPY A,XRCH(Y) 0006 8082 0002 0450 COPY UIDX(X),A 0007 8444 0004 0451 COPY A,UID(Y) (ITS ADDRESS OUT) 0008 8083 0003 0452 COPY ATERMX(X),A 0009 844A 000A 0453 COPY A,ATERM(Y) 000A 8084 0004 0454 COPY REPLYX(X),A 000B 844B 000B 0455 COPY A,REPLY(Y) ... ALL PARAMETERS 0456 * 0457 * NOW SET UP ADDRESSES 0458 * 000C 0060 0459  COPY Y,A 000D 0B0C 0460 ADD =ACTLEN,A 000E 8449 0009 0461 COPY A,AACTLEN(Y) ADDRESS TO STORE ACTUAL LENGTH 000F 0B05 0462 ADD =STRING-ACTLEN,A 0010 8446 0006 0463 COPY A,ASTRING(Y) ADDRESS OF STRING 0011 8443 0003 0464 COPY A,ADRIN(Y) IS ALSO ADDRESS IN FOR FOR C:MOVBTS  0465 * 0466 * NOW ZERO THE LENGTHS AND SET UP UID LENGTH 0467 * 0012 0904 ’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I’I