/LIBRARY AND FILE COMMAND PROCESSOR: /****** FIELD 0 DIRECTORY ****** /***** ***** /* 0200 HANDLER TABLES, BUFFER I/O /* 0400 ERROR MESSAGES (OPTIONAL) /* 2000 BUFFERS (4X 2 PAGES EACH) /* 4000 HANDLER AND STACK AREA /* 5200 PUSHDOWN (STACK) ROUTINES /* 5400 GETHND (MULTI-USE VERSION) /* 5600 FILE OUTPUT, CLOSE & ABORT /* 6000 FILE IN AND INPUT COMMANDS /* 6200 TAB, OUTPUT, ECHO COMMANDS /* 6400 ERASE, SAVE, LOAD, GO & DO /* 6600 I/O/U, JUMP TABLES, LSORTJ /* 7000 DIRECTORY LISTING ROUTINES /* 7200 OPEN, USR, IOWAIT, COMPARE /* 7400 FILE NAME PROCESSOR /***** ***** /************************************ / INITIAL TEXT FOR LAB-FOCAL: (XS40) FIELD 2 PAGE 1 0 /PROGRAM LENGTH 1011 /'()' FOR TDUMP LINE0, 0 /POINTER TO NEXT 0 /LINE NO. ZERO XS40 "C LAB-FOCAL:" TITLE, XS40 "VER-5E" /'@M'=CODED CR DATE, / YR.MO.DA=1, MO/DA/YR=0, DA.MO.YR= -1 IFNDEF DASTYL /DEFAULT=MO/DA/YR IFZERO DASTYL+1 IFZERO DASTYL+0 IFZERO DASTYL-1 LINE1=. /ALLOW 1 EXTRA WORD /PAGE ZERO STORAGE HAS BEEN VERY CAREFULLY ARRANGED ! FIELD 0 PAGE 0 INBLKS= [1^[2^[3^[4 /RESERVE THE LAST 4 LOCS. 0 /INTERRUPT SERVICE ROUTINE CDI P JMP I [INTRPT PRNTSP, RMF /RETURN FROM THE INTERRUPT ION L5400, JMP I 0 USR, 7700 /POINTER TO MONITOR (200 IF IN CORE) K77, 77 /LOCATION 7 FOR HISTORIC REASONS AUTO, ZBLOCK 4 /AUTO-INDEX REGISTERS HTABL, ZBLOCK 4 /HANDLER USAGE TABLE NONAME, LPUSHF /INSERT VERS. NO. AFTER 'ERASE' L0RD, VERSION /'LPUSHF' = 'ECHOC' PRNTC, LPOPF /'LPOPF' = 'PRINTC' XCHAR, NAMLOC-1 /ADDRESS OF 'CHAR' JMS TEMP /GO UPDATE THE HEADER IOWAIT, SP1 /ENTER HERE AFTER 'DELETE' DCA GOSW DCA LIBFLG /ZAP 'PROGRAM SAVED' FLAG TAD GOSW /RETURN PT FOR LOAD CALLS EXIT, TAD GOJUMP /NORMAL RETURNS='JMP I (PROC' DCA GOSW DISMISS /REMOVE THE USR CDI P I0N /'0' IF INTERRUPTS ARE OFF GOSW, [DERR /LOWER FIELD ERROR ROUTINE DISMISS /CLEARS AC AND LINK TAD GOSW /(RELOCATE FOR LINC INTERRUPTS) CDI P DCA I [ERROR /SIMULATE A 'JMS' DSK, 5600 ERORP1 /'DSK' = 5723 ERROR0= JMS I . /'SOFT' ERRORS TRAP ERROR1= JMS GOSW /'HARD' ERRORS *HORD GOJUMP, 5600 K177-1 /PLUS (GOSW) VERSION,TEXT "VER-5E" /VERSION ID *VERSION+3 /BACKSPACE OVER FILL WORD OBSW, ERTRAP /-2 LOAD 'N GO DEWPT /-1 CONT / 0 K177, START /+1 GOTO+1 /+2 LIBHND, ZBLOCK 4 /E.P., NAME(2), DEV. NO. DEVNO= .-1 NEWDEV, ZBLOCK 4 /NAME(2), LENGTH, ORIGIN FLNGTH= .-2 STBLK= .-1 CHAR, 0 /LOWER FIELD COPY NAMLOC, ZBLOCK 4 /(MUST BE 'CHAR+1') EXTENSION=.-1 /(MUST BE 'M1400-1') BUFR, /(MUST BE 'LIBDEV-1') M1400, 6400 /ALSO POINTER TO F1 F.P.P. LIBDEV, ZBLOCK 4 /DEVICE NAME, LENGTH, ORG LIBFLG= .-1 *100 PC0, 0 /ENTRY AND RESTART POINT IFDEF MEM <*PC0;MEM&7>/SET DEFAULT MEMORY SIZE CB, 5600 . /INITIALIZE (ONCE ONLY) JMP IOWAIT /RETURN TO COMMAND MODE FL, 0 /CURRENT INPUT FILE SIZE *106 /'1970', 'UNAVAL' TEMP, 0 /UPDATE THE HEADER TAD XCHAR /NAMLOC-1 CIF T JMP NUHEAD M200,; IFNZRO .+7666 <'AND L7600'.NE.'-7666'> L7600, 7600 /CLA JMP I TEMP INBLK, 0 /INPUT FILE PARAMETER BLOCK INFLG, 0 /(OPBLKS IS A COPY OF THIS) ISWCH, 0 IPNTR, 0 OPTR1, 0 /OUTPUT PACKING POINTERS OPTR2, 0 OUTFLG, 0 /ACTIVE OUTPUT FILE FLAG *123 ERORP1, ERROR+1 /FOR 'DSK' OECONT, JMS I [SETODV /SET NEW OUTPUT DEVICE XI33 EKODEV, XOUTL /DEFAULT IS 'TERMINAL' /DEFINE LOWER-FIELD MACROS: LSORTJ= JMS I . /BRANCH FROM CHAR LIST SORTER SCANLN= JMS I . /LOOK FOR A TERMINATOR SCANER GETOPT= JMS I . /EVALUATE '/N' OPTION BUFOPT GETHND= JMS I . /LOAD A HANDLER HANDLR GETUSR= JMS I . /LOAD USER SERVICE ROUTINE USRIN DISMIS= JMS I . /REMOVE USER SERVICE ROUTINE USROUT *ECHOC&177 /FOR INPUT ECHO & INITIALIZE LPUSHF= JMS I . MPUSHF /PUSH 4 WORDS ON STACK LPOPF= JMS I . MPOPF /POP 4 WORDS TO 'ARG+1' COMPAR= JMS I . NCOMP /COMPARE N CONSECUTIVE WORDS GTNAME= JMS I [NAME *INBLKS+4 OUTHND= INBLKS /OUTPUT BLOCK = INPUT BLOCK ZERO OUTDVN= INBLKS+3 ZBLOCK 4^3 /ENTRY POINT, NAME(2), DEVICE NO. OPBLKS, ZBLOCK 6^4 /C(FL,SB,INBLK,INFLG,ISWCH,IPNTR) TSKTBL, ZBLOCK 14 /TASK ASSIGNMENT TABLE FOR 'FQUE' CLRTBL,/TAD (TSKTBL-1 /ROUTINE TO CLEAR THE TASK TABLE DCA CLRTBL-1 ISZ CLRTBL-1 DCA I CLRTBL-1 TAD CLRTBL-1 SZA CLA JMP CLRTBL+1 CDI T JMP NIGHT /'FL0ATR' /THE 'O L' COMMAND FOR SELECTING THE L.P. HANDLER OLCMD, GTNAME /CHECK THE ECHO SWITCH JMS I [SETODV LPECHO /CHANGE OUTPUT DEVICES LPCALL OPTL, TAD .-1 /PROCESS THE ',L' OPTN. JMP I .+1 OPTE+1 ///// OPCMD, JMS I [SETODV /THE 'OUTPUT PLOT' COMMAND XOUTL XOUTL /PATCHED BY PLOTER OVERLAY /THE 'I/O B' COMMANDS USE ONE OF THE 4 BUFFERS: IOB, SZA /VIA 'INDEV' OR 'OUTDEV' JMP OB TAD I IBADR /GET NEXT CHARACTER SZA ISZ IBADR /BUMP IF NOT AT EOB SNA TAD [EOF /GET EOF CODE IOX, CDI P JMP I IOBRTN ///// OB, DCA I OBADR /STORE CHAR IN BUFFER TAD I OBADR / AND K177 /OPTIONAL TAD [-LF SNA ISZ OBSW /CR/LF PAIR? SKP JMP SKIPLF /YES TAD [-4 DCA OBSW /SET -1 FOR CR TAD OBCNT SMA CLA JMP OBFULL ISZ OBCNT /TEST WORD COUNT ISZ OBADR SKIPLF, DCA I OBADR /SET 'EOB' FLAG JMP IOX ///// OBFULL, DCA I OBADR /CLEAR EXTRA CHARS ERROR1 IOBRTN, IO2BUF+3 ///// OBADR, 0 OBCNT, 0 IBADR, HTABL+3 ///// IBCMD, JMS I GETBUF /GET THE BUFFER ADDRESS SKP /NONE = USE CURRENT ONE DCA IBADR TAD OBSET+2 /NOW SWITCH INPUT DEVICE JMP I [SETIDV /(AND CHECK ECHO SWITCH) OBCMD, JMS I GETBUF /GET BUFFER ADDRESS JMP OBSET /NONE = USE CURRENT DCA OBADR TAD [-400 /ALSO SET CHAR CNT DCA OBCNT DCA OBSW OBSET, JMS I [SETODV IO2BUF /NO ECHO ON OUTPUT IO2BUF GETBUF, GETBAD /INITIALIZE THE VARIABLES AND THE DATE *4400 INITLZ, TAD STRTUP+2 /USER INITIALIZATION CODE DCA I .+3 /SET RESTART ADDRESS, JSW DCA I .+3 JMP .+3 /FOR CCLX CALLS 7745 7746 ZBLOCK 24 JMS MOVEUP /LOAD COMMAND DECODER AREA PVPT, PUTV RELOC RANDOM-14 PUTV= .-1 PUSHJ /CLEAR THE SYMBOL TABLE ZINITL SETSVP /POINT TO 'PI' FENT FGET I PIPTR /GET THE VALUE OF 'PI/2' FPUTIPT1 /AND PLACE IN FIRST S.V. FEXT . JMS T1 /SET D.F. TO SECRET VAR. ISZ I PT1 /CHANGE 'PI/2' INTO 'PI' DCA I XRT2 /CLEAR THE OTHER S.V.'S ISZ RANDOM /ALSO CLEAR THIS LOCATION JMP .-2 RANDOM, -4^6 /6 SECRET VARIABLES + PI CDI T JMP DATEP /NOW FINISH STARTUP CODE PIPTR, PIOV2 RELOC; 0 MV0, TAD I (17726 AND [200 /CHECK 'SCOPE MODE' BIT SNA DCA I (MODLN /REMOVE LINENO PRINTOUT JMP I (ENVIR+1 /INSTALL RUBOUT PATCHES CKOS8, SMA CLA /SKIPS THE SECOND TIME TAD PC0+1 /CHECK THE OS/8 LIMIT SZA /ALWAYS SKIPS THE 2ND TIME JMP CKPC0-1 /NOT ZERO OR GT INT. LIMIT TAD PC0 /USE INTERNAL FIELD LIMIT DCA PC0+1 /AND FALL THRU TO 'CDF10' CLL CIA /NEGATE; SET LINK IF AC=0 CKPC0, TAD PC0 /CHECK THE INTERNAL LIMIT SNL SZA /L=1 IF OS/8 IS .LE. PC0 JMP CKOS8 /NON-ZERO, COMPARE WITH OS8 TAD PC0+1 /NOW CHECK THE 'SOFT' LIMIT SZA CLA JMP CDF10 /IF NON-ZERO, SKIP PHYSICAL CHECK / THIS IS A DESTRUCTIVE MEMORY TEST: LOCATION 7200 IS USED / SINCE IT CAN BE CHANGED IN ALL FIELDS WITHOUT DESTROYING / ANYTHING. MCHK, RDF TAD CDF10 /INCREMENT THE 'CDF' DCA .+1 HLT /'CDF X' SM2 DCA I [7200 /TRY TO STORE A '-2' C6, 6 /A PDP-8 WILL SKIP THIS ISZ I [7200 /NOW INCREMENT IT: '12'S MAY SKIP ISZ I [7200 /DOUBLE-CHECK (A PDP8 SKIPS THIS) JMP CDF10 /DIDN'T SKIP 2ND TIME, OR DID 1ST ISZ PC0+1 /THIS FIELD IS OK: COUNT IT RDF TAD M70 /HAVE WE TESTED FIELD 7? M70, SPA CLA JMP MCHK /NO, TRY THE NEXT FIELD CDF10, CDF P /FILL IN 'ZERO' PARAMETERS SM2 TAD PC0+1 /CHECK FOR AT LEAST 12K SPA SNA PATCH, JMP GOJUMP /ERROR IF ONLY 8K DCA I MOVEUP-3 TAD I MOVEUP-3 /NUMBER OF VARIABLE FIELDS CMA DCA I MOVEUP-2 /MAX NUMBER OF VAR. FIELDS TAD I C106 /GET NO. OF UNAVAILABLE SLOTS CMA /-1 COMPENSATES FOR EXTRA ISZ TAD (SPF-7 /'-7' BECAUSE C106=(34)+(6^7) DCA TEMP /INITIALIZE THE QUOTIENT TAD I (FIRSTV /GET START OF SYMBOL TABLE TAD C106 /ROOM FOR SECRET VARIABLES STL CIA ISZ TEMP /COUNT LOSS OF EACH VARIABLE TAD C6 SZL JMP .-3 SM2 /DISCARD REMAINDER C106, AND TEMP /MAKE SURE QUOTIENT IS EVEN DCA I MOVEUP-1 /(THIS WAS THE HARD ONE!) CIF P /NOW GO CLEAR THE SYM. TABLE DCA I PVPT+7 /FIX 'FEXT' JMS I PVPT /(RETURNS TO 'STRTUP' VIA F2) NUMVF /'ZERO' PARAMETERS MAXVF MISING MOVEUP, 0 /CLEVER LITTLE ROUTINE CDF L TAD I MOVEUP /WHERE ITS GOING DCA AUTO ISZ MOVEUP TAD I MOVEUP /WHERE ITS AT CDF P SNA JMP I MOVEUP /DF=P DCA I AUTO CDF L JMP MOVEUP+4 STRTUP, KSF /KEYBOARD INPUT? (7344) JMP NONAME / (5031) PC0 /RESET THE FLAG JMP IOWAIT /LEAVE VERSION ID PAGE / CHECK THE RUN-TIME ENVIRONMENT P07777, 07777 /BATCH & RTS8 FLAGS ENVIR, CKPC0 /RETURN POINT SNA /CHECK AC FOR 'SCOPE MODE BIT JMP .+5 /NONE: SAVE THE SOFTWARE SIZE TAD ["H&77 DCA I MV2-1 /PUT '210' IN LOC '10000' TAD NONAME DCA I (RUB1+4 /CHANGE TO VIDEO RUBOUTS CDF 0 TAD I P07777 /SAVE THE OS/8 SIZE AND [70 CLL RAR CLL RTR DCA PC0+1 /ZAP INITIALIZATION / CALLED BY BATCH OR RUNNING UNDER RTS8? TAD I P07777 /2000=BATCH, 1000=RTS8 STL RTL SNL SMA CLA /EITHER BATCH OR RTS8? JMP I ENVIR /NO - EXIT (L=0) JMS I MV1 /MAKE NON-INTERRUPT HESITATE HESI RELOC HESI+1 CLA IAC /1'S COMPLEMENT NEGATE MULT10 /10 MSEC DELAY TAD OTIM DCA HORD /INITIALIZE LOOP ISZ LORD JMP TEMP1 /NON-STOPPABLE... RELOC; 0 JMS I MV1 /CHANGE TO NON-INTERRUPT I/O XI33P1, XI33+1 /RELOCATION POINTER MV1= .+10 RELOC XI33+2 /XI33, 0 / KSF /ANY INPUT? JMP .-1 JMS KCHK /PROCESS IT TAD INBUF DCA XOUTL /SAVE CHAR KCC DCA INBUF /RESET FLAG TAD XOUTL JMP I XI33 XOUTL, MOVEUP TLS /THIS IS ALL WE NEED! 7600 /'CLA' = MONITOR EXIT TSF /BUFFER FULL? JMP .-1 JMS KCHK /CHECK FOR INPUT JMP I XOUTL BYEBYE, CDI /RETURN TO OS/8 JMP I XOUTL+2 JMP I 0 /OR TO BATCH... POPX, XPUSHA+3 /CHECK INPUT AFTER A 'PUSH' JMS KCHK JMP I POPX KCHK, POPX+1 /KEYBOARD CHECK KSF JMP I KCHK /NOTHING THERE KRS AND P177 SNA JMP I KCHK /IGNORE NULLS DCA INBUF TAD INBUF TAD MCC SNA /CTRL C? JMP BYEBYE TAD MCC SNA CLA /CTRL F? JMP M20+2 JMP I KCHK RELOC; 0 MV2, TAD MV2-20 /MOVE 'KSF' DCA I XI33P1 /INTO PLACE / DISABLE ALL THE 'IONS' DCA I ERORP1 TAD [7400 /NOP DCA I (NOTCR+3 ICH2P, CDF L DCA GOSW-1 TAD MV2-21 DCA I (PCHK!177 /APUSHX DCA I (FLOUTP+3 DCA I ICH2P /ICHAR2+2 DCA I (OCHAR0+3 DCA I (IOWATE+2 / CHECK FOR BATCH STL RTR AND I P07777 /CHECK THE BATCH BIT (L=0) SNA CLA JMP I ENVIR /NOT RUNNING UNDER BATCH TAD I P07777 AND [70 /GET THE BATCH FIELD TAD MV3-5 /ADD 'CIF' DCA MV3-5 /SET UP THE INSTRUCTION JMS I MV1 /INSTALL BATCH I/O CALLS XI33+2-1 RELOC XI33+2 /XI33, 0 / CIF BF /CHANGE TO THE BATCH FIELD JMS I POPX-1 /READ FROM THE BATCH STREAM ERROR2 /NOTHING LEFT! TAD .+5 SNA JMP XI33+1 /IGNORE LINEFEEDS TAD CLF JMP I XI33 -LF-200 /BATCH SETS '200' BIT XOUTL, ERRX /OUTPUT TO THE BATCH LOG CIF /'PATCHED FOR BATCH' 7000 /'NOP' = BATCH EXIT JMS I .+1 /'BATIN' = '5400' 7400 /'BATOUT' = '7400' RELOC; 0 MV3, TAD MV2-6 /PATCH THE ERROR ROUTINE DCA I MV3-6 TAD MV3-5 /MOVE UP THE 'CIF' INSTR DCA I XI33P1 /TO 'XI33+1' TAD MV3-5 DCA I (BYEBYE /AND TO 'BYEBYE' TAD PC0 STL CIA /COMPARE USER LIMIT WITH BATCH SZA /FORCE BATCH LIMIT IF ITS ZERO TAD PC0+1 SMA SZA CLA JMP I ENVIR /USER LIMIT IS LESS THAN BATCH TAD [-400 DCA I (UNAVAL /REDUCE THE TABLE SIZE BY 256. JMP I ENVIR *GOSW /ADD 12K PATCH PATCH+1 *CONT SZA CLA JMP GOSW+2 /8K IS NOT ENOUGH! TAD FCDF DCA I CDFVP /MOVE VARIABLES TO F2 TAD I NOTAV CLL IAC /CHECK FOR -1 SNL CLA JMP .+3 /DON'T CHANGE 'UNAVAL' TAD LCNT DCA I NOTAV IAC RTR /4000 OR 6000 TAD [200 DCA I VSTRT SM1 TAD I VSTRT /COMPUTE TEXT END CIA DCA I TFINI IAC JMP I GOSW /SIZE UP THE VARIABLES TFINI, TXTEND VSTRT, FIRSTV NOTAV, UNAVAL CDFVP, CDFSV /THE STACK AND VARIOUS STACK ROUTINES LIVE HERE *5230-1 /START THE STACK HERE PCHK, (XPUSHA+3 /STACK OVERFLOW CHECK CDF P TAD I [PDLXR /ADJUST STACK POINTER DCA PDLXR TAD [-4 /SET LOOP COUNTER DCA LCNT TAD PDLXR /BACKUP AND COPY DCA I [PDLXR TAD PDLXR /CHECK FOR OVERFLOW STL CIA TAD STKLMT /UNUSED HANDLER SPACE CDF L SPA SNA SZL CLA /-10 = L-P JMP I PCHK /L=1 PDERR, TAD DSK-2 /TOO BAD! JMP DSK-2 /USE 'CDI P' AS THE ERROR CODE STKLMT, HNDLRS /TOP OF STACK (SET BY 'STKADJ') IFNZRO .-XPUSHJ MPUSHF, 0 /PUSH 4 WORDS ON THE STACK TAD PDERR-2 /LOWER FIELD ENTRY TAD PCHK+1 /UPPER FIELD ENTRY DCA FCDF CLL CMA TAD I MPUSHF /BACKUP POINTER ISZ MPUSHF DCA AUTO TAD [-4 JMS PCHK FCDF, CDF T /CHANGE TO CALLING FIELD TAD I AUTO CDF S DCA I PDLXR /LOAD STACK ISZ LCNT JMP FCDF /WITH FOUR WORDS SP2 TAD FCDF /CHANGE 'CDF' TO 'CDI' DCA .+1 LCNT, -27 JMP I MPUSHF APUSHX, DCA MPUSHF /PUSH THE AC ON THE STACK SM1 JMS PCHK /SETS L=1 TAD MPUSHF DCA I PDLXR CDI P JMP I (XPUSHA+3 /ONLY USED BY FIELD 1 MPOPF, 0 /POP 4 WORDS INTO FIELD 0 TAD I MPOPF DCA AUTO JMS PCHK /COPY PDLXR TAD I PDLXR DCA I AUTO ISZ LCNT JMP .-3 SP4 JMS PCHK /ADJUST THE REAL SP ISZ MPOPF JMP I MPOPF STKADJ, TAD STKLMT TAD M200 /DECREMENT LOWER LIMIT DCA STKLMT TAD STKLMT TAD M1400 /CONVERT '5000' TO '16' JMS I APUSHX+1 /SHFTL6='DIVIDE BY 200' DCA HTABL-1 TAD I HTABL-1 /CHECK PAGE MAP SPA SNA CLA JMP STKADJ /REPEAT IF IT'S UNUSED JMP I (USECNT+11 *RESTORE RESTOR, 0 DCA GOSW /SAVE ERROR CODE KCC TAD I (SWAPIN /CHECK SWAP FLAG SNA CLA JMS I (SWAPIN /RESTORE SWAP AREA CDI P TAD GOSW /REPLACE ERROR CODE DCA I [LINENO TAD EKODEV-1 /RESET DEFAULT I/O DEVICES DCA I [INDEV TAD EKODEV /= TERMINAL, LPT, OR SCOPE DCA I [OUTDEV TAD PRNTC /AND TURN ON THE ECHO, TOO DCA I [IECHO JMP I RESTORE /NOW GO PRINT ERROR MESSAGE ///// BUFOPT, 0 /CHECK BUFFER OPTION - 'GETOPT' CMA DCA GOSW TAD I BUFOPT /ALSO SETS GOSW AND EXTENSION ISZ BUFOPT DCA EXTENSION SCANLN TAD (200-"/ /LOOK FOR A '/' STL CIA SNL SMA JMS I .-1 /CALL 'MGETA' (L=0) SZL CLA CMA /DEFAULT = -1 DCA MPOPF TAD TEMP /RESTORE CHAR DCA CHAR JMP I BUFOPT /DF=P IF BUFFER SPECIFIED ///// PAGE / DYNAMIC HANDLER ALLOCATION ROUTINE -JVZ- / THIS ROUTINE MANAGES 4 PAGES OF MEMORY, ALLOWING UP TO / 4 SINGLE-PAGE HANDLERS OR 2 TWO-PAGE HANDLERS TO BE IN / USE AT ANY ONE TIME. SINCE ONLY THE SYSTEM HANDLER IS / GENERALLY USED FOR MOST OPERATIONS, THE STACK HAS BEEN / ARRANGED TO EXPAND INTO WHATEVER FREE SPACE REMAINS. USECNT, 0 /INCREMENT/DECREMENT USE COUNT DCA HNDEP /SAVE ENTRY POINT SM1 DCA HNDPG /BE SURE WE DON'T REMOVE 'SYS' TAD HNDEP AND L7600 SZA TAD [-7600 SNA JMP I USECNT /NO HANDLER (OR SYSTEM HANDLER) TAD M1400 /7600-HNDLRS+2600(=HTABL-1^200) JMS I USECNT+2 /'SHFTL6' DCA TBLPT /INDEX INTO USE-COUNT TABLE USCNT1, ISZ TBLPT TAD I TBLPT /OCCUPIED TAD I USECNT /ADD OR SUBTRACT '10' SPA AND HAND1 /UNDERFLOW, KEEP '2-PAGE' BIT DCA I TBLPT TAD I TBLPT /CHECK FOR SECOND PAGE CLL RAR SNA /STILL IN USE? DCA I TBLPT /NO, CLEAR '2-PAGE' BIT DCA HNDPG /SAVE NEW COUNT SZL JMP USCNT1 /COUNT SECOND PAGE TOO TAD L5400 JMP I .+1 /ADJUST THE STACK LIMIT STKADJ+1 ///// HANDLR, 0 /AC = HANDLER BLOCK ADDRESS DCA SLOT TAD I SLOT /CHECK RESIDENT STATUS SZA CLA SM2 COMPARE /CHECK FOR THE SAME NAME TO SLOT, 0 /AVOID LOADING HANDLER AGAIN NEWDEV-1 JMP NOTEQ /NEW NAME = NEW HANDLER! TAD I AUTO 2 HANDX, DCA TEMP /COPY OLD (NEW) DEVICE NO. JMP I HANDLR NOTEQ, TAD I SLOT /GET OLD HANDLER ENTRY POINT JMS RLSHND /REMOVE THE OLD HANDLER DCA I SLOT /SET 'NOT-RESIDENT' FLAG GETUSR /LOAD THE USER SERVICE ROUTINE TAD NEWDEV DCA TBLPT /MOVE DEVICE NAME FOR USR CALL TAD NEWDEV+1 DCA HNDNO CIF 10 JMS I USR /DO AN 'INQUIRE' 12 TBLPT, 0 HNDNO, 0 HNDPG, 0 ERROR0 /NO SUCH HANDLER IN SYSTEM HNDLRS= 4000 /ALL HAVE 'NEG' ENTRY POINTS! HAND0, TAD HNDPG /E.P., 0 OR 1 SPA /ALREADY LOADED? JMP HAND2 /YES! TAD H3600 /INITIALIZE LOAD ADDRESS DCA HNDEP TAD [HTABL-1 /SET UP FOR PAGE SEARCH DCA TBLPT ALOC1, TAD [200 /BUMP TO THE NEXT PAGE TAD HNDEP DCA HNDEP ISZ TBLPT TAD I TBLPT /OCCUPIED? SPA ERROR0 /NO ROOM FOR NEW HANDLER SZA CLA JMP ALOC1 /IN USE, TRY ANOTHER PAGE TAD HNDPG /DO WE NEED TWO PAGES? SNA JMP ALOC2 /NO TAD TBLPT DCA USECNT /POINT TO THE NEXT PAGE TAD I USECNT SZA CLA /OCCUPIED? JMP ALOC1 ISZ I TBLPT /SET THE 'TWO-PAGE' BIT ALOC2, ISZ HNDPG /BUMP THE PAGE COUNT TAD HNDNO /DEVICE NO. FROM 'INQUIRE' CIF 10 JMS I USR HAND1, 1 /LOAD HNDEP, 0 /HERE JMP HAND0 /CAN'T: NEED 2 PAGES TAD HNDEP /INCREMENT USE COUNT HAND2, JMS USECNT 10 /WE COUNT BY 10'S TAD HNDEP DCA I SLOT /FILL IN 'HNDBLK' TAD SLOT DCA AUTO TAD NEWDEV DCA I AUTO TAD NEWDEV+1 /PUT NEW NAME IN 'HNDBLK' DCA I AUTO TAD HNDNO /KEEP FOR RE-USE LATER ON DCA I AUTO TAD HNDNO JMP HANDX /AND COPY FOR IMMEDIATE USE / REDUCE THE PAGE COUNT WHEN WE CHANGE HANDLERS AND / RESET THE RESIDENCY TABLE WHEN COUNT GOES TO ZERO. RLSHND, 0 /'RELEASE' JMS USECNT -10 /'SPA SNA SZL CLA' (NOP) TAD P7650 DCA USECNT /POINT TO 'RESIDENCY' TABLE CDF 10 RELS1, TAD HNDEP /LOOK FOR PAGE MATCH AND L7600 CIA TAD I USECNT M7666, AND L7600 TAD HNDPG /GET SAVED USE COUNT P7650, SNA CLA H3600, DCA I USECNT /DELETE TABLE ENTRY IF 0 ISZ USECNT TAD USECNT TAD M7666 /17 ENTRIES, MINUS 'SYS' SZA CLA JMP RELS1 CDF L JMP I RLSHND ONMTMP, ZBLOCK 4 /SAVED OUTPUT FILE NAME PAGE / FILE CLOSING AND OUTPUT ROUTINES ABORT, DCA O2 /'OUTPUT ABORT' COMMAND DCA BLKCNT CLOSE, STA CML RAR /'OUTPUT CLOSE' COMMAND JMS CLOSER /L=1 JMP OECONT /RESTORE DEFAULT DEVICE CLOSER, 0 /CLOSE OR REMOVE THE FILE DCA TEMP /SET THE 'CALL' FLAG TAD OUTFLG /IS THERE AN OPEN FILE? SMA CLA JMP I CLOSER /NO TAD O2 /WHICH COMMAND? SNA CLA JMP REMOVE /'ABORT' L377, 377 /'AND L377'='OPBLKS+1' TAD [EOF /'CLOSE' JMS NOCHAR /INSERT A 'CTRL/Z' GETSIZ, SNL SMA /POINTS TO 'MGETA' JMP .-2 /AND PAD WITH ZEROS ISZ TEMP /CHECK CALLING FLAG JMP NOSIZE FLENPT, OPBLKS /NOTE: L=1, SO NO 'GETC' REMOVE, JMS I GETSIZ /GET THE CLOSING LENGTH, IF ANY STL /ONLY 'O A' & 'O C' HAVE SIZES TAD OLNGTH /COMPARE WITH THAT AVAILABLE SNL SZA CLA ERROR1 /BETTER LUCK NEXT TIME TAD I L0RD /GET THE SIZE BACK SZA /ZERO MEANS 'AS IS' DCA BLKCNT /ENTRY POINT FOR OVERFLOW ERROR NOSIZE, JMS I IOWAIT /WAIT FOR TELETYPE (RESETS DF) CIF 10 TAD OUTDVN /SAVED DEVICE NO. JMS I USR 4 ONMTMP /FILE NAME POINTER BLKCNT, 0 /CURRENT FILE LENGTH OLNGTH, 0 /MAXIMUM " " TAD OUTFLG SNA CLA ERROR1 /FILE WAS TOO LONG DCA OUTFLG /CLEAR THE 'FILE OPEN' FLAG TAD BLKCNT DCA I FLENPT /UPDATE FILE LENGTH TAD I CB DCA FL JMP I CLOSER /ALSO CALLED BY 'SAVE' & 'DELETE' NOCHAR, INITLZ /OS/8 3/2 BUFFERED CHARACTER OUTPUT STBLKP, AND L377 /MASK OUT GARBAGE ISZ O2 /WHICH CHAR OF THREE? JMP O1 /STRAIGHT PACKING JMS O2 /HALF WORD PACKING - PACK 1ST HALF TAD O3 /GET SAVED ARG JMS O2 /PACK SECOND HALF SM3 /RESET 3-WAY SWITCH DCA O2 /BUFFER CAN ONLY BE FILLED ISZ OUTFLG /ON THE 3RD CHARACTER OF 3 JMP O1+2 /NOT FULL YET OSUB, TAD OLNGTH /CHECK THE FILE SIZE (L=1) TAD BLKCNT /AMOUNT USED SO FAR SNL CLA /HAVE WE GONE TOO FAR? JMP NOSIZE-1 /YES, DELETE THE FILE I0F JMS I OUTHND /WRITE ONE BLOCK BUFFER 4200 2000 /BUFFER/0 OBLK, JMP I NOCHAR JMP I [DERR /DEVICE ERROR ISZ OBLK /BUMP OUTPUT BLOCK ISZ BLKCNT /AND COUNT OF BLOCKS SO FAR JMS O3 /RESET POINTERS FOR NEXT BUFFER JMP I NOCHAR /L=1 O1, DCA I OPTR1 /NORMAL PACKING IS EASY! ISZ OPTR1 /BUMP POINTER 1 CLL JMP I NOCHAR /L=0 O2, 0 /HALF-WORD PACK ROUTINE CLL RTL RTL DCA O3 /SAVE FOR SECOND HALF TAD O3 AND [7400 TAD I OPTR2 /ADD IN CHARACTER IN RIGHT HALF DCA I OPTR2 /PACK IT ISZ OPTR2 /BUMP POINTER 2 JMP I O2 O3, 0 /RESET THE OUTPUT POINTERS SM3 DCA O2 TAD OBLK-1 DCA OPTR1 TAD OPTR1 DCA OPTR2 TAD M200 /X3 = 384 CHARACTERS/BUFFER DCA OUTFLG JMP I O3 /'SM3' SETS THE LINK /THE 'OPEN OUTPUT' COMMAND: OOCMD, JMS I [OPEN /LOAD USR, HANDLER; ENTER FILE OUTHND /OUTPUT HANDLER BLOCK= INBLK 0 ERROR0 /ENTER ERROR: CLOSE OPEN FILE! JMP REOPEN /'O O,R' RE-OPENS OUTPUT FILE LPUSHF /SAVE THE FILE NAME FOR CLOSING NAMLOC LPOPF ONMTMP-1 TAD FLNGTH /SAVE FILE PARAMETERS FOR 'FRA' DCA I FLENPT TAD STBLK DCA I STBLKP /'O I/0' ACCESSES OUTPUT FILE! TAD FLNGTH STL CIA DCA OLNGTH /SAVE (-) MAXIMUM FILE SIZE JMP ORESET /COME HERE TO RESTART THE OUTPUT FILE: REOPEN, TAD GOSW /CHECK ',R' SWITCH SNL SMA CLA JMP OECONT /NONE - DO NOTHING TAD OUTFLG SNL SMA CLA ERROR0 /'O O,R' WITHOUT AN OPEN FILE ORESET, TAD I STBLKP /STARTING BLOCK DCA OBLK JMS O3 /INITIALIZE PACKING POINTERS DCA BLKCNT JMP OECONT /RESET OUTPUT TO DEFAULT DEV ///// XLEN, TAD FL /CURRENT INPUT FILE LENGTH JMP I CLOSE /'FL0ATR' TAD BLKCNT /MAXIMUM OUTPUT FILE LENGTH CIA /(MINUS AMOUNT USED SO FAR) TAD I FLENPT JMP I CLOSE ///// PAGE FLOUTP, 0 /INPUT HANDLER CALL JMS ICALL DCA INFLG /SET 'EOF' FLAG I0N CIF P JMP I FLOUTP /DF=L ///// /THE 'OPEN INPUT' COMMAND: OICMD, JMS OPINDX /GET BUFFER ASSIGNMENT JMP X100 /'O I/0' WHILE FILE IS OPEN JMS I [OPEN /LOAD HANDLER, LOOK UP FILE ISLOT, INBLKS+4 ERROR0 /FILE MISSING JMP ITCMD+1 /NO FILE NAME: CHK FOR ',R' TAD STBLK /SAVE FILE PARAMETERS DCA I FORMER TAD FLNGTH DCA I CB X100, SM1 /INITIALIZE PACKING FLAGS DCA INFLG DCA INBLK /THE 'INPUT TERMINAL' COMMAND: ITCMD, DCA GOSW /REVERSE ECHO SWITCH TAD GOSW SZA CLA /TEST 'RESTART' FLAG JMP X100 TAD EKODEV-1 /NOTE: 'O I' = 'I T' JMP SETIDV /THE 'INPUT CLOSE' COMMAND: ICLOSE, JMS OPINDX /GET FILE NUMBER JMP ICHAR0 /DON'T CLOSE OUTPUT TAD I ISLOT JMS I RLSHN /RELEASE HANDLER DCA I ISLOT DCA I CB /ZAP FILE LENGTH JMP X100+1 RLSHN, RLSHND /THE 'INPUT FILE' COMMAND: IFCMD, JMS OPINDX /GET DESIRED FILE INBLKS-40 TAD [ICHAR SETIDV, CDF P /SET INPUT DEVICE DCA I [INDEV GTNAME /CHECK ECHO SWITCH TAD I CB DCA FL /UPDATE FILE LENGTH TAD I FORMER CDF P DCA I PRNTSP /SAVE S.B. FOR FBLK ISZ GOSW TAD PRNTC /INPUT ECHO = 'PRINTC' DCA I [IECHO JMP EXIT /CONTINUE WITH PROGRAM ///// OPINDX, 0 /INDEX INTO INPUT TABLES JMS GETBAD SKP /NO '/N' SPECIFICATION DCA IBUF TAD IBUF JMS I X100 /'SHFTL6' TAD [10 DCA ICALL /BUF*2+20 TAD ICALL CLL RAL /BUF*4+40 TAD IFCMD+1 DCA ISLOT /BUF*4+INBLKS TAD ISLOT TAD ICALL DCA CB /BUF*6+OPBLKS TAD ISLOT TAD M200 AND OUTFLG SMA ISZ OPINDX /NO FILE/0 WORRIES SPA CLA TAD IERROR DCA ICHAR0 /SET ERROR TRAP FOR BUF/0 LPUSHF /SWAP FILE BLOCKS INBLK LPOPF FORMER, INBLK-1 /INITIAL VALUE TAD CB IAC DCA FORMER TAD FORMER IAC DCA CURENT LPUSHF CURENT, INBLK LPOPF INBLK-1 JMP I OPINDX /L=1 ///// GETBAD, [SETIDV /GENERATE BUFFER ADDRESS TAD I LPOPF&177 /FROM THE '/N' PARAMETER CMA STL /CHECK FOR '-1' SNA /WAS A BUFFER SPECIFIED? JMP I GETBAD /NO CMA CLL RTL /*4 AND [16 /LIMIT TO 0-3 TAD [20 /PLUS (ORIGIN/100) JMS I X100 /*100 ISZ GETBAD JMP I GETBAD /CALLED BY 'I/O B', 'OPINDX' ///// ICALL, 0 TAD [200 /PLUS '4000' AS NEEDED DCA FNWD TAD I ISLOT SMA IERROR, ERROR1 /HANDLER IS GONE - YOU LOSE! DCA GETBAD TAD INBLK /COMPUTE CURRENT BLOCK NO. TAD I FORMER DCA IBLK I0F JMS I GETBAD /GO GET IT FNWD, 0200 IBUF, 2400 /ONE OF 4 POSSIBLE BUFFERS IBLK, 0 SMA CLA /ONLY BOTHER WITH FATAL ERRORS JMP I ICALL JMP I [DERR /WE'VE GOT ONE ///// /'ICHAR0' IS SET TO 'ERROR1' WHENEVER AN 'O I' OR 'I F' /COMMAND SELECTS BUFFER/0 WHILE AN OUTPUT FILE IS OPEN. /THIS PREVENTS A READ FROM CORRUPTING THE OUTPUT BUFFER /YET STILL PERMITS THE 'FRA' FUNCTION TO USE OPEN FILES. /THIS LOCATION IS SET TO '0' UNDER NORMAL CIRCUMSTANCES. ICHAR0, ERROR1&0 /OS/8 FILE INPUT VIA 'INDEV' ISZ INFLG /COUNT CHARACTERS TAD INFLG /EOF YET? SZA /TIME FOR ANOTHER BLOCK? JMP ICHAR2 /NO JMS ICALL /YES TAD IBUF DCA IPNTR /RESET BUFFER POINTERS DCA ISWCH ISZ INBLK /AND ADVANCE BLOCK NUMBER TAD [-600 DCA INFLG /384(10) CHARACTERS/BUFFER ICHAR2, SMA SZA CLA /HIT THE EOF YET? / PAGE BOUNDARY JMP EOFXIT /YES CDF, I0N TAD ISWCH /CHECK THE SWITCH SPA JMP ICHAR3 /CHAR NO. 3 SNA TAD [10 /SET FLAG BIT DCA ISWCH TAD I IPNTR /UNPACK 3RD CHAR AND [7400 CLL RAL TAD ISWCH /COMBINE HALVES RTL RTL DCA ISWCH /SAVE FOR LATER TAD I IPNTR /GET THE NEXT WORD ISZ IPNTR JMP .+4 ICHAR3, DCA AUTO /DO THE ODD ONE DCA ISWCH /RESET SWITCH TAD AUTO AND K177 /CHECK FOR EOF, NULLS SNA ICHAR4, JMP I ICHARP /SKIP NULLS (ENTRY PT) TAD MEOF SNA /TEST FOR CTRL/Z EOFXIT, DCA INFLG /ZAP WORD COUNT ON EOF TAD [EOF CDI P JMP ICHAR+3 /RETURN CHAR TO PROGRAM ///// ICHARP, ICHAR0 /THE 'OUTPUT DUMP' COMMAND: JMS I OCHARP /FLUSH THE BUFFER ODCMD, TAD OUTFLG SNL SZA CLA /L=0 INITIALLY JMP ODCMD-1 JMP EXIT /PAD WITH ZEROS AND EXIT ///// *RMF 0 /'JMS I PRNTSP' TAD [SP CDI P JMS CPRNT JMP I RMF /FOR DIR LISTING AND DATE ///// TRAP, 0 /'ERROR0' DISMISS SP2 DCA GOSW /SET EXIT INDEX TO 'GOTO' CDF P TAD I [NAGSW /WAS A LINE NUMBER GIVEN? SMA CLA JMP EXIT-1 /YES, FALL INTO THE TRAP TAD TRAP JMP GOSW+3 /NO, DO THE USUAL STUFF /TAB-EXPANSION ROUTINES: ZER, TASK SMA CLA /INITIAL ENTRY POINT JMP POS TAD I XCHAR /SAVE THE CURRENT CHARACTER DCA TEMP NEG, CDI P JMP SKPX /SKIP OVER ONE (OR MORE) ISZ I L0RD JMP NEG TAD TEMP DCA I XCHAR /RESTORE THE ORIGINAL ONE POS, CDI P TAD I L0RD /FIND OUT WHERE WE'RE GOING STL CIA TAD I [ERROR /SUBTRACT FROM WHERE WE ARE SNL CLA JMP I ZER /FORGET IT... TAD [SP JMS CPRNT /PRINT SPACES JMP POS ///// OCHAR0, DCA CHAR /FILE OUTPUT VIA 'OUTDEV' TAD CHAR JMS I OCHARP I0N /'NOP' UNDER BATCH, RTS8 TAD CHAR CDI P JMP OCHAR+3 /RETURN CHARACTER FOR ECHO OCHARP, NOCHAR ///// /THE 'OUTPUT FILE' COMMAND: OFCMD, GTNAME /CHECK OPTION SWITCHES TAD OUTFLG SMA CLA /FLAG IS CHARACTER COUNT ERROR0 /NO OUTPUT FILE TO RESUME JMS SETODV /CHANGE OUTPUT, ECHO DEV. OECHO OCHAR ///// *ICHAR DIRBLK= .-4 /LOCATION OF DIRECTORY BLOCK SETODV, 0 /SET NEW OUTPUT, ECHO DEVICE TAD I SETODV ISZ SETODV DCA TEMP /SAVE ECHO ADDRESS TAD I SETODV CDF P DCA I [OUTDEV ISZ GOSW /ECHO SWITCH SET? SKP JMP NOECHO /NO TAD RMF /GET ECHO DEVICE CIA TAD I [OUTDEV /COMPARE SZA CLA TAD RMF /DIFFERENT SNA NOECHO, TAD OTCMD+1 /'NOP' DCA I TEMP /SET NEW ECHO DEVICE JMP EXIT ///// OTCMD, JMS SETODV /'OUTPUT TERMINAL' COMMAND CRTEST XOUTL /OPTLST-1 OPTLST, 0 /UNUSED "L /LINEPRINTER "T /TERMINAL "E /ECHO,EMPTIES ///// MEOF, -EOF /CHARACTER TABLES FOR LOWER-FIELD COMMANDS: LIBLST, "Q /QUIT "G /LOAD 'N GO OUTLST, "P /PROGRAM OR PLOT "A /ALL OR ABORT "D /DO OR DUMP "I /INITIAL OR INPUT "O /ONLY OR OUTPUT "S /SAVE OR SCOPE "L /LOAD OR LPT "E /ERASE OR ECHO INLST, "H /HOST OR HEADER "B /BUFFER "F /FILES "T /TERMINAL "C /CLOSE OR CALL ///// PAGE /LIBRARY COMMANDS: SAVER, ERASER, LOADER, LIBGO, LIBDO *FPNT /ENTER VIA 'JMP I 7' LCMDS, GETOPT /GET PROGRAM BUFFER DOTFP, 0620 ISZ GOSW /SUBROUTINE RETURN? JMP GOBACK JMP LSORT /CHECK COMMAND LIST *FPNT+5 SCANER, 0 /COMMAND WORD SCANNER CDI P TAD I XCHAR /SAVE FIRST CHARACTER DCA TEMP JMS LSCAN /SCAN TO END (AC=LAST) CL0SE, JMP I SCANER SAVER, TAD SAVIT /'LIBRARY SAVE' COMMAND NAMER, DCA .+3 /'LIBRARY CALL' COMMAND GTNAME /('LIBRARY HEADER' TOO) JMS TEMP /FILL IN THE HEADER JMS SAVE /DO IT JMP EXIT /DONE LSORT, LSORTJ /BRANCH TO PROPER COMMAND LIBLST-1 LIBJMP-LIBLST LERROR, ERROR1 /SORRY, TRY AGAIN ERASER, JMS I CL0SE /'LIBRARY ERASE' COMMAND GTNAME TAD D-1 GETHND JMS LCLOSE JMP EXIT-2 /CLEAR 'LIBFLG' AND EXIT LCLOSE, 0 /SAVE OR DELETE A FILE DCA SAVBLK TAD DEVNO CIF 10 JMS I USR 4 NAMLOC SAVBLK, 0 ERROR0 /NOT THERE JMP I LCLOSE LIBDO, LPUSHF /'LIBRARY DO' COMMAND FOCLTM LPOPF /MOVE 'FOCAL.TM' TO NAME AREA NAMLOC-1 TAD DSK /IN CASE WE NEED TO SAVE IT DCA NEWDEV DCA NEWDEV+1 TAD LIBFLG /ARE WE ALREADY SAVED? SNA CLA SAVIT, JMS SAVE /NO TAD DOTFP DCA EXTENSION /RESET EXTENSION TO 'FP' /LOOKUP AND LOAD ROUTINES: SM3 /THESE ALL DO THE SAME THING AND LIBGO, STL IAC /THEN BRANCH TO DIFFERENT PLACES LLOAD, STL IAC /LOAD HAS 5 POSSIBLE EXITS ! JMS I [OPEN /CALL THE HANDLER AND LOCATE FILE LIBHND D, DATE-1 /NOT THERE, NO NAME, OR ERROR1 /SOMETHING JUST AS STUPID JMS I (DEVCHK /FILE STRUCTURED? TAD GOSW /CHECK FOR GOSUB SPA CLA LPUSHF /SAVE CURRENT PROGRAM INFO. LIBDEV JMP LOADGO GOBACK, JMS I IOWAIT /RESTORE CALLING PROGRAM POINTERS DCA GOSW LPOPF NEWDEV-1 TAD D-1 GETHND /GET THE HANDLER BACK LOADGO, JMS LOADER /READ THE PROGRAM CDF T /'CDI T' FOR SPEC. PROG. TAD I D /CHECK PROGRAM I.D. SZA CLA / JMP I D /ENTER SPECIAL PROGRAM ERROR1 /(NONE RIGHT NOW) TAD I L200 /MOVE PROGRAM LENGTH CDF P DCA I BUFP DCA I (FQSW /DISABLE THE SCHEDULER CDI L /RETURN TO: JMP EXIT-1 /PROC, START, GOTO, OR DO SAVE, 0 /CALLED BY 'SAVER' AND 'LIBDO' JMS I CL0SE /AVOID TROUBLE CDF P TAD I BUFP /GET PROGRAM LENGTH CDF T DCA I L200 /SAVE IT WITH THE PROGRAM LSHFT, SM1 TAD I L200 /COMPUTE FILE SIZE CDF L AND L7600 /MASK PAGE COUNT JMS I LSHFT /SHIFT IT IAC CLL RAR /ROUND UP TO BLOCKS DCA FLNGTH /SAVE GETUSR /GET THE USER SERVICE ROUTINE TAD D-1 GETHND /LOAD THE HANDLER JMS I (DEVCHK /CHECK FOR STUPIDITY SP3 DCA I (CALL /SET UP OUR SUBROUTINE JMS I (OPENUP ERROR1 /NO ROOM OR WRITE-LOCKED TAD FLNGTH JMS LCLOSE /UPDATE DIRECTORY IN ADVANCE! TAD [20 /SET THE 'WRITE' BIT JMS LOADER /SAVE THE PROGRAM JMP I SAVE ///// LOADER, 0 /READ (OR WRITE) A PROGRAM TAD FLNGTH /COMPUTE FUNCTION WORD JMS I LSHFT /'SHFTL6' STL RAL /SET TO SEARCH FORWARD TAD [T /ADD FIELD BITS (12K) DCA .+4 TAD STBLK DCA .+4 JMS I LIBHND /GET THE PROGRAM 0 L200, 200 /LOADS FROM 200 UP 0 /STARTING BLOCK NO. JMP I [DERR DISMISS /SO WE CAN USE THE STACK LPUSHF NEWDEV /SAVE NEW POINTERS IN CASE LPOPF BUFP, LIBDEV-1 /THE PROGRAM USES A 'LIBDO' JMP I LOADER PAGE OSCOPE, XOUTL /HERE FOR EASY 'O S' PATCH P17757, 17757 /DEVICE-CONTROL-WORD TABLE DEVCHK, 0 /CHECK THE DEVICE TYPE TAD DEVNO TAD P17757 DCA SORTER CDF 10 TAD I SORTER CDF L SMA CLA ERROR1 /NOT FILE-STRUCTURED! JMP I DEVCHK ///// / ENTRY POINT FOR 'INPUT'/'OUTPUT'/'USER' COMMANDS: / NOTE: 'USER' COMMANDS MUST DISCARD DATA SAVED ON / THE STACK BEFORE CONTINUING - SEE THE DISCUSSION / ON THE PAGE AFTER NEXT... IOCMDS, SMA SZA /SKIP FOR 'I' OR 'O' JMP IOUERR /'JMP I [UC' FOR 'U' DCA SORTER /'I'=0, 'O'=-1 GETOPT /LOOK FOR '/' OPTION DOTDA, 0401 /AND SET DEFAULT .EX ISZ SORTER /INPUT OR OUTPUT? JMP ISORT OSORT, LSORTJ /CHECK THE 'O' LIST OUTLST-1 OUTJMP-OUTLST ISORT, LSORTJ /CHECK THE 'I' LIST INLST-1 INJMP-INLST IOUERR, ERROR1 /UNKNOWN 'IOU' COMMAND OECMD, GTNAME /'OUTPUT ECHO' COMMAND ISZ GOSW TAD I PRNTSP SNA OSCMD, TAD OSCOPE /'OUTPUT SCOPE' COMMAND DCA EKODEV JMP OECONT /IS EFFECTIVELY 'O E,S' ///// /LIBRARY COMMAND LIST: LIBJMP, 7600 /Q LIBGO /G LSTPRG /P LSTALL /A LIBDO /D LLOAD /I LOAD IN LSTONE /O SAVER /S LLOAD /L ERASER /E NAMER /H LERROR /B UNUSED LSTFLS /F LERROR /T UNUSED NAMER /C /OUTPUT COMMAND LIST: OUTJMP, OPCMD /P PLOTTER ABORT /A ODCMD /D OICMD /I OOCMD /O OSCMD /S OLCMD /L OECMD /E INTJMP, IOUERR /H HOST OBCMD /B OFCMD /F OTCMD /T CLOSE /C /INPUT COMMAND LIST: INJMP, IOUERR /H HOST IBCMD /B IFCMD /F ITCMD /T ICLOSE /C /OPTION LIST: OPTJMP, OPTN /N UNUSED OPTL /L OPTT /T OPTE /E / SUGGESTED INITIALIZATION CODE FOR THE 'USER' COMMANDS: / UCMNDS, CLA STL RTL /CLEAR AC, SET '+2' / CDF 10 / ISZ I (FORLVL /REDUCE LOOP COUNT / STL RAL / JMS I (PCHK /FIX STACK POINTER / THIS DISCARDS INFORMATION SAVED BY THE 'UNTIL' COMMAND, /LEAVING THE USER COMPLETELY FREE TO INTERPRET THE SUBSE- /QUENT TEXT IN ANY MANNER. TO GENERATE A SERIES OF 'SUB- /COMMANDS' ('U A','U B','U C', ETC.), USE 'SCANLN' TO GET /THE SECOND LETTER (AND SKIP TO THE NEXT PARAMETER FIELD) /THEN PUT 'TEMP' IN 'CHAR' AND CALL 'LSORT' TO SELECT THE /DESIRED COMMAND. THE ROUTINES 'GETOPT' AND 'GTNAME' MAY /ALSO BE USEFUL FOR EVALUATING CERTAIN COMMAND OPTIONS... / A 'JMP EXIT' INSTRUCTION WILL CONTINUE EXECUTION OF THE /PROGRAM WHEN THE COMMAND IS FINISHED. / LOWER FIELD SORT-AND-BRANCH ROUTINE: 'LSORT' SORTER, 0 JMS I IOWAIT /CLEAR AC, RESET DF, TURN IOF TAD I SORTER /GET LIST ADDRESS ISZ SORTER DCA AUTO TAD CHAR /CONVERT TO EIGHT-BIT AND K177 TAD LM140 /CHECK FOR LOWER CASE SMA TAD LM40 /TURN INTO UPPER CASE TAD L340 DCA AUTO 2 /SAVE FOR OTHER CHECKS TAD I AUTO SPA /END OF LIST ? JMP ERR CIA TAD AUTO 2 LM140, SZA CLA /MATCH ? JMP .-6 TAD AUTO TAD I SORTER /YES: COMPUTE ENTRY POINT DCA SORTER TAD I SORTER DCA SORTER ERR, CLA CLL /NO: FALL THROUGH OFFSET! JMP I SORTER /L=0 ///// / MULTIPLE-COLUMN OUTPUT ROUTINE FOR DIRECTORY LISTINGS *.!177&7740 /TO GET 'L340' L17, 17 /SPACE MASK TAD [CR-SP SPACLP, JMS I PRNTSP /SPACE BETWEEN COLUMNS CDF P TAD I [ERROR /CHECK PRINT POSITION L340, AND L17 LM40, SMA SZA CLA /SEPARATE BY 3 SPACES JMP SPACLP TAD I [LINENO /COLUMN SPECIFICATION? SZA DCA COLCNT /SAVE NEW COLUMN COUNT TAD I [ERROR CDF L CLL RTL /TIMES 8, THEN NEGATE P7044, CMA RAL TAD COLCNT /COMPARE SMA CLA JMP I P7044 /CONTINUE JMP SPACLP-1 /START A NEW LINE ///// COLCNT, 5^200 /NO. OF DIRECTORY COLS. /THE LIST COMMANDS: 'LIST ALL', 'LIST ONLY', 'LIST FILES', /AND 'LIST PROGRAMS' DO MORE-OR-LESS WHAT THE NAMES IMPLY. LSTFLS, TAD DOTDA /'LIST FILES' (ALL *.DA) DCA EXTENSION LSTPRG, CMA CLL RTR /'LIST PROGRAMS' (ALL *.FP) LSTONE, CMA STL RAL /'LIST ONLY' (JUST ONE) LSTALL, DCA I [OPEN /'LIST ALL' (EVERYTHING) GTNAME /GET DEVICE TO LIST TAD [LIBHND GETHND /GET THE HANDLER JMS DEVCHK /CHECK DEVICE TYPE DISMISS /REMOVE THE USR JMS I [7607 /SWAP OUT CODE TO MAKE ROOM 4200 /FOR DIRECTORY DIRBLK 40 /SYSTEM SCRATCH AREA JMP I [DERR /WHOOPS! DCA I BLOKLP-1 /SET THE FLAG TO SWAP BACK IN /PUT THIS LIST HERE SO WE CAN CROSS THE PAGE SMOOTHLY NAMLST, "< /BLOCK ": /DEVICE "( /VARIABLE DATA ". /EXTENSION "[ /SIZE ", /ECHO "* /WILDCARDS " /SPACES CLA CLL IAC /(SWAPIN) BLOKLP, DCA LBLOCK /DIRECTORY BEGINS WITH BLOCK 1 JMS I LIBHND 0200 DIRBLK /POSITIONED FOR OUR CONVENIENCE! LBLOCK, 1 JMP I [DERR TAD [DIRBLK+4 /FIRST 5 WORDS ARE INFORMATION DCA AUTO LOOP2, TAD AUTO /SAVE NAME POINTER FOR PRINTING DCA LIBX TAD I AUTO /CHECK IF WE SHOULD LIST EMPTIES SNA CLA JMP EMPTY ISZ AUTO ISZ AUTO TAD I AUTO /PICK UP EXTENSION DCA LBLOCK TAD I [DIRBLK+4 /WASTE WORDS (NEGATIVE) CIA TAD AUTO /SKIP TO LENGTH DCA AUTO TAD I AUTO /ZERO LENGTH MEANS TEMPORARY FILE SNA IFNZRO CMA RAL-. <'JMP I P7044' WON'T WORK PROPERLY> JMP LOOP3 /IGNORE SUCH THINGS (SPACLP RETURN) DCA FLNGTH TAD NAMLOC /WAS A NAME GIVEN ? SNA CLA JMP CKEXTN /NO TAD EXTENSION /CHECK THIS TOO? SNA CLA IAC /NO, ONLY CHECK THE NAME TAD [-4 COMPARE /COMPARE THIS NAME WITH ARG LIBX, AUTO-1 NAMLOC-1 JMP LOOP3 /NON-MATCHING ISZ I [OPEN /TEST FOR ONLY ONE TAD EXTENSION /OR A NULL EXTENSION SZA CLA DCA NAMLOC /DON'T CHECK ANY MORE JMP DIRLST CKEXTN, TAD EXTENSION /DO WE WANT THIS ONE? CIA TAD LBLOCK SZA CLA TAD I [OPEN /TEST FOR 'ALL' SPA CLA JMP LOOP3 /GUESS NOT DIRLST, SM3 /PRINT 3 WORDS DCA NEWDEV ISZ LIBX TAD I LIBX JMS I DIDJET /PRINT 2 CHARS ISZ NEWDEV JMP .-4 TAD [".-240 /PRINT '.' JMS I PRNTSP TAD LBLOCK /PRINT EXTENSION MTSLST, JMS I DIDJET TAD I P7540 /SETUP DIVISOR ADDRESS DCA NEWDEV /'SHFTL6-4' DCA NEWDEV+1 /SET LEADING-SPACES SW DCA SHFTL6 /CLEAR QUOTIENT NLOOP, TAD I NEWDEV /FINISHED ALL POWERS OF 10? SNA JMP I (SPACLP /YES, SPACE TO THE NEXT COL. TAD FLNGTH /NO, ADD TO (-)LENGTH P7540, SMA SZA /OVERFLOW? JMP DIDJET /YES, PRINT THIS DIGIT DCA FLNGTH /SAVE REMAINDER ISZ SHFTL6 /ADD ONE TO THIS DIGIT TAD ["0-240 /USE ASCII OFFSET TO DCA NEWDEV+1 /DISABLE ZERO-SUPPRESSION JMP NLOOP /AND GO THROUGH LOOP AGAIN /MANY THANKS TO STEVE L. GILLETT FOR THE INITIAL WORK /ON THE 'EMPTIES' OPTION. ANYBODY WANT TO ADD DATES? EMPTY, TAD I AUTO /LIST THE EMPTIES! DCA FLNGTH /GET THE LENGTH TAD GOSW /ARE WE SUPPOSED TO? SMA SZA CLA /SKIP IF WE'RE NOT JMP MTSLST /YES, INDENT SLIGHTLY LOOP3, ISZ I LBLOCK-1 /DONE WITH THIS BLOCK? JMP LOOP2 /NO, KEEP GOING JMS I IOWAIT /WAIT FOR I/O TAD I LINKWD /LINK TO NEXT BLOCK SZA /LAST BLOCK? JMP BLOKLP /NO, GET THE NEXT JMS I BLOKLP-1 /('JMS' RESETS THE FLAG) DIREND, DCA GOSW /COME HERE FOR FINAL CR CDF 10 TAD I [ERROR /START A NEW LINE? SNA CLA JMP EXIT-1 /NO, MINIMIZE SCROLLING TAD [CR-SP JMS I PRNTSP /YES, WE NEED IT JMP EXIT-1 ///// LINKWD, DIRBLK+2 FOCLTM, FILENAME FOCAL.TM *STL CMA /TRICKY, HUH? DECIMAL;1000 100 10 OCTAL; 1 *SM1 /MORE TRICKS! SHFTL6, 0 /CLEVER USE TERMINATES TABLE CLL RTL RTL RTL JMP I SHFTL6 /NOT QUITE THE SAME AS 'BSW' ///// DIDJET, SM2 /CLEAN UP THE AC AND NEWDEV+1 /GET OFFSET TAD SHFTL6 /PLUS QUOTIENT JMS I PRNTSP /PRINT SPACE OR DIGIT ISZ NEWDEV /GET NEXT POWER OF TEN JMP NLOOP-1 /CLEAR DIGIT AND REPEAT ///// PAGE /ROUTINE TO ENTER OR FIND A FILE FOR 'O I', 'O O' & 'LIB' OPEN, 0 /LOOKUP AND ENTER ROUTINE DCA GOSW /SET ECHO/LOAD SWITCH IAC CML RAL /SET CALL CODE (2 OR 3) DCA CALL GTNAME /GET DEVICE AND FILENAME TAD MDSK /CALLING SEQUENCE: TAD NEWDEV / AC=GOSW, L=1 FOR ENTER SNA / JMS I [OPEN TAD NAMLOC / HANDLER BLOCK SNA CLA / ERROR RETURN JMP SHUT / 'NO NAME' RETURN TAD I OPEN / NORMAL RETURN ISZ OPEN /POINT TO ERROR RETURN GETHND /LOAD THE HANDLER TAD NAMLOC /CHECK FOR A DIRECT ACCESS CALL SHFT, CMA STL RAL /POINTS TO 'SHFTL6' TAD CALL /'NAMLOC'=1, 'CALL'=2 (ONLY) SNA JMP I OPEN /CANNOT USE D.A. FOR OUTPUT IAC SNA CLA JMP SHUT /OK: 'STBLK' & 'FLNGTH' ARE SET JMS OPENUP /DO WHAT WE CAME FOR JMP I OPEN /ERROR RETURN TAD CALL+2 CIA DCA FLNGTH /SAVE POSITIVE LENGTH SHUT, DISMISS /REMOVE THE USR ISZ OPEN ISZ OPEN JMP I OPEN /NORMAL RETURN (L=0) ///// NCOMP, 0 /COMPARE TWO BLOCKS OF ANY LENGTH DCA OPENUP TAD I NCOMP /CALLING SEQUENCE: ISZ NCOMP / AC= -# OF WORDS DCA AUTO 2 / COMPARE TAD I NCOMP / ADDR#1-1 ISZ NCOMP / ADDR#2-1 DCA AUTO 3 / HERE IF DIFFERENT TAD I AUTO 2 / HERE IF IDENTICAL CIA TAD I AUTO 3 /CHECK THIS PAIR SZA CLA JMP I NCOMP /BLOCKS ARE DIFFERENT ISZ OPENUP /DONE ? JMP .-6 /NO, CHECK TWO MORE ISZ NCOMP /YES, BUMP RETURN POINTER JMP I NCOMP ///// *STA CML DATER, DCA AUTO /AC=(NODATE-1 TAD [-4 DCA GOSW CDF T TAD I AUTO /GET DATE JMS NPACK /OUTPUT IT ISZ GOSW JMP .-4 CDI T /(*STA CML RAR) JMP NIGHT /FUNCTION RETURN USRIN, 0 /LOCK THE USR IN CORE - 'GETUSR' / I0F CIF 10 JMS I USR 10 TAD U200 DCA USR JMP I USRIN *CLA CLL IAC SWAPIN, NOP /RESTORE MEMORY AFTER LISTING JMS I [7607 /SYSTEM HANDLER U200, 200 DIRBLK 40 DERR, ERROR1 /DEVICE ERROR = 'CLA CLL RTL' JMP I SWAPIN USROUT, 0 /REMOVE THE USR - 'DISMISS' CLA IAC STL RAR TAD USR /CHECK POINTER TO FIND OUT SMA CLA JMP I USROUT /ALREADY GONE: BOTH AC,L=0 TAD .-2 DCA USR /RESET POINTER TO '7700' / I0F CIF 10 /THEN DO THE CALL - THIS WAY JMS I U200 /WE SURVIVE IN CASE 'USR' IS 11 /OUT-OF-SYNC AFTER MON-ERROR JMP USROUT+1 /MAKE SURE L=0 ///// TSWP, TELSW *SP1 IOWATE, 0 /WAIT FOR TERMINAL TO FINISH CDF P I0N TAD I TSWP SZA CLA JMP .-3 I0F CDF L JMP I IOWATE /THEN TURN THE INTERRUPT OFF ///// XFORM, 0 AND K77 SMA SZA TAD [40 AND K77 JMS I PRNTSP JMP I XFORM ///// *SM2 NPACK, 0 /STANDARD 6-BIT UNPACK ROUTINE DCA OPENUP TAD OPENUP JMS I SHFT /'BSW' RAL JMS XFORM TAD OPENUP JMS XFORM JMP I NPACK /FOR DIRLST, DATE AND ERR MSG ///// MDSK, -5723 OPENUP, 0 /DO AN 'ENTER' OR 'FETCH' TAD [NAMLOC /INITIALIZE ARG2 DCA CALL+1 TAD FLNGTH /GET REQUESTED FILE SIZE CLL RTL RTL AND L7760 TAD TEMP /DEVICE NO. FROM 'GETHND' CIF 10 JMS I USR /'ENTER' OR 'FETCH' CALL, 0 / =3 =2 NAMLOC /BECOMES THE BLOCK NO. 0 / AND THE FILE LENGTH L7760, SNL SMA SZA CLA /ERROR RETURN ISZ OPENUP TAD CALL+1 /SAVE STARTING BLOCK DCA STBLK JMP I OPENUP /CALLED BY 'SAVE' AND 'OPEN' PAGE /READ A DEV:FILENAME.EX STRING INTO 'NEWDEV' & 'NAMLOC' NAME, 0 SM1 /POINTER TO 'SHFTL6' T3P, AND DSK /POINTER TO 'T3' DCA NEWDEV DEVNAM, DCA NEWDEV+1 DCA NAMLOC+0 /CLEAR THE NAME FIELD DCA NAMLOC+1 DCA NAMLOC+2 JMP PERIOD+2 /KEEP THE ASSUMED .EX PERIOD, DCA NAMLOC+3 SP3 /ADVANCE TO EXTENSION TAD [NAMLOC DCA STBLK /<> DCA FLNGTH /[] DCA AUTO 1 /RESET BYTE SWITCH SNL CLA JMP IGNORE /EVERY TIME BUT FIRST NAMLUP, DCA TEMP /SET DIGIT COUNTER TAD TEMP SMA CLA JMS MGETC /GET THE NEXT CHAR LSORTJ NAMLST-1 /< : ( . [ , * SP NAMGO-NAMLST TAD AUTO 2 TAD MINUS9 /CHECK FOR @-Z, 0-9 CLL TAD PLUS10 SZL SNL SMA SZA CLA /"0-"@ = -20 TAD .-1 STL TAD ("@-"Z-1 SNL CLA JMP NAMEND /ILLEGAL CHARACTER TAD AUTO 1 /0 FIRST, THEN -1,-2 TAD NAMEND-1 STL CMA TAD STBLK /EXCEEDED THE LIMIT? SNL CLA JMP IGNORE /YES TAD K77 /BUILD 6-BIT NAME PLUS10, AND AUTO 2 ISZ AUTO 1 /HIGH OR LOW BYTE? JMS I T3P-1 /'SHFTL6' SETS L=0 TAD I STBLK DCA I STBLK SZL ISZ STBLK /ADVANCE POINTER CMA CML RAL DCA AUTO 1 /RESET BYTE COUNTER NXTNUM, CDF P TAD I AUTO 3 /MAY BE GARBAGE TAD .+3 /ADD ("0) DCA CHAR IGNORE, ISZ TEMP /END OF NUMERIC STRING? SZA SNL /NO (XX60) SCANLN TAD (200-", /YES, IS THERE ANOTHER? CLL SZA CLA JMP NAMLUP+1 /NO PROGNM, JMS MGETA /PROGRAMABLE FILE NAME CIA DCA CHAR /ASSUME ITS A LETTER TAD I (HORD /NOW CHECK THE SIGN SPA JMP NAMLUP /IT WAS: C(AC) = -1 CDI P JMP VFN /CONVERT POS. NUM. TO ASCII *-"9-1 COLON, TAD NAMLOC /MOVE NAME TO 'NEWDEV' DCA NEWDEV TAD NAMLOC+1 JMP DEVNAM MGETC, 0 /CROSS-FIELD CALL CDI P JMP LGETC /L=1 TO SKIP 'GETC' DCA CHAR JMP I MGETC *SNL SMA-1 JMP I .+1 /TRY TO FIGURE THIS OUT! MGETA, 0 /EVALUATE AN EXPRESSION JMS MGETC /SKIP DELIMITER (IF L=0) CDI P JMP GETA /CALL 'EVAL' NAMGO, BLKNUM /BLOCK NUMBER MINUS9, COLON /DEVICE PROGNM /PROGRAMABLE NAME PERIOD /EXTENSION SQBRKT /SIZE OPTION /COMMA NAMLUP /STAR NAMLUP /SPACE VFR, DCA AUTO 3 /SAVE STARTING ADDRESS TAD I T3P SPA SNA /CHECK DECIMAL EXPONENT CLA IAC /FORCE 1 IF .LE. ZERO IFNZRO SMA SZA-. STL CMA DCA TEMP /EXPONENT=NUMBER OF DIGITS JMP NXTNUM BLKNUM, JMS MGETA /READ THE BLOCK NUMBER ISZ NAMLOC /SET THE BLOCK FLAG JMP PERIOD+3 SQBRKT, JMS MGETA /GET ESTIMATED FILE SIZE JMP PERIOD+4 OPTION, TAD [SP /REPLACE COMMA WITH A SPACE CDF P DCA I XCHAR SCANLN /SKIP TO OPTION OR LINE NO. DCA CHAR LSORTJ /WHICH OPTION WAS SPECIFIED? OPTLST-1 OPTJMP-OPTLST OPTN, STL CMA /UNKNOWN OPTION (',N',',R') JMP OPSW OPTT, TAD I OPTN-2 /ECHO ON TERMINAL SKP OPTE, TAD EKODEV /ECHO ON ECHO-DEVICE DCA I PRNTSP CMA CLL RAR /3777 OPSW, DCA GOSW /3777 OR 7777 SCANLN /SKIP TO THE END OF THE OPTION NAMLOC+4 /USES 'AND M1400' TO CLEAR AC! NAMEND, CDI P /EVALUATE THE LINE NUMBER JMP GETL JMP I NAME /***RETURN*** PAGE /PAGE ZERO (FIELD 0) LITERALS: FIELD 0 *OUTHND ZBLOCK 4 /CLEAR LAST 4 LITERALS /READ AND STORE THE OS/8 DATE WORD: FIELD 2 PAGE 0 PACK1, 0 /HALF-WORD PACK ROUTINE TAD ("0&177 /ADD OFFSET ISZ XS4O /TEST THE SWITCH JMP PACK0 JMS ROT6L DCA ROT6L /SAVE LEFT HALF JMP I PACK1 K77, 77 /HERE TO GET 'D7' XR0, 0 /AUTO-INDEX REGISTERS XR1, 0 PACK0, TAD ROT6L /MERGE THE PIECES CDF T DCA I XR1 CDF 10 /RESET DATA FIELD SM1 DCA XS4O /RESET THE SWITCH JMP I PACK1 NUHEAD, DCA XR0 /UPDATE HEADER LINE TAD (TITLE-1 DCA XR1 JMS XS4O /MOVE THE NAME CDF L JMS XS4O CDF L JMS XS4O DCA I XR1 /CLEAR ID WORD JMS XS4O JMS XS4O JMS XS4O /MOVE THE DATE JMS XS4O CDI L JMP L7600 /CALLED BY 'L S', 'L C' XS4O, 0 /CONVERT 6-BIT TO XS40 TAD I XR0 RAL JMS ROT6L /ONE BYTE AT A TIME... JMS ROT6L CDF T DCA I XR1 /STORE AWAY IN 'LINE 0' JMP I XS4O ROT6L, 0 /6BIT TO XS40, KEEPING 'ZERO' SZL JMP .+5 /DON'T WORRY - IT'S NOT ZERO TAD T7600 SZL CML /RESET LINK IF BYTE IS NON-0 TAD T200 CML RTL RTL RTL JMP I ROT6L /OTHERWISE JUST DOES A 'RTL6' DAY, SNA /'FDAY' FUNCTION (L=0) JMP DAY0 /ZERO ARG = PRINT ASCII DATE ISZ I (HORD JMS DATUM /POSITIVE = CHANGE THE DATE AND I (17666 /NEGATIVE = GET CURRENT DATE NIGHT, CDI P JMP I (FL0AT /'FL0ATR' *NAMLOC+3 /TO AVOID RE-LOADING XREG NODATE=. /BECOMES THE CURRENT DATE IFZERO DASTYL IFNZRO DASTYL T200= .-1 /DISGUISED AS 'B'! T7600, 7600 /LOC. 77 *PC0 /FOR COMMAND MODE ZBLOCK 2 PACK2, 0 ISZ PACK1 /CLEAR QUOTIENT JMP .-1 DCA XR0 /SAVE REMAINDER D600, 600 /LOCATION 106 ISZ PACK1 TAD XR0 /DIVIDE BY TEN TAD (-12 SMA JMP D600-1 CLA CMA /CLEAR OVERDRAW TAD PACK1 JMS PACK1 TAD XR0 /SECOND DIGIT JMS PACK1 IFZERO DASTYL /"0"-1="/" IFNZRO DASTYL /"0"-2="." JMS PACK1 JMP I PACK2 /ROUTINE TO UNPACK THE DATE - IN ANY OF 3 FORMATS! / DAMOYR=-1 /EUROPEAN STYLE DATES / MODAYR= 0 /AMERICAN " " / YRMODA=+1 /INTERN'L " " DATUM, STRTUP /USED BY 'FDAY', 'INITLZ' DCA I (17666 DCA LFCDI /REMOVE INITIALIZATION CODE DATEP, STA CML DCA XS4O /INITIALIZE SWITCH TAD (NODATE-1 DCA XR1 CDF 10 TAD I (17666 /GET DATE WORD SNA JMP LFCDI /SKIP NULL DATE IFZERO DASTYL-1 < /YEAR FIRST AND D7 DCA PACK2 CDF 0 TAD I XS4O /WILL BE -1! D106, AND D600 CLL RTR RTR TAD D106 /1970 TAD PACK2 JMS PACK2 /YEAR TAD I (17666> IFNZRO DASTYL+1 < /MONTH BEFORE DAY RTL RTL AND D7 RAL JMS PACK2 /MONTH TAD I (17666> RTR D7, AND K77 CLL RAR JMS PACK2 /DAY IFZERO DASTYL+1 < TAD I (17666 /MONTH AFTER DAY RTL RTL AND D7 RAL JMS PACK2 > /MONTH IFNZRO DASTYL-1 < TAD I (17666 /YEAR LAST AND D7 DCA PACK2 CDF 0 TAD I XS4O /WILL BE -1! D106, AND D600 CLL RTR RTR TAD D106 /1970 TAD PACK2 JMS PACK2 > /YEAR LFCDI, CDI L /INITIALIZATION CALL JMP I DATUM DAY0, TAD (NODATE-1 /FDAY(): PRINT CURRENT DATE CDI L JMP I DATEP FIELD 2 /LITERALS FIELD 1 /FIELD 1 LINKS FOR FIELD 0 *F0LINK GETA, GETNXT /FOR 'O A', 'O C', 'GTNAME' CIF L JMP MGETA-1 /DF=P, L=0 GETL, GETLN /'=' OPTION IN 'GTNAME' CDI L JMP NAMEND+2 LGETC, SNL CLA /'GETC' (UNLESS L=1) GETC TAD CHAR CDI L JMP MGETC+3 VFN, TAD LORD /+HORD /VARIABLE FILE NAMES SZA CLA SM0 /ROUND UP (EXCEPT 0) DCA OVER NORMALIZE SM1 PRINTN /CONVERT TO ASCII CIF L JMP VFR /AC=STRING ADDRESS $END$