ASMB,R,N * <800822.0733> * * * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * * NAME: EDIT0 * SOURCE: 92074-18003 * RELOC: PART OF 92074-12001 * PGMR: J.D.J. * * NAM EDIT0,5,50 92074-1X003 REV.2034 800818 ENT EDIT0 * ENT ED%PS PRINT SOURCE FILE MESSAGE ENT ED%FI READ IN NEW SOURCE FILE ENT ED%CS CLOSE SOURCE FILE ENT ED%CL CLOSE LIST FILE ENT ED%EF SET UP FOR NEW SOURCE FILE ENT ED%NL GET NEW LIST LU ENT ED%LP POST LIST FILE ENT ED%.M M COMMNAD ENT ED%.E E COMMAND ENT ED%EX EXIT EDIT ENT ED%WR WR, WC COMMANDS ENT ED%WF WRITF CALL ENT ED%PF TURN OFF BREAK MODE PROMPTS ENT ED%PN TURN ON " " " ENT ED%LK LOCK A LU ENT ED%TC CLOSE COMMAND FILE ENT ED%RF READ COMMAND FROM A FILE ENT ED%TR TR COMMAND ENT ED%PC PANIC TRACK REQUEST * EXT .ENTR,.MVW,.MBT,.SBT,.LBT,.DFER EXT SRTN EXT CREAT,OPENF,READF,WRITF,CLOSE,POST,LOCF EXT EXEC EXT TNAMR,INAMR,$CVT1 EXT LURQ EXT LUTRU EXT LOGLU EXT ENAMR * DEXEC EQU EXEC * * SUBROUTINES IN MAIN * EXT ./B$ SET TOP OF SOURCE FILE EXT ./B1 ROLL TO TOP OF SOURCE FILE EXT ALCAT ALLOCATE TRACKS EXT ASCII TEST FOR DIGIT EXT ASK ASK BEFORE EXCUTION EXT SETOK SUPPRES ASKING IF SLASH EXT CSTRP STRIP COMMA, BLANKS EXT DOUT WRITE DEST. FILE TO DISK EXT ECH GET NEXT COMMAND CHAR EXT ECHL GET CASE FOLDED COMMAND CHAR EXT ENDCK CHECK THAT ALL CHAR USED FORM E BUFF EXT EOFLN GET EOF LINE NUMBER EXT ERCLN CLEAN UP AFTER ERROR EXT EXCER REPORT EXEC CALL ERROR EXT FLLER COPY NEXT COMMAND FORM R BUFF TO E BUFF EXT I/PSB INPUT NEXT SOURCE LINE EXT KILL KILL MULKTIPLE COMMANDS EXT LCASE FOLD CASE EXT LST LIST A LINE EXT OUTCR PUT CHARACTER IN OUTPUT BUFFER EXT OVTST TOO MANY LINES OVERFLAW TEST EXT PBKE PUT BACK LAST CHAR EXT PRINT EXT PRTER PRINTER ERROR FLAG EXT RALLT RELASE ALL TRACKS EXT RQST REQUEST A TRACK EXT SETSO SET UP SOURCE EXT SQ SET UP SOURCE EXT SETTY SET INPUT TO TTY EXT SWPET SWAP E AND T BUFFERS EXT TR TRANSFER ONE LINE TO DEST EXT TRN TRANSFER N LINES EXT TYPEQ GET EQT TYPE EXT UNDOD SET UP FOR UNDO * ************** * * JMP TO POINTS IN MAIN * EXT ERR REPORT ERROR EXT ./A0 ABORT PROGRAM EXT DISPL REPORT ERROR EXT NODE1 GET NEXT COMMAND EXT RQST4 REURN FOR PANIC TRACK REQUEST * * DATA IN MAIN * EXT B^FNM BYTE POINTER TO FILE NAME EXT COMND FIRST CHAR OF CURRETN COMMAND EXT DBEND * EXT DBFP1 EXT DBUF$ EXT DBUFP EXT DCBSZ EXT DVRTY EXT DVTY EXT EBUFF EXT ECCNT EXT ELNG EXT ERFLG EXT EXFLG EXT FCARW EXT FNAME SAVE AREA FOR FILE NAME EXT FNSIZ AND IT'S SIZE EXT FSECW EXT FTYPW * EXT FSIZE * EXT FTYPE EXT IOPT EXT LASTL NUMBER OF LAST LINE IN SOURCE FILE EXT LDCB LIST DCB EXT LINEM EXT LINES EXT LNAM EXT LOPNF LIST FILE OPEN FLAG EXT LCLOF CLOSE LIST FILE AT NODE 1 IF SET EXT CTFLG CLOSE COMMAND FILE AT NODE 1 IF SET EXT LSTFG LIST AT TR FLAG EXT LSTFG LIST AT TR FLAG EXT LSLUT EXT LULOG EXT LUCMD EXT MODFG EXT NLSFG EXT NOPRN NO PRINT FLAG EXT NBUF0 EXT NAME EXT NEWLU NEW LU FROM RQST EXT DSCTR SECTOR PER TRACK FOR NEW TRACK EXT NWTRK NEW TRACK FROM RQST * EXT NOLSF NO LS SUPPORT EXT OCCNT EXT OKFLG EXT PASS1 EXT PANIC PANIC FLAG - IF SET USE SOURCE TRACKS EXT POFFG EXT PBFLG EXT QCSFG CLOSE SOURCE FLAG EXT QUFLG QUITE FLAG EXT QSFLG EXT RCLNG EXT RCCNT CURRENT COUNT IN RBUFF EXT PATCH FLAG IF THER IS ANOTHER COMMAND IN R BUFF EXT SBUF$ EXT SBUFP EXT SCFLG EXT SLNG EXT SPFLG EXT SVSLU EXT SVSSC EXT SVSTR EXT SVSWC EXT T#REC EXT T#REM EXT T#SEC * EXT TBUFF EXT TNAME EXT TSFLG TIME STAMP FLAG EXT TYDCB EXT TTYDV EXT TRFLG EXT ^LNAM EXT ROFLG EXT TYOPN COMMAND FILE OPN FLAG EXT TTYLU EXT LSTLU EXT ALTRK ALCAT'S PRE-ALLOCATED TRACK EXT ALCLU ALCAT'S PRE-ALLOCATED LU EXT #TRAK NUMBER OF TRACK IN SOURCE FILE * A EQU 0 B EQU 1 * ************************ * EDIT0 JMP SRTN JUMP BACK TO MAIN ******************************* * * SPSP ASC 1, "C" OCT 103 "E" OCT 105 "R" OCT 122 "Q" OCT 121 "W" OCT 127 ":" OCT 72 ">" OCT 76 "." OCT 56 "<" OCT 74 .1 DEC 1 .4 DEC 4 .10 DEC 10 .11 DEC 11 .128 DEC 128 .24 DEC 24 .3 DEC 3 .30 DEC 30 .6 DEC 6 .60 DEC 60 .75 DEC 75 * B37 OCT 37 B40 OCT 40 COMMA OCT 54 B60 OCT 60 B600 OCT 600 B77 OCT 77 * I.1 OCT 100001 I.2 OCT 100002 I.3 OCT 100003 I.5 OCT 100005 * M1 DEC -1 M6 DEC -6 * * * * *************************************************************** * PC BSS 8 CREAS NOP JSB .ENTR DEF PC LDB PC+2 PUT THE SIZE INTO THE NAMR BLOCK ADB =D3 LDA B,I SET FLAG BITS IOR =B400 STA B,I ADB =D4 LDA PC+3,I STA B,I LDA PC+4,I GET TYPE SZA,RSS DEFAULT TYPE ZERO TO TYPE 4 LDA =D4 STA PC+4,I JSB TYCHK CHECK FOR LEGAL TYPE JMP CREAS,I RETURN - ERROR CODE IN A REG JSB CREAT CREATE OUTPUT FILE DEF *+9 DEF PC+0,I DCB DEF PC+1,I ERROR BUCKET DEF PC+2,I FILE NAME ( MUST BE NAMR BLOCK) DEF PC+3,I # OF BLOCKS DEF PC+4,I FILE TYPE(DEFAULT TO 4) DEF PC+5,I SECURITY CODE DEF PC+6,I CARTRIDGE ID DEF PC+7,I DCB SIZE LDA PC+1,I GET ERROR SSA,RSS ERROR ? JMP CREA1 NO - REPORT SUCESSFUL LDB PC+2 GET ADDRESS OF NAMR BLOCK JSB FMGRE REPORT ERROR JMP CREAS,I RETURN * CREA1 JSB ENAMR GET FILE PARAMS DEF CRENR DEF PC+0,I DCB DEF TEMP IERR DEF PC+2,I NAMR BLOCK - 10 WORDS CRENR EQU * LDA PC+3,I GET SIZE LDB PC+2 GET ADDRESS OF NAMR BLOCK ADB =D7 STA B,I SET SIZE INTO NAMR BLOCK AFTER ENAMR CLEARED IT LDA CRMES GET MESSAGE STRING LDB PC+2 AND NAMR BLOCK JSB NMLST GO LIST IT LDA PC+1,I GET BACK GOOD ERROR NUMBER JMP CREAS,I RETURN * * CRMES DEF CRMS0 THIS CRMS0 DEC 13 IS A ASC 7,created file TABLE. ** SPC 1 ************************************ * PO BSS 7 OPENS NOP JSB .ENTR DEF PO JSB OPENF OPEN OUTPUT FILE DEF *+8 DEF PO+0,I DEF PO+1,I DEF PO+2,I DEF PO+3,I DEF PO+4,I DEF PO+5,I DEF PO+6,I LDA PO+1,I GET ERROR COE SSA,RSS TEST FOR ERROR JMP OPEN1 NO - GO REPORT SUCCESSFUL LDB PO+2 YES - GET NAMR BLOCK JSB FMGRE GO REPORT JMP OPENS,I RETURN * OPEN1 EQU * JSB ENAMR GET FILE PARAMS DEF OPENR DEF PO+0,I DCB DEF TEMP IERR DEF PO+2,I NAMR BLOCK - 10 WORDS OPENR EQU * LDA ROFLG TEST IF WE SHOULD REPORT OPEN MESSAGE SZA JMP OPEN2 FLAG SET , DON'T REPORT LDA OPMES GET ADDRESS OF OPEN MESS STRING LDB PO+2 AND NAMR BLOCK JSB NMLST GO LIST OPEN2 LDA PO+2 GET TYPE ADA =D6 LDA A,I JSB TYCHK DO VALID TYPE CHECK JMP OPEN3 ILLEGAL TYPE - GO CLOSE THE FILE LDA PO+1,I GET BACK GOOD ERROR CODE JMP OPENS,I RETURN * OPEN3 JSB CLOSS WRONG FILE TYPE - CLOSE THE FILE NOW!!!! DEF OPEN4 DEF PO+0,I DEF PO+1,I DEF ZERO TRUNCATE SIZE DEF PO+2,I OPEN4 EQU * LDA =D-15 GET ERROR CODE JMP OPENS,I RETURN WITH ERROR * * ZERO DEC 0 OPMES DEF OPMS0 THIS OPMS0 DEC 12 IS ASC 6,opened file A TABLE. * TEMP BSS 1 JUNK BSS 1 TEMP1 BSS 1 SPC 1 ***************************************************** * TYPE CHECK - ALLOW ANY TYPE BUT 1,2,5,6,7 * TYPE IS IN AREG. RETRNS AT P+2 IF OK - ELSE AT P+1 , AREG = -15 * (-15 => ILLEGAL NAME - AS CLOSE AS I CAN COME) TYCHK NOP CPA =D1 JMP TYCKE CPA =D2 JMP TYCKE CPA =D5 JMP TYCKE CPA =D6 JMP TYCKE CPA =D7 JMP TYCKE ISZ TYCHK BUMP TO GOOD RETURN JMP TYCHK,I RETURN * TYCKE CCE SET E REG FOR DECIMAL JSB $CVT1 GET ASSCII STA TCTYP SET IT IN THE MESSAGE JSB PRINT DEF TYCK1 DEC 13 ASC 3,Type TCTYP BSS 1 ASC 9, files are illegal * TYCK1 LDA =D-15 JMP TYCHK,I RETURN AT ERROR POINT ** * * ****************************************** * * REPOPRT FMGR ERROR, A REG IS ERROR, B REG. IS NAMR BLOCK * FMGRE NOP STA ERSAV SAVE ERROR NUMBER STB TEMPE SAVE ADDRESS FOR NAMR BLOCK JSB PTFME PUT ERROR IN SCB DEF FMGE0 DEF ERSAV FMGE0 EQU * JSB LOGLU MAKE SURE WE PRINT TO THE TERMINAL DEF FMGE1 DEF JUNKE FMGE1 EQU * STA LULOG CLA STA NOPRN MAKE SURE WE PRINT IT LDA ERSAV GET BACK ERROR CODE LDB "SPSP CCE,SSA,RSS TEST IF ERROR IS NEGITIVE, SET E FOR $CVT1 JMP FMGE2 POSITIVE - USE AS IS CMA,INA NEGATIVE - MAKE IT POSITIVE CCE SET E FOR DECIMAL FORM $CVT1 LDB "SPMI GET A SPACE MINUS FMGE2 STB SIGN JSB $CVT1 CONVERT TO DECMINAL STA NUMB LDA FEMES GET LENGTH AN MESSAGE LDB TEMPE GET ADDRESS OF NAMR BLOCK JSB NMLST GO LIST THEM LDA ERSAV GET BACK ERROR NUMBER JMP FMGRE,I RETURN * ERSAV BSS 1 TEMPE BSS 1 JUNKE BSS 1 * FEMES DEF FEMS0 THIS FEMS0 DEC 18 IS ASC 5,FMGR error A SIGN ASC 1, - TABLE. NUMB ASC 3,XX on DO NOT MOVE ! * "SPSP ASC 1, "SPMI ASC 1, - * ************************************* * * NMLST INVERSE PARSE NAMR AND LIST WITH A MESSAGE * A REG HAS ADESSS OF MESSAGE IN FROM < ASCCII STRING> * B REG HAS ADDRSS OF NAMR BLOCK NMLST NOP STB NMNMR SAVE NARM BUFFER. LDB A,I GET MESSAGE LENGTH STB TEMP SAVE IT INB ROUND UP BRS AND DIVIED BY 2 TO GET WORDS. STB TEMP1 INA BUMP FROM ADDRESS TO STRING LDB BUFF USE BUFF AS DESTINATION JSB .MVW MOVE THE MESSAGE THERE DEF TEMP1 NOP JSB INAMR INVERSE PARSE NAMR BLOCK DEF NMRTN NMNMR BSS 1 NAMR BLOCK DEF BUFF0 DEF .60 DEF TEMP NMRTN EQU * * LDA LULOG RESET LIST LU TO TTY LU * STA LSTLU IN CASE OF ERROR TO LIST FILE LDA BUFF GET ADDRESS CCB REMOVE COMMA ADB TEMP FROM LENGTH CMB,INB MAKE IT NEGITIVE STB TEMP AND SET LENGTH. LDB NOPRN GET NO PRINT FLAG SSB JMP NMRT1 SET SO SKIP PRINT JSB EXEC RERPOT DEF NMEXE DEF I.2 WRITE DEF LULOG TERMINAL'S LU DEF BUFF0 BUFFER DEF TEMP AND NEGITIVE LENGTH NMEXE JSB EXCER REPORT ERROR IF ANY NMRT1 JMP NMLST,I * BUFF DEF BUFF0 .2 DEC 2 ******************************************************* PR BSS 6 READS NOP JSB .ENTR DEF PR JSB READF READ DEF *+6 SOURCE DEF PR+0,I FILE DEF PR+1,I DEF PR+2,I DEF PR+3,I DEF PR+4,I LDA PR+1,I GET ERROR CODE SSA,RSS TEST FOR ERROR JMP READS,I NO - RETURN LDB PR+5 YES - GET ADDRESS NAMR BLOCK JSB FMGRE REPORT JMP READS,I RETURN SPC 1 ******************************* PW BSS 5 WRITS NOP ED%WF EQU WRITS JSB .ENTR DEF PW JSB WRITF WRITE DEF *+5 RECORD DEF PW+0,I ON DEF PW+1,I OUTPUT DEF PW+2,I FILE DEF PW+3,I LDA PW+1,I GET ERROR CODE SSA,RSS TEST FOR ERROR JMP WRITS,I NO - RETURN NOW LDB PW+4 YES - GET ADDRESS OF NAMR BLOACK JSB FMGRE LIST ERROR JMP WRITS,I RETURN * SPC 1 ******************************** PCL BSS 4 CLOSS NOP JSB .ENTR DEF PCL * * JSB LOCF CALL LOCF TO GET FILE SIZE * DEF CLOCR * DEF PCL+0,I DCB * DEF PCL+1,I ERROR * DEF I * DEF IRB * DEF I * DEF JSECT *CLOCR EQU * ** LDA PCL+1,I GET ERROR CODE * SSA TEST FOR ERROR * JMP CLERR YES - GO REPORT JSB CLOSE CLOSE DEF *+4 DEF PCL+0,I FILE DCB DEF PCL+1,I IERR DEF PCL+2,I TURNCATE SIZE LDA PCL+1,I GET ERROR CODE SSA,RSS TEST FOR ERROR JMP CLOS1 NO - REPORT SUCCESSFUL CLOSE LDB PCL+3 YES - GET NAMR BLOCK ADDRESS CLERR JSB FMGRE GO REPORT JMP CLOSS,I RETURN * * CLOS1 LDA CLMES GET ADDRESS FOR CLOSED MESSAGE STRING LDB PCL+3 GET ADDRESS OF NAMR BLOCK JSB NMLST LIST MESSAGE JMP CLOSS,I RETURN * * CLMES DEF CLMS0 THIS CLMS0 DEC 12 IS A ASC 6,closed file TABLE ! * * SPC 1 ********************************************* TPCL BSS 3 TCLOS NOP JSB .ENTR DEF TPCL JSB LOCF GET FILE LOCATION DEF LOCFR DEF TPCL+0,I DEF TPCL+1,I DEF I DEF IRB DEF I DEF JSECT LOCFR EQU * LDA TPCL+1,I GET ERROR CODE SSA,RSS ERROR ? JMP LOCF1 NO - LDB TPCL+2 YES - GET ADDRESS NAMR JSB FMGRE REPORT JMP TCLOS,I RETURN * LOCF1 LDA JSECT ITRUN = (JSECT/2)-(IRB+1) ARS DIVIDE BY 2 LDB IRB GET IRB INB ADD ONE CMB,INB MAKE IT NEGITIVE ADA B ADD STA ITRUN SAVE AS ITRUN. * LDA JSECT GET FILE SIZE IN SECTOR CLE,ERA DIVIDE BY 2 GIVES BLOCKS LDB ITRUN GET TRUNCATE SIZE CMB,INB ADA B REDUCE NUMBER OF BLOCKS IN FILE BY THIS SIZE LDB TPCL+2 COMPUTE ADDRESS OF SIZE WORD IN NAMR BLOCK ADB =D7 STA B,I SET IN SIZE * JSB CLOSS CLOSE DEF TCLSR DEF TPCL+0,I FILE DEF TPCL+1,I DEF ITRUN DEF TPCL+2,I NAMR BLOCK TCLSR JMP TCLOS,I RETURN * I BSS 1 USED AS A TEMP JSECT BSS 1 IRB BSS 1 ITRUN BSS 1 SPC 1 ******************************** PPOST BSS 3 POSTS NOP JSB .ENTR DEF PPOST JSB POST POST DEF *+3 DEF PPOST+0,I DEF PPOST+1,I SSA,RSS ERROR ? JMP POSMS NO -GIVE MESSAGE LDB PPOST+2 YES - GET NAMR ADDRESS JSB FMGRE REPORT JMP POSTS,I RETURN * POSMS STA PSAVE LDA COMND IF COMMAND IS CPA "E" THEN SUPPRESS MESSAGE JMP PSMS1 LDA ^PMSG LDB PPOST+2 NAMR BLOCK JSB NMLST PSMS1 LDA PSAVE JMP POSTS,I RETURN * ^PMSG DEF PMSG THIS PMSG DEC 12 IS ASC 7,posted file A TABLE * PSAVE BSS 1 SPC 1 ******************************** SKP * * CODE THAT USE TO BE IN MAIN * * * ED%PS JSB KILL KILL SPECIAL JUMP IN TTYIN JSB PRINT PRINT MESSAGE ABOUT HOW TO START DEF LSNUL THEN GO SET UP NUL FILE DEC 16 ASC 16,FI,namr specifies file to edit. * ED%FI EQU * CLA SET UP LINE COUNTERS STA LASTL FOR NEW SOURCE STA LINEM CLEAR SOUREC LINE COUNTER ( MSB NOT YET USED) STA JUNK SOURCE NAME LENGTH STA T#REC DEST LINE COUNTER STA T#REM - DOUBLE WORD BUT NOT YET USED STA SCFLG SOURCE CREATE FLAG CLA,INA STA LINES SET SOURCE LINE NUMBER TO 1 CCA SET EX FLAG STA EXFLG SO THAT THIS WILL BE NEW SOURCE STA PASS1 SET PASS 1 FLAG LDA DBUF$ RESET DESTINATION POINTER STA DBUFP PSFC3 JSB ECH GET FIRST CHARACTER JMP LSNUL NO MORE CHAR - USE A NULL FILE CPA B40 BLANK ? JMP PSFC3 YES TRY NEXT CHAR CPA B60 ="0"? JMP LSNUL JMP TO NULL LS CODE JSB PBKE PUSH BACK FIRST CHAR BY ADDING -1 FPARS EQU * JSB RALLT RELEASE ALL TRACKS JSB GETAT GET A FIRST TRACK FOR ALCATE JMP ./A0 NO TRACKS AND NO WAIT - ABORT JSB ALCAT SET UP DESTINATION FILE JSB GETAT GET A TRACK SO ALCAT WILL WORK NEXT TIME JMP ./A0 NO TRACKS SO ABORT NOW LDA NBUFF GET WHERE TO PUT FILE NAME JSB SC.CR AND GO PARSE FILE NAME. JMP STEOF SET AND ENMPTY FILE. USE LS AREA JSB INSRC FETCH FILE JMP NEWSC NOT FOUND - GO TELL HIM AND GIVE UP. * CCA SET STA ERFLG ER NAME VALID FLAG * LDA FCARW GET USER'S CART. SPECIFICATION. * SZA WAS IT SUPPLIED? * JMP WPMSG YES--NO NEED TO FAKE IT. * LDA SBUF$,I NO. GET FIRST WORD OF DCB. * AND B77 ISOLATE THE FILE'S LOCATION LU. * CMA,INA NEGATE, AND SAVE FOR * STA FCARW POSSIBLE USE IN FILE REPLACEMENT. WPMSG LDA SBUF$ GET FLAG WORD FORM DCB ADA =D7 LDA A,I TEST IF SECURITY CODES AGGREE SSA BIT 15 OF WORD 7 - IF SET THEN MATCH JMP STEOF YES - SKIP MESSAGE JSB PRINT DEF STEOF DEC 12 ASC 12,File is write protected * * STEOF CCA SET EOF FLAG STA SLNG IN SOURCE LENGTH LDA LASTL SAVE LINE COUNT STA JUNK JSB ./B1 TRANSFER PARTIAL BUFFER LDA JUNK RESTORE STA LASTL LINE COUNT JMP STBUF SET TBUFF. SPC 1 *LSFIL EQU * * IFZ * JSB REMCK TALKING REMOTE? * CLA,RSS YES,TREAT LS AS UNDEFINED * XIF * CLA ALWAYS USE NUL LS * LDA SFCUN SAVE SYSTEM LS POINTER, LSNUL EQU * LDA ELNG NO FILE - CLEAR E BUFF SO SC.CR WILL STA ECCNT FAIL. JMP FPARS GO DO NORMAL FILE STUFF. * *LSNUL CCB UNLESS LS UNDEFINED. * SZA,RSS * STB NOLSF ! NO LS SUPPORT * STA LSLUT IN SOURCE FILE POINTER AND * JSB ALCAT GET LS FILE AND DEST. TRACK * CCA IF THE LOGICAL SOURCE AREA !NO * CPA NOLSF IS UNDEFINED, THEN !LS * JMP STEOF+1 BYPASS SOURCE INPUTS, AT PRESENT. !SUPPORT * JMP STEOF BYPASS SOURCE INPUTS, AT PRESENT. * JSB SQ FILL INPUT BUFFER STBUF EQU * CLA CLEAR THE TEMP STA JUNK USE FOR NAME LENGTH JSB INAMR PUT ASCII FILE NAME IN DEF PUTFN SAVE AREA DEF NBUF0+0 DEF FNAME+0 DEF .30 DEF JUNK THIS MUST POINT TO A ZERO,BECOMES COUNT PUTFN EQU * LDA FSECR SAVE ORGINAL SC FOR A STA FSECW POSSIBLE ER. LDA JUNK SHORTEN NAME LENGTH BY 1 SZA TO REMOVE THE COMMA ADA =D-1 STA FNSIZ AND SAVE. JMP DISPL PRINT FIRST LINE * NEWSC CPA M6 SOURCE NOT OPENED - IS ERROR -6 ? JMP NWSC1 YES - GO TELL HIM WE WILL CREATE IT NWSC0 JSB CLRN0 NO - WIPE OUT NAME SO ER WONT WORK JMP LSNUL USE NULL FILE * NWSC1 JSB PRINT DEF NWSC3 DEC 29 ASC 10,File does not exist, ASC 19, an ER or the first WR will create it. * * NWSC3 CCA SET STA SCFLG SOURCE CREATE FLAG CLA CLEAR A FOR NUL LS JMP LSNUL * ****** * GETAT NOP ALLOCATE A TRACK AND PUT IT IN ALCAT TABLE JSB RQST GET THE TRACK JMP GETAT,I NONE SO RETURN LDA NWTRK COPY THE NEW TRACK NUMBER TO STA ALTRK ALCAT'S AREA LDA NEWLU DITTO FOR LU STA ALCLU ISZ GETAT BUMP TO GOOD RETURN JMP GETAT,I RETURN * ********** * * PANIC MODE REQSUET TRACKS - WE WILL USE THE SOURCE TRACKS * FIRST COPY LU AND SECT THE READT IT FIND LINK WORD ED%PC LDA LSLUT GET SOURCE TRACK POINTER LDB .2 ASSUME LU 2 RAL,CLE,SLA,ERA TEST BIT 15, CLEAR IT LDB .3 IT IS LU 3 - STA NWTRK STB NEWLU LDA SECT2 CPB .3 LDA SECT3 RAR CONVDERT TO 128 WORD SECTORS STA DSCTR SET SECTOR PER TRACK FOR RQST ADA =D-1 BUMP BACK BY ONE SECTOR CLE,ELA TIMES 2 GIVES 64 WORD SECTOR NUMBER STA PCSEC JSB EXEC READ THE TRACK DEF EDPC1 DEF I.1 READ/ NO ABORT DEF NEWLU DEF BUF DEF .128 DEF NWTRK DEF PCSEC EDPC1 JSB EXCER LDA BUF+127 GET THE LINK WORD STA LSLUT SET IT AS THE START LU,TRACK LDA #TRAK REDUCE OUTSTANDING TRACK COUNT BY 1 ADA =D-1 STA #TRAK JMP RQST4 CONTINUE PROCESSING * SECT2 EQU 1757B # SECTORS PER TRACK LU 2 SECT3 EQU 1760B # SECTORS PER TRACK LU 3 PCSEC BSS 1 * * * *********************************************************** * * CLOSE SOURCE FILE * * * CLMMS ASC 4,,closed B^CLS DBL CLMMS .7 DEC 7 * * ED%CS JSB ENDCK MAKE SURE THERE ARE NO MORE CHARAS LDA ERFLG TEST IF SSA,RSS ER FILE EXIST JMP ERR NO - ERROR LDA SCFLG TEST IF FILE EXIST SSA JMP ERR NO - ERROR LDA B^CLS PATCH IN CLOSED INTO MESSAGE LDB B^FNM ADB FNSIZ JSB .MBT DEF .7 NOP LDA FNSIZ ADA .7 STA FNSIZ JSB ERCLS GO CLOSE FILE NOP IGNORE ERRORS JMP DISPL ********************************* * * ERCLS NOP CLOSE ER FILE, RETURN AT P+2 IF SUCCESSFUL CCA SET QSCFG STA QCSFG JSB $ERTN AND DO IT JMP ERCLS,I ERROR RETURN ISZ ERCLS JMP ERCLS,I GOOD RETURN * ********************************** * * ED%EF EDIT A DIFFERENT FILE * - IF THERE IS ANY LINES IN THE FILE - ASK FIRST * - CHECK IF THERE IS A ER FILE OPEN - IF SO GO CLOSE * - JUMP INIT INPUT CODE * ED%EF JSB CSTRP SRTIP COMMA, BLANKS JMP ERR NO FILE NAME GIVE SO ERR JSB SETOK STRIP SLASH IF PRESENT LDA MODFG HAS FILE BEEN MODIFIED ? SZA JSB ASK YES - ASK FIRST CLA CLAR MODIFIED FLAG STA MODFG FOR NEXT TIME LDA ERFLG TEST IF ER FILE EXISTS SSA,RSS JMP $EF1 JSB ECLOS CLOSE OLD FILE IF OPEN $EF1 JMP ED%FI GO GET NEW FILE * * ************************************************** $ERTN NOP DO FILE STUFF - RETURN AT P+2 IF NO ERROR ED%WR EQU $ERTN CCA SET STA TRFLG TRANSFER FLAG DLD T#REC SAVE WHERE WE ARE DST E#REC CCA STA PANIC SET PANIC FLAG IN CASE WE RUN OT OF TRACK JSB ./B$ TRANSFER FILE TO DESESTION CLA STA PANIC JSB FILWR WRITE OUT FILE JMP $ERT1 ERROR RETURN CLA STA MODFG CLEAR MODIFIED FLAG JSB ERSTR RESTOR AFTER E CODE NOP NO RESPOSITION RETURN ISZ $ERTN BUMP JMP $ERTN,I AND RETURN * $ERT1 JSB ERSTR RESTORE BFFER STUFF NOP JMP $ERTN,I RETURN * * ************************** * ERSTR RESTORES THINGS AFTER AN E TYPE COMMAND * OLD T#REC MUST BE IN E#REC * ERSTR NOP CLA STA EXFLG RESET EXCHANGE FLAG STA PBFLG RESET PARTIAL BUFFER FLAG STA LSTFG RESET LIST FLAG CLA,INA STA LINES RESET LINE COUNTER JSB ALCAT GET NEW SOUCE AND DEST. FILE JSB SQ READ IN FIRST BLOCK LDA E#REC+1 GET WHERE WE WERE, HIGH BITS SZA IF THEY ARE ZERO THEN OK TO GO BACK JMP ERSTR,I NO - JUST RETURN LDA E#REC SSA TEST FOR TOO MANY JMP ERSTR,I NEGITIVE - JUST RETURN JSB TRN MOVE THE LINES TO GET BACK ISZ ERSTR BUMP JMP ERSTR,I AND RETURN * E#REC BSS 2 E.TBS BSS 1 ************************************************** NLSP0 CCA SET STA NLSFG NEW LIST LU FLAG STA MRGFG MERGE FLAG JSB CSTRP STRIP TO NAME JMP OLDLF DEFAULTED - GO CHECK FOR OK JMP NLSP3 GO PARSE FILE NAME * * NLSLU SET UP FOR A NEW LIST LU * NLSLU NOP ED%NL EQU NLSLU *** * ALLOW LIST TO A FILE * PARSE FOR NAMR * JSB NUMIN GET OPTIONAL NEW LIST LU JSB EFOLD FOLD E BUFFER CLA CLEAR MERGE FLAG STA MRGFG JSB ECH JMP NLSLU,I NOTHING DO RETURN CPA PLUS IS THIS CHAR A + FOR MERGE ? JMP NLSP0 YES - GO SET MERGE FLAG JSB PBKE NO - PUT IT BACK NLSP3 LDA ECCNT GET COMMAND CHAR COUNT INA BUMP IT BECAUSE STA TEMP NAMR COUNT IS ONE MORE THAN ECH COUNT JSB TNAMR PARSE WITH NAMR DEF NLS.0 DEF LSNAM DEF EBUFF,I DEF ELNG DEF TEMP NLS.0 CCB SET B TO -1 ADB TEMP UPDATE COMMAND CHAR COUNT STB ECCNT NLSP4 JSB ENDCK MAKE SURE THERE ARE NO MORE CHARS LDA LSNAM+3 GET TYPE WORD AND .3 MASK OUT ALL BUT FIRST SZA,RSS TEST IF NULL JMP NLS.1 YES - SKIP NEW TEST(A REG. IS 0) CCB NOT NULL -SET LIST FLAG(FOR A DELETE STB LSTFG WITH LIST) STB NLSFG SET NEW LIST LU FLAG CPA .3 IF TYPE 3 THEN A FILE JMP LSTFL FILE - GO DO FILE STUFF LDA LSNAM ELSE GET LU NUMBER ********************** NLS.1 AND B77 SAVE JUST THE LU LDB 0 SZA,RSS IF NOT SUPPLIED JMP NLSLU,I RETURN NOW IOR B600 SET ECHO AND V-BITS STA LSTLU SAVE THE LU ** SZB,RSS SKIP UNLESS NOT SPECIFIED ** JMP NLSLU,I * JSB TYPEQ GET LIST DEVICE TYPE CODE. SZA,RSS IF IT'S INTERACTIVE, JMP NLSLU,I THEN SIMPLY RETURN; ELSE, CHECK: * * ALLOW ANY DRIVER TYPE TO BE USED. * * * CPA DVR37 IS IT DVR37-- A HPIB DEVICE? * JMP *+6 YES, SKIP FOR ADDITIONAL PROCESSING * CPA DVR23 * JMP +*4 * CPA DVR12 IS IT DVR12--A LINEPRINTER? * JMP *+2 YES, SKIP FOR ADDITIONAL PROCESSING. * JMP ERR NO! OTHER DEVICES ARE UNACCEPTABLE. JSB LULOK GO TO LOCK THE LIST LU JMP NLSLU,I RETURN. ***************************** * SET LIST TO A FILE * LSTFL EQU * NEWFL JSB LCLOS CLOSE ANY OPEN LIST FILE LDA LSNAM+7 DEFUALT SIZE TO SZA,RSS 24 BLOCKS LDA .24 STA LSNAM+7 JSB CREAS CREATE LIST FILE DEF LSTF4 DEF LDCB+0 DEF RUBSH DEF LSNAM NAME DEF LSNAM+7 SIZE DEF LSNAM+6 TYPE DEF LSNAM+4 SECU DEF LSNAM+5 CARTRIDGE DEF .128 LSTF4 EQU * CPA =D-2 DOES FILE ALREADY EXIST? JMP LSTFO YES - GO OPEN IT SSA TEST FOR ERROR JMP LSTF3 YES - GO REPORT LFRTN LDA ^LSNM COPY NAME TO REPORING BUFFER LDB ^LNAM JSB .MVW DEF .10 NOP LFSFF CCA SET STA LOPNF LIST FILE OPEN FLAG STA LSTLU AND LIST LU TO -1 CLA CLEAR STA SPFLG SPACES FLAG JMP NLSLU,I RETURN ***************************************************** * OLDLF LDA LOPNF CONTINUE LIST TO OPEN FLIE SSA TEST IF THER A FILE OPEN JMP LFSFF YES - RETURN JMP ERR NO - GIVE ?? * LSTFO JSB OPENS OPEN NEW LIST FILE DEF LSTF2 DEF LDCB+0 DEF RUBSH DEF LSNAM DEF ZERO EXCLUSIVE OPEN DEF LSNAM+4 SECU CODE DEF LSNAM+5 CR DEF .128 LSTF2 EQU * SSA,RSS ELSE IF ERROR - REPORT JMP LSTFA NO ERROR - GO ASK IF IT IS OK TO OPEN LSTF3 JSB FMPER CLEAN UP AFTER ERROR JMP NODE1 ABORT COMMAND * LSTFA EQU * LDA ^LSNM COPY NAME TO REPORING BUFFER LDB ^LNAM JSB .MVW DEF .10 NOP CCA SET STA LOPNF LIST FILE OPEN FLAG STA LCLOF AND LIST CLOSE FLAG IN CASE ASK DO NOT RETURN LDA MRGFG TEST MERGE FLAG SSA,RSS JMP LSTM4 NO - SKIP MOVING TO EOF JSB PRINT DEF LSTM1 DEC 9 ASC 9,Appending to file. LSTM1 JSB READS READ UNTIL WE FIND AN EOF DEF LSTM2 DEF LDCB DEF IERR DEF BUF DEF ZERO DON'T MOVE ANY WORDS DEF ILEN DEF LSNAM NAMR BLOCK FOR ERRORS LSTM2 EQU * SSA ERROR ? JMP LSTF3 YES - GO ABORT COMMAND LDA ILEN AT EOF ? SSA,RSS JMP LSTM1 NO TRY NEXT RECORD LSTM4 JSB ASK GO ASK IF IT IS OK TO USE THIS FILE CLA STA LCLOF JMP LFSFF GOT BACK SO MUST BE OK. * MRGFG BSS 1 IERR BSS 1 ILEN BSS 1 ******************** * * LCLOS CLOSE THE OPEN LIST FILE * LCLOS NOP ED%CL EQU LCLOS LDA LOPNF GET LIST FILE OPEN FLAG SSA,RSS IF -1 THEN THERE A FILE OPEN JMP LCLOS,I NOTHING OPEN - RETURN JSB TCLOS TRUNCATE AND CLOSE THE LIST FILE DEF LSTF0 DEF LDCB+0 DEF RUBSH DEF LNAM+0 NAMR BLOCK FOR ERROR REPORT LSTF0 SSA TEST FOR ERROR JSB FMPER YES - GIVE ERROR MESSAGE CLA SET A TO ZERO STA LOPNF CLEAR LIST FILE OPEN FLAG STA LNAM+3 AND VALID REPORT NAMR FLAG JMP LCLOS,I RETURN * LSNAM BSS 10 ^LSNM DEF LSNAM PLUS OCT 53 '+' ********************************************************** * * FILWR WRITE DESTINATION FILE TO FMP FILE * FILWR NOP LDA QCSFG IS THIS A SZA CLOSE SOURCE FILE CALL ? JMP .QCS1 YES - SKIP COMMAND SCAN JSB ECHL GET REPLACE,CREATE OR LS COMAND JMP FWERR NOTHING SO ERROR * CPA "L" SET SYSTEM LS POINTER? * RSS * JMP ./E3 * IFZ * JSB REMCK REMOTE CRT? * JMP FWERR YES, CAN'T ACCESS LS * XIF * SPC 1 * JSB $LIBR ******************************* * NOP TURN OFF MEMORY PROTECT AND * LDA LSLUT SET SYSTEM LS AREA POINTER * STA SFCUN TO FINAL FILE ADDRESS * JSB $LIBX THEN TURN MEMORY PROTECT * DEF *+1 BACK ON * DEF LSTLS ****************************** * SPC 1 *DLU. DEF LU. *DTRK. DEF TRK. *DLSB DEF LSBUF *DTBF0 DEF TBUF0 PERMANENT SAVE. *LSLU NOP RETURN TO SCHEDULER *LTRAK NOP RETURN TO SCHEDULER *LSBUF ASC 4,LS FILE X, *LU. ASC 1,2, *TRK. ASC 2,XXX * SPC 1 *LSTLS LDA TBUFF * STA DTBF0 * LDA DLU. * STA TBUFF * LDB SFCUN * LDA .2 * SSB * INA * STA LSLU * CLB * JSB DEC CONVERT LU TO ASCII * CLA * STA OCCNT RESET CHAR COUNTER * LDA DTRK. POINT TO TRACK ASCII * STA TBUFF * LDA SFCUN GET LS TRACK * CLE,ELA SHUNT OUT LU * ALF,ALF * STA LTRAK B ALREADY CLEAR FROM ABOVE * JSB DEC * LDB OCCNT ACTUAL # OF DIGITS. * ADB .10 INCREASE BY PREL CHARS * LDA DLSB POINT TO MESSAGE, * JSB LST AND SEND IT OUT. * LDA DTBF0 RESTORE PRIMARY OUTPUT * STA TBUFF POINTER AND RESET * CLA CHARACTER COUNTER. * STA OCCNT * SPC 1 * JSB ECHL FETCH C OR R * JMP FWEND NONE, GO TO END MESSAGE STA SAVER SAVE COMMAND MODE * * SC.CR ALLOWS OPTIONAL COMMA LDA ^LSNM PUT FILE NAMR LSNAM AS TEMP JSB SC.CR PARSE FILE NAME JMP CHEKR /R IS VALID TO REPLACE SOURCE. LDA SAVER FETCH COMMAND MODE CPA "C" IF C JMP CRFIL GO TO CREATE FILE CPA "R" IF R JMP RPFIL GO TO REPLACE FILE JMP FWERR OTHERWISE GO TO FWERROR SPC 1 CHEKR LDA SAVER GET COMND CPA "R" IF IT'S R, PICK UP TURN-ON JMP .QCS1 FILE NAME:SC:CR. JMP FWERR NOT R - F W ERROR. * SAVER BSS 1 * .QCS1 LDA NBUFF CHANGE POINTER FOR SENDING STA SCCR^ FILE NAME. JSB .DFER MOVE IN FILE SC:CR:TYPE DEF FSECR DEF FSECW+0 ISZ SCFLG TEST IF WE ARE TO CREATE -(ONLY TRY ONCE) JMP .ERFL NO - CCA SET A FLAG SO WE WILL SET ERFLG STA SERFG IF THE CREATE IS SUCCESSFUL JMP CRFIL YES - GO DO IT .ERFL CCA SET ER OPEN LFAG STA ROFLG JMP RPFIL TRY TO REPLACE. SPC 1 NBUFF DEF NBUF0+0 FSECR BSS 1 ! THIS FCART BSS 1 ! IS A FTYPE BSS 1 ! TABLE. FSIZE BSS 1 SPC 1 CRFIL DLD T#REC COMPUTE FILE SIZE NEEDED ASR 7 IN 128 WORD BLOCKS ADA T#SEC FSIZE = INA ( T#REC/128 + T#SEC ) + 1 LDB SCCR^ GET POINTER TO NAMR BLOCK ADB =D7 BUMP TO SIZE WORD LDB B,I GET SIZE STB FSIZE SET AS A SIZE FOR NOW SSB WAS A NEGITIVE SIZE GIVEN ? JMP CRFL2 YES - GO SO SET EXACT SIZE SZB IF DEFAULTED ROUND TO A MULTIPLE OF 6 BLOCKS JMP CRFL1 HE GAVE A >0 NUMBER SO USE IT * * MAKE SURE FILE SIZE IS A MULTIPLE OF 6 * STA FSIZE SET EXACT IN CASE OF < 6 BLOCKS ADA =D-7 IF LESS THAN 6 BLOCK SKIP TEST SSA JMP CRFL1 ADA =D12 ROUND UP CLB DIV .6 MPY .6 STA FSIZE CRFL1 EQU * SPC 1 ** JSB CREAT CREATE OUTPUT FILE JSB CREAS SEG CALL TO CREATE OUTPUT FILE DEF *+9 DEF DBUF$,I DCB DEF RUBSH ERROR BUCKET DEF SCCR^,I FILE NAME DEF FSIZE+0 # OF BLOCKS DEF FTYPE+0 FILE TYPE(DEFAULT TO 4) DEF FSECR+0 SECURITY CODE DEF FCART+0 CARTRIDGE ID DEF DCBSZ+0 DCB SIZE SPC 1 SSA ERROR FROM CREATE? JMP FMPO YES, GO GIVE UP ISZ SERFG WAS ER DEFAULT FILE CREATE ? JMP WRITR NO - LEAVE ER FLAG UNCHANGED CCB YES - SET STB ROFLG ER FILE OPEN FLAG STB ERFLG SET ER VALID FLAG JMP WRITR GO TO OUTPUT FILE * SERFG DEC 0 * CRFL2 STA FSIZE SET EXACT SIZE JMP CRFL1 GO CREATE FILE * SPC 1 **RPFIL JSB OPEN OPEN OUTPUT FILE RPFIL JSB OPENS SEG CALL TO OPEN OUTPUT FILE DEF *+8 DEF DBUF$,I DEF RUBSH DEF SCCR^,I DEF ZERO DEF FSECR+0 DEF FCART+0 DEF DCBSZ+0 SPC 1 SSA ERROR FROM OPEN? JMP FMPO YES, PRINT ERROR MESSAGE SPC 1 LDA QCSFG IS THIS A CLOSE SOURCE CALL ? SZA JMP .QCS2 YES - SKIP WRITE WRITR JSB SETSO SET UP TO READ SOURCE. JSB SQ READ IN FIRST BLOCK NXREC LDB SLNG CONVERT # CHARS. TO BRS # OF WORDS STB RCLNG SPC 1 LDA TSFLG GET TIME STAMP FLAG SSA,RSS JMP WRTF0 FLAG CLEAR SO DON'T TIME STAMP LDA B GET RECODR LENGTH LDB SBUFP GET WORD ADDRESS JSB TSMPT SET FOR TIME STAMP JMP WTSMP GO DO TIME STAMP ** JSB WRITF WRITE WRTF0 JSB WRITS SEG CALL TO WRITE DEF *+6 RECORD DEF DBUF$,I ON DEF RUBSH OUTPUT DEF SBUFP,I FILE DEF RCLNG+0 DEF SCCR^,I NAMR BLOCK FOR ERROR REPORTS SSA IF ERROR, PRINT MESSAGE AND JMP FMPC TRY TO RECOVER LDA RCLNG IF EOF WRITTEN SSA GO TO JMP CLSFL CLOSE FILE JSB I/PSB READ NEXT RECORD JMP NXREC CONTINUE SPC 1 * CLSFL EQU * .QCS2 CLA FLAG AS NORMAL CLOSE JSB FCLOS GO CLOSE OR POST FILE FWEND ISZ FILWR INCR RETURN JSB QCSCL GO CLEAN UP QSC IF NEEDED JMP FILWR,I RETURN AS SUCESSFUL * WTSMP JSB @STMP GET FOMATTED TIME DEF *+1+1 DEF BUF USE BUF AS A TEMP LDA B^BUF LDB TPNTR GET BYTE POINTER TO START OF DATE JSB .MBT MOVE IN TIME STRING DEF .11 NOP JMP WRTF0 * FMPC EQU * JSB FCLOS GO CLOSE FILE, A REG AHS ERROR FLAG FMPO JSB FMPER GO DO SOME ERROR CLEAN UP JMP FILWR,I RETURN * * FWERR JSB PRTER GO PRINT '??' FMPC0 JMP FILWR,I RETURN THROUGH ERROR EXIT * * ** *** * FCLOS NOP - CLOSE OR POST FILE LDB QCSFG IS THIS A QCS COMMAND ? SZB JMP FCLS0 YES - CLOSE THE FILE LDB ROFLG TEST IF THIS IS DEFAULT ER SZB JMP FPOST YES - JUST POST THIS FILE * **CLSFL JSB CLOSE CLOSE FILE FCLS0 JSB CLOSS CALL TO CLOSE DEF FCLS1 OUTPUT DEF DBUF$,I FILE DEF RUBSH IERR BUCKET DEF ZERO TRUNCATE SIZE DEF SCCR^,I NAMR BLOCK FOR ERROR REPORTS FCLS1 EQU * SSA IF ERROR PRINT MESSAGE JSB FMPER AND END JMP FCLOS,I RETURN * FPOST SSA IS IT AN ERROR JMP FCLOS,I YES - JUST RETURN. JSB POSTS POST IS IN SEG ZERO DEF FPST1 DEF DBUF$,I DEF RUBSH DEF SCCR^,I NAMR BLOCK FOR ERROR REPROT FPST1 JMP FCLS1 GO TEST FOR ERROR * ************* * CLRN0 NOP CLEAR ER NAME BUFFER LDA ^CLRN LDB NBUFF JSB .MVW WIPE OUT SUBFIELDS DEF .10 NOP JMP CLRN0,I RETURN * CLRNR ASC 3, CLEAR NAMR TYPE BLOCK DEC 0,0,0,0,0,0,0 7 ZERO WORDS ^CLRN DEF CLRNR SPC 1 * QCSCL NOP CLEAN UP CLOSE SOURCE OPERATION LDA QCSFG GET CLOSE SOURCE FLAG SZA,RSS IS IT SET ? JMP QCSCL,I NO - JUST RETURN CLA YES - CLEAR STA QCSFG CLOSE SOURCE FLAG STA ROFLG AND ER FILE OPEN FLAG STA ERFLG AND ER OK FLAG JSB CLRN0 AND NAME BUFFER JMP QCSCL,I RETURN * SC.CR NOP STA SCCR^ SAVE WHERE TO PUT FILE NAME(10 WORD ARRAY) **** * OPTIONAL COMMA JSB CSTRP REMOVE POSSIBLE COMMA JMP SC.CR,I NOTHING, SO RETURN JSB ECH SEE IF THERE ARE ANY MORE CHAR JMP SC.CR,I NO - SO RETURN NOW JSB EFOLD FOLD E BUFFER LDA ECCNT GET COMMAND CHAR COUNT STA SCCRT NAMR COUNT IS ONE MORE THAN ECH COUNT * SO WE DON'T HAVE TO PUT BACK THE LAST CHAR. JSB TNAMR PARSE WITH NAMR DEF SCCR0 SCCR^ BSS 1 DEF EBUFF,I DEF ELNG DEF SCCRT SCCR0 EQU * CCB SET B TO -1 ADB SCCRT UPDATE COMMAND CHAR COUNT STB ECCNT SSA TEST FOR ERROR JMP SC.CR,I YES - RETURN NOW LDB SCCR^ FETCH ADB =D4 SECURITY LDA B,I CODE STA FSECR AND SAVE. INB FETCH LDA B,I CARTRIDGE NUMBER STA FCART AND SAVE. INB FETCH LDA B,I FILE TYPE STA FTYPE AND SAVE ISZ SC.CR BUMP RETURN ADDRESS JMP SC.CR,I * SCCRT BSS 1 * SKP * INSRC FINDS AND LOADS NEW SOURCE FILE. * * - READS SOURCE (FMGR) FILE INTO DESTINATION BUFFER, ONE RECORD * AT A TIME, DELETING TRAILING DOUBLE BLANKS. * - WHEN DESTINATION BUFFER IS FULL, CALLS TO WRITE THE * BUFFER IN SYSTEM-ASSIGNED TRACK IN LS FORMAT. * TEMPI BSS 1 * INSRC NOP ***** * MERGE WITH NON-EXCLUSIVE OPEN * CLA EXCLUSIVE OPEN IS A ZERO LDB EXFLG GET ORGINAL/MERGE FLAG SSB,RSS IF SET THEN ORGINAL INA THIS IS A MERGE - NON-EXCLUSIVE OPEN STA TEMPI * ** JSB OPEN OPEN INPUT FILE * JSB OPENS SEG CALL TO OPEN INPUT FILE DEF *+8 DEF SBUF$,I DEF RUBSH DEF SCCR^,I DEF TEMPI DEF FSECR+0 DEF FCART+0 DEF DCBSZ+0 SSA,RSS ERROR ON OPEN? JMP IN1 NO, READ IN FILE JSB FMPER YES, PRINT ERROR JMP INSRC,I ERROR RETURN IN1 ISZ INSRC STEP TO OK RETURN CLA STA TSMFG CLEAR TIME STAMP GIVEN FLAG * LDA EXFLG ORIGINAL INPUT * SSA FILE OR MERGE FILE? ** ALCAT NOW CALLED BEFORE INSCR IS CALLED * JSB ALCAT ORGINAL - GET FIRST DEST. TRACK JMP NXTR2 * SPC 1 NXTRC EQU * LDB EXFLG MERGE OR ORIGINAL? SSB JMP NXTR1 ORIGINAL ISZ T#REC INCREMENT DEST RECORD COUNT JMP *+2 DURING READ FOR A MERGE, ISZ T#REM IN DOUBLE-WORD INTEGER. JMP NXTR2 * NXTR1 ISZ LASTL BUMP LAST LINE COUNT AS WE READ IN * NXTR2 LDA DBUFP SET DBFP1 INA TO STA DBFP1 DBUFP+1 SPC 1 JSB READS READ DEF *+7 SOURCE DEF SBUF$,I FILE DEF RUBSH DEF DBFP1,I DEF .75 DEF DBUFP,I DEF SCCR^,I POINTER TO NAMR BLOCK FOR ERROR REPORT SPC 1 SSA ERROR FROM READF? JMP FMPA YES, GO TO FILE MANAGER ABORT LDA DBUFP,I FETCH RECORD LENGTH SSA END OF FILE? JMP ENDFL YES, GO TO END PROCESS *** JSB OVTST TEST FOR SIZE OVERFLOW < A IS SAVED> JMP ISER1 YES - GO DO ERROR PROCCSSING * ** THIS CODE DELETES TRAILING BLANKS FROM RECORDS ** READ FROM THE FILE MANAGER * ADA M1 BACK UP ONE WORD * SZA,RSS IF LAST WORD IN RECORD * JMP .NXT DO NOT DELETE * LDB DBFP1 LOAD LAST * ADB A WORD OF * LDB B,I RECORD * CPB SPSP IF LAST TWO CHARS. WERE * JMP DEL? BLANK CONTINUE LOOKING *.NXT EQU * * INA OTHERWISE BUMP WORD COUNT LDB TSMFG TEST TIME STAMP MESSAGE FLAG SSB JMP INTSP AREADY SET SO SKIP TEST LDB DBFP1 JSB TSMPT TEST FOR TIME STAMP LINE JMP TSMSG FOUND - PRINT MESSAGE INTSP LDA DBUFP,I FETCH RECORD LENGTH ALF,ALF MOVE RECORD LENGTH TO STA DBUFP,I UPPER BYTE ALF,ALF ADA DBFP1 ADD PREVIOUS POINTER LDB DBUFP GET OLD POINTER IN CASE OF DOUT ERROR STA DBUFP SET NEW POINTER CMA CHECK FOR AVAILABLE ROOM ADA DBEND TO END OF BUFFER. SSA,INA,RSS END OF OUTPUT BUFFER? JMP NXTRC NO, READ NEXT RECORD STB DBPSV SAVE THE OLD POINTER STA DBFP1 STORE NUMBER OF WORDS OF OVERFLOW JSB DOUT OUTPUT BUFFER JMP INSER ERROR - GO FIX UP AND QUIT LDA DBFP1 NO OVERFLOW SZA,RSS SO CONTINUE JMP NXTRC WITH READ LDB DBEND OTHERWISE FETCH OVERFLOW ADDRESS OVMVR LDA B,I MOVE STA DBUFP,I BUFFER INB OVERFLOW ISZ DBUFP INTO ISZ DBFP1 BEGINNING OF BUFFER JMP OVMVR JMP NXTRC READ NEXT RECORD * DBPSV BSS 1 * INSER LDA DBPSV GET THE SAVE BUFFER POINTER STA DBUFP RESET ISER1 CCB STB DBUFP,I PUT IN EOF FLAG * ***************** * * LEAVE FILE OPEN WHILE WORKING ON IT * WE WILL CLOBBER DCB BUT RE-OPEN THIS OPEN FILE UPON EXIT * ENDFL EQU * LDA EXFLG GET EXCHANGE FLAG SSA JMP ENFL1 FLAG SET - ORGINAL FILE - SKIP CLOSE *** JSB CLOSS CLOSE DEF *+5 MERGED DEF SBUF$,I FILE DEF RUBSH DEF ZERO TRUNCATE SIZE DEF SCCR^,I NAMR BLOCK FOR ERROR REPORT SSA ERROR FROM CLOSE? JSB FMPER YES, GO DO SOME CLAEN UP JMP INSRC,I RETURN * ENFL1 JMP INSRC,I RETURN * TSMSG CCA SET TIME STA TSMFG STAMP GIVE FLAG JSB PRINT DEF INTSP DEC 13 ASC 13,File will be time stamped. * TSMFG BSS 1 * ************************************* * * TSMPT TIME STAMP TEST - LOOKS FOR TIME STAMP * A REG - WORD COUNT * B REG - WORD ADDRESS * * RETURN AT P+1 IF FOUND - TPNTR IS BYTES ADDRESS OF DATE * RETURN AT P+2 IF NOT FOUND * TSMPT NOP TIME STAMP TEST CLE,ELB MAKE RECODR ADDRESS A BYTE ADDESS CLE,ELA CONVERT WORD COUNT TO BYTE COUNT ADB A BUMP TO END OF RECORD ADB =D-1 CCA STA TPNTR SET TO ALLOW ONE CHAR TSMP1 JSB .LBT GET LAST BYTE ADB =D-2 BUMP POINT BACK 1 CHAR CPA B40 A BLANK ? JMP TSMP1 YES- TRY NEXT CHAR CPA ">" CLOSING BROKET ? JMP TSMP2 YES - GO LOOK FOR TIME STAMP ISZ TPNTR FIRST NO-MATCH CHAR ? JMP TSMP0 NO - NOT FOUND JMP TSMP1 YES - TRY AGAIN * TSMP0 ISZ TSMPT NOT FOUND - BUMP REUTRN JMP TSMPT,I * TSMP2 ADB =D-11 BUMP BACK TO START OF STRING JSB .LBT GET FIST CHAR OF POSSIBLE TIME STAMP CPA "<" IS IT CORRECT ? JMP TSMP3 YES - CONTINUE JMP TSMP0 NO - GIVE UP. * TSMP3 STB TPNTR SAVE BYTE ADDRESS OF START OF TIME STAMP LDA =D-11 SET UP LOOP COUNT STA RUBSH TSMP4 JSB .LBT CPA "." IS IT THE DATE TIME SEPERATOR ? JMP TSMP5 YES - GO CHEACT FOR CORRECT POSITION CPA B40 ALSO ALLOW SPACE AS SEPERATOR JMP TSMP5 YES - GO CHEACT FOR CORRECT POSITION JSB ASCII IS IT A DIGIT ? JMP TSMP0 NO - GIVE UP JMP TSMP6 YES - CONTIUNE * TSMP5 LDA =D-5 IS DAY-HOUR SEPERATOR IN RIGHT PLACE CPA RUBSH JMP TSMP6 YES - CONTINUE JMP TSMP0 NO - GIVE UP * TSMP6 ISZ RUBSH TEST LOOP COUNT JMP TSMP4 JMP TSMPT,I FOUND - RETURN AT P+1 * TPNTR BSS 1 BYTTE POINTER TO START OF TIME STAMP * DBFP1 BSS 1 RUBSH NOP ANYTHING I DON'T WANT GOES HERE B^BUF DBL BUF SPC 1 * FMPER PRINTS FILE MANAGER ERROR * FMPER NOP A REG. IS SAVED STA FMPET JSB ERCLN GO DO ERROR CLEAN UP LDA FMPET JMP FMPER,I * * FMPET BSS 1 * SPC 1 FMPA JSB FMPER DO SOME ERROR CLEAN UP JMP ENDFL THEN ABORT THE READ * ************************************************************ * ED%.M JSB CSTRP ALLOW OPTIONAL COMMA JMP ERR NAME MUST BE SUPPLIES OR IT A ERROR * LDA ^LSNM PUT PARSED NAMR LSNAM JSB SC.CR GET THE FILE NAME JMP ERR ERROR IF NO FILE NAME CCA SET MODIFIED FLAG STA MODFG JSB TR SEND THE PENDING LINE JSB UNDOD SET FOR AN UNDO JSB INSRC FETCH THE FILE NOP IGNOR NOT FOUND ERROR SPC 1 JSB EXEC NOW GET DEF *+7 THE OLD SOURCE DEF I.1 BACK IN DEF SVSLU CORE DEF SBUF$,I DEF SVSWC+0 DEF SVSTR+0 DEF SVSSC+0 JSB EXCER REPORT ERROR SPC 1 JMP DISPL * SPC 1 LULOK NOP LIST LU LOCKING/UNLOCKING ROUTINE. ED%LK EQU LULOK LDA LUCMD GET THE CURRENT COMMAND. XOR .1 CONVERT TO OPPOSITE ACTION. STA IOPT CONFIGURE THE CALL. IFZ JSB REMCK IF THE LIST DEVICE IS REMOTE, JMP LULOK,I THEN LOCKING IS NOT REQUIRED. XIF LOKIT JSB LURQ REQUEST DEF *+4 LOCK OR DEF IOPT UNLOCK DEF LSTLU FOR THE SPECIFIED DEF .1 LIST LOGICAL UNIT. JMP LKERR REPORT THE ERROR. * CPA M1 IF NO RN'S AVAILABLE, NOW, JMP NORNS THEN GO REPORT CPA .1 IF LOCKED BY ANOTHER, THEN JMP WAITL GO BACK TO WAIT FOR IT. LDA IOPT GET LOCK OPTIONT IOR =B100000 MAKE SURE THE NO WAIT BIT IS SET STA LUCMD AND SAVE FOR UNLOCK NEXT TIME JMP LULOK,I LOCK/UNLOCK SUCCESSFUL--RETURN. * WAITL CLA CLEAR OK FLAG STA OKFLG SO WE ARE SURE TO ASK JSB PRINT DEF WTLK1 DEC -30 ASC 15,Device is locked. Is waiting _ WTLK1 JSB ASK LDA =B40001 INCLUDE NO-ABORT BIT, STA IOPT AND SET COMMAND: WAIT FOR LU/RN. JSB .DFER COPY NAME TO MESAGE DEF NAME1 DEF NAME+0 JSB PRINT INFORM DEF LOKIT THE USER DEC 15 THAT WE MUST WAIT. NAME1 ASC 15,edit waiting for list device. * NORNS LDA "NO" LDB "RN" LKERR STA LUMSG+7 STB LUMSG+9 CONFIGURE ERROR MESSAGE. LDA LULOG REPORT TO THE CONSOLE, INSTEAD, STA LSTLU DUE TO LIST-DEVICE PROBLEM. JSB PRINT PRINT THE ERROR MESSAGE, DEF ERR AND GO TO ERROR DEC 10 LUMSG ASC 10,LU LOCK ERROR XX XX "NO" ASC 1,NO "RN" ASC 1,RN * ******* * DVR07 CCA THIS IS USED A DATA (I DON'T WHAT BUT IT WORKS)! DVR23 OCT 11400 MAG TAPE DRIVER CODE SPC 1 * ****************************** * POST LIST FILE * ED%LP NOP JSB POSTS DEF LSST1 DEF LDCB+0 DEF RUBSH DEF LNAM+0 NAMR BLOCK FOR ERROR REPORT LSST1 SSA ERROR ? JSB FMPER GO DO ANY ERROR CLAEAN UP JMP ED%LP,I RETURN * * * * * .EFIX THINGS AFTER AN E COMMAND KILLED THEM * .EFIX NOP JSB ERSTR RESTORE OTHER STUFF JMP ERR NOT REPSOITION RIGHT - GIVE ERROR LDA COMND RESTORE A JMP .EFIX,I RETURN * * * ********************************************** * * EXIT CODE * * ED%.E DLD T#REC AND CURRENT POSITION DST E#REC CCA STA PANIC SET PANIC FLAG IF NO TRACKS JSB ./B$ COMPLETE XFER OF SOURCE TO DEST. CLA STA PANIC CLEAR THE FLAG JSB FILWR DO FILE WRITE JMP ./EER ERROR RETURN JSB RALLT RELEASE TRACKS SPC 1 * ****** TERMINATION HERE ******** * ED%EX CLA CLEAR STA SPFLG SPACES FLAG SO THING LINE UP JSB SETTY CLOSE COMMAND FILE IF NEEDED JSB LCLOS CLOSE OPEN LIST FILE JSB ECLOS GO CLOSE ER FILE JSB PRINT END OF EDIT MESSAGE DEF EXEC6 DEC 8 ASC 8,end of edit EXEC6 JSB EXEC DEF *+2 DEF .6 * ./EER JSB .EFIX GO FIX UP WORK SPACE JMP NODE1 GET NEXT COMMAND SPC 1 * ******************************************************************* * ECLOS CLOSE ER FILE WITHOUT WRITE * ECLOS NOP LDA ERFLG GET THE THE ER FLAG SZA,RSS TEST IF WE MUST CLOSE THE SOURCE JMP EXOPE NO SURCE GIVEN - QUIT NOW ISZ SCFLG TEST IF FILE WAS TO BE CREATED JMP *+2 NO - SO WE CAN CLOSE IT JMP EXOPE NO FILE TO CLOSE - GO QIUT LDA ROFLG TEST IF ER DCB IS GOOD SZA JMP EXCLS YES - JUST CLOSE IT. CCA SET FLAG STA ROFLG SO WE DON'T GIVE OPEN MESSAGE JSB OPENS NO - MUST RE-OPEN IT DEF *+8 DEF DBUF$,I DEF RUBSH DEF NBUF0+0 USE ORGINAL NAME DEF ZERO DEF FSECW AND SEC. CODE DEF FCARW AND CART. DEF .128 SPC 1 CLB CLEAR STB ROFLG ER FILE OPEN FLAG SSA ERROR FROM OPEN? JMP EXOPE YES, SKIP CLOSE - EXCLS JSB CLOSS CALL TO CLOSE DEF *+5 OUTPUT DEF DBUF$,I FILE DEF RUBSH ERROR BUCKET DEF ZERO TRUNCATE SIZE DEF NBUF0+0 NAMR BLOCK FOR ERROR REPORT SPC 1 EXOPE EQU * JMP ECLOS,I RETURN - IGNORE ERRORS * *** * SPC 1 ************************************************ * * * TURN SYSTEM PROMT BACK ON AFTER A POFF * PON NOP ED%PN EQU PON * LDA TTYLU AND B77 IOR CW20 STA TEMP JSB EXEC DEF .QSX3 DEF I.3 DEF TEMP .QSX3 JSB EXCER REPORT ANY ERRORS CLA STA POFFG CLEAR PROMPT OFF FLAG JMP PON,I RETURN * CW21 OCT 2100 DISABLE TERMINAL'S INTERRUPT PROGRAM CW20 OCT 2000 ENABLE TERMINAL' INTERRUPT PROGRAM LOPTN OCT 40001 LOCK WITH WAIT, NO ABORT UOPTN OCT 40000 UNLOCK LU,NO ABORT ****************************************************************** * * DO A CONTROL REQUEST TO DISABLE INTERRUPT PROGRAM SCHEDULEING * POFF NOP ED%PF EQU POFF JSB LUTRU GET SYSTEM LU FOR THIS TERMINAL DEF POFF1 DEF LULOG POFF1 EQU * CPA =D1 IS IT LU 1? JMP POFF,I YES - DON'T LOCK SYSTEM CONSOLES LDA LULOG IOR CW21 STA TEMP CCA SET PROMT OFF FLAG STA POFFG JSB EXEC DEF ./QSE DEF I.3 DEF TEMP ./QSE JMP ERR ERROR RETURN * LOCK LU SO NO ONE ELSE CAN WRITE TO IT JSB LULOK JMP POFF,I RETURN * ************************************ * EFOLD - FOLD E BUFFER EFOLD NOP LDA ELNG GET LENGTH CMA,INA,SZA,RSS MAKE IT NEGITIVE, CHECK FOR ZERO JMP EFOLD ZERO - RETURN NOW STA TEMP USE AS LOOP COUNT LDB EBUFF GET WORD ADDRESS CLE,ELB MAKE IR A BYTE ADDRESS EFLD1 JSB .LBT GET A BYTE FOR E BUFFER JSB LCASE FOLD CASE ADB M1 BUMP ADDRESS BACK TO WHERE IT WAS JSB .SBT REPLACE THE BYTE ISZ TEMP CHECK LOOP COUNT JMP EFLD1 NOT DONE - LOOP JMP EFOLD,I DONE - RETURN * DVR12 OCT 5000 LINE PRINTER TYPE CODE. DVR37 OCT 17400 HPIB TYPE CODE. DVR05 CLA USED AS DATA * ******* * ED%TR TRANSFER COMMAND * * ED%TR LDA PATCH IS THER ANYTHING MORE ON THE LINE ? SZA,RSS JMP .TR0 NO - SO OK CCA ADA RCCNT BUMP BACK THE COMMAND SEPERATOR STA RCCNT JSB FLLER COPY NEXT COMMAND TO EBUFF FOR REPORTING JMP ERR .TR0 JSB SETOK STRIP LAST SLASH JSB CSTRP JMP ERR NOTHING SO ERROR LDA ECCNT INA STA NRCNT SAVE CURRENT POSITION FOR NAMR COUNT JSB EFOLD .TR1 JSB ECH JMP .TR3 CPA B40 A BLANK ? JMP .TRBK GO LOOK FO COLON CPA COMMA A COMMA JMP .TR2 YES FOUND END OF NAMR JMP .TR1 TRY NEXT CHAR * .TRBK JSB ECH JMP .TR3 CPA B40 ANOTHER BLANK ? JMP .TRBK STRIP IT CPA ":" JMP .TR1 YES - MORE OF NAMR .TR2 JSB PBKE PUT BACK DELIMTER .TR3 JSB CSTRP STRIP BLANKS, COMMA NOP IGNOR DEFAULT LDA ECCNT STA NRLEN SAVE CURRENT COUNT AS LENGTH FOR NAMR JSB ECH JMP .TR4 CPA "Q" QUITE JMP .TRQ YES GO SET FLAG JMP ERR ELSE ERROR * .TRQ CCA SET STA QUFLG QUITE FLAG .TR4 JSB ENDCK MAKE SURE WE AT AT THE END JSB TNAMR PARSE NAME DEF .TR5 DEF TNAME+0 DEF EBUFF,I DEF NRLEN LENGTH DEF NRCNT COUNT .TR5 EQU * SSA JMP ERR YES - GO GIVE ERROR LDA TNAME+3 AND =D3 SZA,RSS JMP ERR CPA =D1 LU ? JMP .TRLU YES - GO SET UP LDA TYOPN IS THERE A COMMNAND FILE OPEN ? SSA,RSS JMP .TR8 NO - GO OPEN NEW ONE JSB CLOSS DEF .TR7 DEF TYDCB+0 DEF NRCNT ERROR BUCKET DEF ZERO TRUCNACTE SIZE DEF TNAME NAMR FOR ERROR .TR7 EQU * SSA JMP NODE1 ERROR - GO ABORT COMMAND .TR8 JSB OPENS NO FILE GO OPEN IT DEF .TR9 DEF TYDCB+0 DEF NRCNT DEF TNAME+0 DEF ZERO DEF TNAME+4 DEF TNAME+5 DEF .128 .TR9 EQU * SSA ERROR ON OPEN ? JMP NODE1 YES - SKIP COMAMND CCA STA CTFLG SET CLOSE COMMAND FILE FLAG JSB ASK CLA STA CTFLG CLEAR THE FLAG CCA SET SIGN BIT OF TTYLU TO MEAN FILE STA TYOPN SET THERES A COMMAND FILE OPEN FLAG STA TTYLU STA TTYDV .TREX LDA QUFLG STA NOPRN SET NO PRINT FLAG JMP NODE1 * .TRLU JSB ASK LDA TNAME SZA,RSS JMP ERR STA TTYLU SAVE AS INPUT LU IOR =B400 STA TEMP JSB EXEC REWIND THE LU DEF ./QT1 DEF I.3 CONTROL REQUEST - REWIND THE LU DEF TEMP ./QT1 JMP ERR REPORT ERROR IF THERE WAS ONE LDA TTYLU IOR B600 SET ECHO BITS STA TTYLU JSB TYPEQ CHECK EQT TYPE LDA DVTY RESET TYPE LU STA TTYDV JMP .TREX GET NEXT COMMNAD * NRLEN BSS 1 NRCNT BSS 1 * ********************************* ** * ED%RF READ COMMAND FROM A FILE * RFBUF BSS 1 ED%RF NOP JSB .ENTR DEF RFBUF JSB READS DEF .RF1 DEF TYDCB+0 DEF NRCNT DEF RFBUF,I DEF .75 DEF NRLEN DEF TNAME+0 .RF1 EQU * SSA JMP .RFER ERROR - GO HANDLE LDB NRLEN GET LENGTH SSB EOF ? JMP .RFEF YES - USE ERROR RETURN CLE,ELB MAKE IT BYTE COUNT CLA STA SPFLG STB ELNG SET AS LENGTH LDA RFBUF JSB LST LIST LINE CCA STA SPFLG CLA MAKE SURE WE HAVE A ZERO IN A LDB ELNG GET BACK LENGTH .RF9 ISZ ED%RF NO ERROR - BUMP RETURN JMP ED%RF,I * .RFEF CCA SET ALL BITS IN AREG CLB CLEAR B REG JMP .RF9 GO RETURN * .RFER CCA PUT A -1 IN A JMP ED%RF,I RETURN * ********* * * CLOSE COMMAND FILE * ED%TC NOP JSB CLOSS DEF .TYC1 DEF TYDCB+0 DEF NRCNT DEF ZERO DEF TNAME+0 .TYC1 EQU * CLA CLEAR STA TYOPN COMMAND FILE OPEN FLAG JMP ED%TC,I RETURN * * SKP HED NAMRT,7 2017 WHH NAMR typing routine * * ROUTINE TO CALCULATE THE NAMR TYPE OF A 16 BIT QUANTITY * THIS ROUTINE IS USED BY ALL 'SH' UTILITIES SO THAT THEY ALL THINK * THE SAME WAY AND APPEAR CONSISTENT TO THE USER * RETURNS 1 IF A NUMBER, 3 IF AN ALPHANUMERIC, 0 IF A NULL * CALL IS: * = NAMRT(VALUE) * ENT NAMRT EXT .ENTR CHAR1 BSS 1 CHAR2 BSS 1 PARAM BSS 1 ;PARAMETER POINTER NAMRT BSS 1 JSB .ENTR DEF PARAM LDA PARAM,I ;IF ZERO, RETURN ZERO SZA,RSS JMP NAMRT,I AND =B377 ;SEPARATE THE BYTES STA CHAR2 LDA PARAM,I ALF,ALF AND =B377 STA CHAR1 * * CHECK BOTH CHARACTERS TO MAKE SURE THAT THEY ARE APPROPRIATE * FOR ASCII DISPLAY * LDA CHAR1 ADA =D-33 AND =B177700 SZA JMP RET1 LDA CHAR2 ADA =D-32 AND =B177700 SZA,RSS JMP RET3 RET1 CLA,INA,RSS ;RETURN 1 RET3 LDA =D3 ;RETURN 3 JMP NAMRT,I SKP HED CLUCR,7 2015 WHH Convert LU to CR * * ROUTINE TO CONVERT A LU TO ITS CARTRIDGE REFERENCE * RETURNS -LU IF THE CARTRIDGE LIST DOES NOT CONTAIN THAT LU * (FOR MANY APPLICATIONS THIS IS SUFFICIENT) * CALL IS: * = CLUCR() * ENT CLUCR EXT .ENTR,FSTAT * * DO IT * LU BSS 1 CLUCR BSS 1 JSB .ENTR DEF LU JSB FSTAT ;GET CARTRIDGE LIST FOR THIS SESSION DEF *+5 DEF BUF DEF BUFSZ DEF ZERO ;OLD FASHION FORMAT DEF ZERO ;THIS SESSION ONLY * * TRY TO FIND THIS LU THERE * KEEP THE BUFFER POINTER IN B-REG * LDB ^BUF LOOP LDA 1,I ;GET THE LU SZA,RSS ;END OF LIST? JMP RETLU ;YES, RETURN NEGATED LU CPA LU,I ;NO, COMPAIR LUS JMP FOUND ;FOUND IT! ADB =D4 ;NO, BUMP POINTER JMP LOOP ;KEEP TRYING * * HERE IF WE FIND THE LU IN THE CR LIST * FOUND ADB =D2 ;GET THE CARTRIDGE NAME LDA 1,I JMP CLUCR,I * * HERE TO RETURN NEGATED LU * RETLU LDA LU,I CMA,INA JMP CLUCR,I * * DATA * BUFSZ DEC 256 ;BUFFER SIZE BUF BSS 256 ;CARTRIDGE LIST BUFFER < 256 WORDS> BUFF0 EQU BUF ^BUF DEF BUF * * SKP HED PTFME,7 2015 WHH Put FMGR err in SCB ENT PTFME EXT .ENTR,PTERR,.DIV * * FMGR ERROR CODE PRINTER * CALL IS * CALL PTFME() * ERROR BSS 1 PTFME BSS 1 JSB .ENTR DEF ERROR LDA ERROR,I GET ABSOLUTE VALUE OF ERROR LDB 0 SSA CMA,INA STA ABS LDA MSG1 DETERMINE SPACE OR MINUS SSB LDA MSG2 STA FMBUF+2 LDA ABS GET HIGH DIGIT OF ERROR CODE CLB JSB .DIV DEF D100 STB ABS ADA FMBUF+2 STA FMBUF+2 LDA ABS CLB JSB .DIV DEF D10 ALF,ALF ADA 1 ADA MSG3 STA FMBUF+3 JSB PTERR PUT INTO SCB DEF *+2 DEF FMBUF JMP PTFME,I RETURN MSG1 ASC 1, 0 MSG2 ASC 1,-0 MSG3 ASC 1,00 D100 DEC 100 D10 DEC 10 FMBUF ASC 4,FMGRxxxx ABS BSS 1 SKP HED ISHFT,8 2015 WHH Logical shift routine EXT .ENTR ENT ISHFT * * FORTRAN FUNCTION TO DO A LOGICAL SHIFT * CALL IS: * = ISHFT(,) * IF SHIFTING DISTANCE IS > 0, SHIFT LEFT * IF SHIFTING DISTANCE IS = 0, DON'T SHIFT ANY * IF SHIFTING DISTANCE IS < 0, SHIFT RIGHT * * THE SHIFT DISTANCE IS ASSUMED TO BE IN THE RANGE -15 TO +15 * NO ERROR IS GIVEN IF THE DISTANCE IS OUT OF RANGE * VAL NOP FAR NOP ISHFT NOP JSB .ENTR CLEAN ENTRY DEF VAL LDA FAR,I FIND OUT WHICH DIRECTION TO GO SSA RIGHT (DISTANCE < 0)? JMP RIGHT YES SZA NO, HOW ABOUT LEFT? JMP LEFT YES, GO LEFT LDA VAL,I ZERO, RETURN VALUE UNCHANGED JMP ISHFT,I * * HERE TO SHIFT LEFT * LEFT AND =B17 BUILD LDL INSTRUCTION IOR =B100040 STA LSLXX LDA VAL,I DO IT LSLXX LSL 1 JMP ISHFT,I * * HERE TO SHIFT RIGHT * RIGHT CMA,INA NEGATE HOW FAR AND =B17 AND BUILD A LSR INSTRUCTION IOR =B101040 STA LSRXX LDA VAL,I CLB LSRXX LSR 1 DO IT JMP ISHFT,I ***** * * HED PASCAL/1000 TIME STRING HANDLER * NAM TIME,7 92832-1X140 REV.2040 800611 ********************************************************************* * * * NAME: TIME * SOURCE: 92832-18140 * RELOC: 92832-1X140 * PGMR: SKJ,JWS * ********************************************************************* * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. * * ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE WITHOUT * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ********************************************************************* * * * * * ********************************************************************* * * * ENT @TIME, @STMP * * EXT EXEC, .ENTR, .MVW * SUP PRESS * AM ASC 1,am PM ASC 1,pm COLON ASC 1, : DOT ASC 1, . D6 DEC 6 D11 DEC 11 D13 DEC 13 DAYS DEF *+1 ASC 14,Fri Sat Sun Mon Tue Wed Thu MONTH DEF *-1 ASC 12,Mar Apr May Jun Jul Aug ASC 12,Sep Oct Nov Dec Jan Feb * TIME EQU * MSEC BSS 1 SEC BSS 1 MINUT BSS 1 HOUR BSS 1 DAY BSS 1 YEAR BSS 1 * SKP ********************************************************************** * * @TIME TIME STRING FOR PASCAL/1000 RUN-TIME LIBRARY * @STMP TIME STAMP FOR PASCAL/1000 RUN-TIME LIBRARY * * THESE ROUTINES RETURN THE TIME IN TWO DIFFERENT FORMATS * * THE TIME STRING IS OF THE FORM: * Thu May 24, 1979 2:52 pm * * CALLING SEQUENCE * JSB @TIME * DEF *+2 * DEF <26 character string> * * THE TIME STAMP IS OF THE FORM: * 790524.1452 * * CALLING SEQUENCE * JSB @STMP * DEF *+2 * DEF <12 character string> * * ERRORS * NO ERROR CONDITIONS * ***************************** * BASIC ALGORITHM FROM CLIB * ********************************************************************** SKP * ********************************* * ENTRY POINT TO GET TIME STAMP * ********************************* * NAMS@ DEF @NAMS @NAMS BSS 6 * STMPP BSS 1 @STMP NOP JSB .ENTR DEF STMPP JSB DOIT LDA NAMS@ LDB STMPP JSB .MVW DEF D6 NOP JMP @STMP,I * ********************************** * ENTRY POINT TO GET TIME STRING * ********************************** * TIMS@ DEF @TIMS @TIMS BSS 5 ASC 2,, 19 BSS 1 ASC 1, BSS 4 * TIMEP BSS 1 @TIME NOP JSB .ENTR DEF TIMEP JSB DOIT LDA TIMS@ LDB TIMEP JSB .MVW DEF D13 NOP JMP @TIME,I SKP * ********************************** * ACTUAL TIME CONVERSION ROUTINE * * GENERATES BOTH REPRESENTATIONS * ********************************** * DOIT NOP * * PICK UP THE TIME INFORMATION, THEN FORMAT IT * JSB EXEC DEF *+4 DEF D11 DEF TIME DEF YEAR * * MINUTES FOR TIME STRING * LDA MINUT JSB ASCDI LDB COLON A <= MINS, B <= ' :' IOR =B30000 PUT IN LEADING ZERO, IF NECESSARY STA MINUT SAVE MINUTES FOR TIME STAMP RRR 8 A <= ':', 10 MINS. B <= 1 MINS, ' ' DST @TIMS+10 MINUTES TO TIME STRING * * AM OR PM FOR TIME STRING * LDA HOUR LDB PM ADA =D-12 SSA,RSS JMP ITSPM * LDB AM LDA HOUR ITSPM STB @TIMS+12 AM OR PM TO TIME STRING * * HOURS FOR TIME STRING * SZA,RSS MIDNIGHT? LDA =D12 YES JSB ASCDI STA @TIMS+9 HOUR TO TIME STRING * * HOURS AND MINUTES FOR TIME STAMP * LDA HOUR WANT 24 HOUR TIME WHICH MIGHT JSB ASCDI HAVE BEEN 'CORRECTED' OUT ABOVE LDB DOT IOR =B30000 PUT IN LEADING ZERO IF NECESSARY RRR 8 A <= '.', 10 HRS. B <= 1 HRS, ' '. STA @NAMS+3 '.' AND 10 HRS TO TIME STAMP BLF BLF B <= ' ', 1 HRS. LDA MINUT A <= MINS. RRR 8 A <= 1 HRS, 10 MINS. B <= 1 MINS, ' '. DST @NAMS+4 1S OF HRS, 10S OF MINS, 1S OF MINS, ' ' TO TIME STAMP * * YEAR * LDA YEAR ADA =D-1900 JSB ASCDI STA @TIMS+7 YEAR TO TIME STRING STA @NAMS+0 YEAR TO TIME STAMP * * DAY & MONTH * LDB DAY ADB =D-60 LDA YEAR AND =D3 SZA SSB ADB =D-1 SSB ADB =D366 ADB =D31 LDA B RAL,RAL ADA B CLB DIV =D153 * STA TIME SAVE THE MONTH FOR A WHILE LDA B CLB DIV =D5 INA JSB ASCDI STA @TIMS+4 DATE TO TIME STRING IOR =B30000 LEADING ZERO? STA @NAMS+2 DATE TO TIME STAMP * * MONTH FOR TIME STRING * LDB TIME BLS ADB MONTH INDEX INTO MONTH TABLE DLD B,I DST @TIMS+2 MONTH TO TIME STRING * * MONTH FOR TIME STAMP * LDA TIME FOR TIME STAMP ADA =D-11 SSA JAN, FEB 0,1 ADA =D12 MAR..DEC -10..-1 INA JSB ASCDI IOR =B30000 LEADING ZERO STA @NAMS+1 MONTH TO TIME STAMP * * DAY OF THE WEEK FOR TIME STRING * CCA ADA YEAR ARS,ARS ADA YEAR ADA DAY CLB DIV =D7 BLS ADB DAYS INDEX INTO DAY TABLE DLD B,I DST @TIMS STUFF IT INTO TIME BUFFER * * RETURN * JMP DOIT,I RETURN * ************************** * DIGIT TO ASCII ROUTINE * ************************** * ASCDI NOP CLB DIV =D10 SZA ADA =A 0 ALF,ALF ADA B IOR =A 0 JMP ASCDI,I RETURN * END EDIT0